source: main/trunk/package-kits/linux/files/servlet.pl@ 29666

Last change on this file since 29666 was 29666, checked in by Jeremy Symon, 7 years ago

Fixed bug in CLI commands (was assuming there to be multiple servlets)

  • Property svn:executable set to *
File size: 6.0 KB
Line 
1#!/usr/bin/env perl
2
3use strict;
4use warnings;
5use utf8;
6
7use XML::Parser;
8use Data::Dumper;
9
10# Reads the servlets partial XML file using XML::Parser,
11# Then converts the obtained data structure to a more readable one
12# Example conversion:
13=xml
14<servlet>
15 <servlet-name>library</servlet-name>
16 <description attribute="example">The standard gsdl3 library program</description>
17 <servlet-class>org.greenstone.gsdl3.LibraryServlet</servlet-class>
18 <init-param>
19 <param-name>library_name</param-name>
20 <param-value>library</param-value>
21 </init-param>
22 <init-param>
23 <param-name>site_name</param-name>
24 <param-value>localsite</param-value>
25 </init-param>
26</servlet>
27=cut
28=data_structure
29{
30 'servlet' => {
31 'servlet-class' => 'org.greenstone.gsdl3.LibraryServlet',
32 'servlet-name' => 'library',
33 'description' => {
34 '.value' => 'The standard gsdl3 library program',
35 '.attr' => {
36 'attribute' => 'example'
37 }
38 },
39 'init-param' => [
40 {
41 'param-value' => 'library',
42 'param-name' => 'library_name'
43 },
44 {
45 'param-name' => 'site_name',
46 'param-value' => 'localsite'
47 }
48 ]
49 }
50}
51=cut
52sub read_servlets {
53 my $file = shift;
54 # The xml needs a root element, so we wrap it in one
55 my $xml='<!DOCTYPE doc [<!ENTITY real_doc SYSTEM "' . $file . '">] >
56 <__root__>
57 &real_doc;
58 </__root__>
59';
60 # Parse the data using XML::Parser
61 my $data = new XML::Parser (Style => 'Tree')->parse ($xml);
62
63 sub tidy {
64 my %hash;
65 # If the element has attributes, add them to the hash
66 my $attr = shift;
67 if (scalar keys %$attr > 0) {
68 $hash{'.attr'} = $attr;
69 }
70 # Read any child elements or text value
71 while (@_) {
72 my $element = shift;
73 my $value = shift;
74 if ($element eq 0) {
75 $value =~ /^\s*$/ || ($hash{'.value'} .= $value);
76 } else {
77 # If there is more than one of a single tupe of child element,
78 # That child element must become an array
79 if (defined $hash{$element}) {
80 unless (ref $hash{$element} eq 'ARRAY') {
81 $hash{$element} = [ $hash{$element} ];
82 }
83 push @{$hash{$element}}, tidy (@{$value});
84 } else {
85 $hash{$element} = tidy (@{$value});
86 }
87 }
88 }
89 # If the element only has a value, it can become a scalar
90 if (scalar keys %hash == 1 and defined $hash{'.value'}) {
91 return $hash{'.value'};
92 }
93 return \%hash;
94 }
95 return tidy (@{@$data[1]});
96}
97
98# Writes a data structure to an XML file
99sub write_servlets {
100 my ($hash, $file) = @_;
101 open OUT, '>', $file;
102 sub open_tag {
103 my ($indent, $tag, $attr) = @_;
104 print OUT $indent, "<", $tag;
105 if (defined $attr) {
106 for my $key (sort keys %$attr) {
107 print OUT " ", $key, '="', $attr->{$key}, '"';
108 }
109 }
110 print OUT ">";
111 }
112 sub write_xml {
113 my ($indent, $hash) = @_;
114 for my $key (sort keys %$hash) {
115 $key eq '.attr' && next;
116 my $val = $hash->{$key};
117 $key eq '.value' && do {
118 print OUT $val, "\n";
119 next;
120 };
121 for (ref $val) {
122 /^ARRAY$/ && do {
123 for my $element (@$val) {
124 open_tag ($indent, $key, $element->{'.attr'});
125 for (ref $element) {
126 /^HASH$/ && do {
127 print OUT "\n";
128 write_xml (" $indent", $element);
129 print OUT $indent, "</", $key, ">\n";
130 last;
131 };
132 print OUT $element, "</", $key, ">\n";
133 }
134 }
135 last;
136 };
137 /^HASH$/ && do {
138 open_tag ($indent, $key, $val->{'.attr'});
139 # If the element only has a value with attributes,
140 # it can be formatted on one line
141 if (scalar keys %$val == 2 and defined $val->{'.value'}) {
142 print OUT $val->{'.value'}, "</", $key, ">\n";
143 } else {
144 print OUT "\n";
145 write_xml (" $indent", $val);
146 print OUT $indent, "</", $key, ">\n";
147 }
148 last;
149 };
150 open_tag ($indent, $key);
151 print OUT $val;
152 print OUT "</", $key, ">\n";
153 }
154 }
155 }
156 write_xml ("", $hash);
157 close OUT;
158}
159
160my $hash;
161# Hackish non-interactive CLI parser
162while (@ARGV) {
163 for (shift) {
164 /^read$/i && do {
165 $hash = read_servlets (shift);
166 last;
167 };
168 /^write$/i && do {
169 write_servlets ($hash, shift);
170 last;
171 };
172 /^debug$/i && do {
173 print Dumper $hash;
174 last;
175 };
176 /^count$/i && do {
177 my $servlets = $hash->{servlet};
178 my $count = 1;
179 if (ref $servlets eq 'ARRAY') {
180 $count = scalar @{$hash->{servlet}};
181 }
182 print "Found ", $count, " servlets\n";
183 last;
184 };
185 /^list$/i && do {
186 print "Servlets:\n";
187 my $servlets = $hash->{servlet};
188 if (ref $servlets eq 'ARRAY') {
189 for my $servlet (@{$hash->{servlet}}) {
190 print " ", $servlet->{'servlet-name'}, "\n";
191 }
192 } else {
193 print " ", $servlets->{'servlet-name'}, "\n";
194 }
195 last;
196 };
197 }
198}
Note: See TracBrowser for help on using the repository browser.