Changeset 29668 for main/trunk/package-kits
- Timestamp:
- 2015-01-07T12:09:44+13:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
main/trunk/package-kits/linux/files/servlet.pl
r29667 r29668 7 7 use XML::Parser; 8 8 use Data::Dumper; 9 use POSIX 'isatty'; 9 10 10 11 # Reads the servlets partial XML file using XML::Parser, … … 50 51 } 51 52 =cut 52 sub read_servlets { 53 my $file = shift; 53 sub read_xml { 54 my $FH = shift; 55 local $/ = undef; 56 my $xml = <$FH>; 54 57 # 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 '; 58 $xml='<__root__>' . $xml . '</__root__>'; 60 59 # Parse the data using XML::Parser 61 60 my $data = new XML::Parser (Style => 'Tree')->parse ($xml); … … 97 96 98 97 # Writes a data structure to an XML file 99 sub write_servlets { 100 my ($hash, $file) = @_; 101 my $OUT; 102 if ($file ne '-') { 103 open $OUT, '>', $file; 104 select $OUT; 105 } 98 sub write_xml { 99 my ($hash, $FH) = @_; 100 select $FH; 106 101 sub open_tag { 107 102 my ($indent, $tag, $attr) = @_; … … 114 109 print ">"; 115 110 } 116 sub write_ xml{111 sub write_element { 117 112 my ($indent, $hash) = @_; 118 113 for my $key (sort keys %$hash) { … … 130 125 /^HASH$/ && do { 131 126 print "\n"; 132 write_ xml(" $indent", $element);127 write_element (" $indent", $element); 133 128 print $indent, "</", $key, ">\n"; 134 129 last; … … 147 142 } else { 148 143 print "\n"; 149 write_ xml(" $indent", $val);144 write_element (" $indent", $val); 150 145 print $indent, "</", $key, ">\n"; 151 146 } … … 158 153 } 159 154 } 160 write_xml ("", $hash); 161 if (defined $OUT) { 162 close $OUT; 163 } 155 write_element ("", $hash); 164 156 select STDOUT; 165 157 } 166 # The code above is for generic XML read/writing167 # The code below is specific to Greenstone's servlets.xml168 158 169 159 my $hash; 170 # Hackish non-interactive CLI parser 160 my %commands; 161 # Command structure: 162 # key: Case-insensitive name of the command 163 # val: Array of info about the command 164 # [0]: Description of the command 165 # [1]: Function that is run for the command 166 # [2]: Number of arguments of the command (if any) 167 %commands = ( 168 help => [ 169 'Prints help about the available commands', 170 sub { 171 for my $cmd (sort keys %commands) { 172 printf "%-10s %s\n", $cmd, $commands{$cmd}[0]; 173 } 174 }, 175 ], 176 clear => [ 177 'Clears the internal state', 178 sub { 179 undef $hash; 180 } 181 ], 182 read => [ 183 'Parses XML from a file into the internal state', 184 sub { 185 my $file = shift @ARGV; 186 if ($file eq '-') { 187 if (isatty *STDIN) { 188 print STDERR "Reading XML from STDIN. Press ^D to end\n"; 189 } 190 $hash = read_xml *STDIN; 191 } else { 192 open FH, '<', $file; 193 $hash = read_xml *FH; 194 close FH; 195 } 196 }, 197 1, 198 ], 199 write => [ 200 'Writes the current internal state as XML to a file', 201 sub { 202 my $file = shift @ARGV; 203 if ($file eq '-') { 204 write_xml $hash, *STDOUT; 205 } else { 206 open FH, '>', $file; 207 write_xml $hash, *FH; 208 close FH; 209 } 210 }, 211 1, 212 ], 213 debug => [ 214 'Dumps the current state to stdout', 215 sub { 216 print Dumper $hash; 217 }, 218 ], 219 count => [ 220 'Returns the number of servlets in the internal state', 221 sub { 222 my $count = 0; 223 if (defined $hash->{servlet}) { 224 $count = 1; 225 my $servlets = $hash->{servlet}; 226 if (ref $servlets eq 'ARRAY') { 227 $count = scalar @{$hash->{servlet}}; 228 } 229 } 230 print $count, "\n"; 231 }, 232 ], 233 list => [ 234 'Lists the servlets in the current internal state', 235 sub { 236 if (defined $hash->{servlet}) { 237 my $servlets = $hash->{servlet}; 238 if (ref $servlets eq 'ARRAY') { 239 for my $servlet (@{$hash->{servlet}}) { 240 print $servlet->{'servlet-name'}, "\n"; 241 } 242 } else { 243 print $servlets->{'servlet-name'}, "\n"; 244 } 245 } else { 246 print STDERR "No servlets found. Was valid XML provided?\n"; 247 } 248 }, 249 ], 250 ); 251 252 # Check that all given commands are valid 253 my $argc = 0; 254 for my $cmd (@ARGV) { 255 if ($argc > 0) { 256 # skip arguments to a previous command 257 $argc --; 258 } elsif (defined $commands{$cmd}) { 259 # get the argument count of a valid command 260 $argc = @{$commands{$cmd}}[2]; 261 defined $argc or ($argc = 0); 262 } else { 263 # invalid command 264 print STDERR "Valid commands are:\n"; 265 @{$commands{help}}[1]->(); 266 die "Invalid command '" . $cmd . "'\n"; 267 } 268 } 269 270 # Run the commands 171 271 while (@ARGV) { 172 for (shift) { 173 /^read$/i && do { 174 $hash = read_servlets (shift); 175 last; 176 }; 177 /^write$/i && do { 178 write_servlets ($hash, shift); 179 last; 180 }; 181 /^debug$/i && do { 182 print Dumper $hash; 183 last; 184 }; 185 /^count$/i && do { 186 my $servlets = $hash->{servlet}; 187 my $count = 1; 188 if (ref $servlets eq 'ARRAY') { 189 $count = scalar @{$hash->{servlet}}; 190 } 191 print "Found ", $count, " servlets\n"; 192 last; 193 }; 194 /^list$/i && do { 195 print "Servlets:\n"; 196 my $servlets = $hash->{servlet}; 197 if (ref $servlets eq 'ARRAY') { 198 for my $servlet (@{$hash->{servlet}}) { 199 print " ", $servlet->{'servlet-name'}, "\n"; 200 } 201 } else { 202 print " ", $servlets->{'servlet-name'}, "\n"; 203 } 204 last; 205 }; 206 } 207 } 272 @{$commands{lc shift}}[1]->(); 273 }
Note:
See TracChangeset
for help on using the changeset viewer.