Index: /main/trunk/package-kits/linux/files/servlet.pl
===================================================================
--- /main/trunk/package-kits/linux/files/servlet.pl	(revision 29665)
+++ /main/trunk/package-kits/linux/files/servlet.pl	(revision 29665)
@@ -0,0 +1,189 @@
+#!/usr/bin/env perl 
+
+use strict;
+use warnings;
+use utf8;
+
+use XML::Parser;
+use Data::Dumper;
+
+# Reads the servlets partial XML file using XML::Parser,
+# Then converts the obtained data structure to a more readable one
+# Example conversion:
+=xml
+<servlet>
+  <servlet-name>library</servlet-name>
+  <description attribute="example">The standard gsdl3 library program</description>
+  <servlet-class>org.greenstone.gsdl3.LibraryServlet</servlet-class>
+  <init-param>
+    <param-name>library_name</param-name>
+    <param-value>library</param-value>
+  </init-param>
+  <init-param>
+    <param-name>site_name</param-name>
+    <param-value>localsite</param-value>
+  </init-param>
+</servlet>
+=cut
+=data_structure
+{
+    'servlet' => {
+        'servlet-class' => 'org.greenstone.gsdl3.LibraryServlet',
+        'servlet-name' => 'library',
+        'description' => {
+            '.value' => 'The standard gsdl3 library program',
+            '.attr' => {
+                'attribute' => 'example'
+            }
+        },
+        'init-param' => [
+            {
+                'param-value' => 'library',
+                'param-name' => 'library_name'
+            },
+            {
+                'param-name' => 'site_name',
+                'param-value' => 'localsite'
+            }
+        ]
+    }
+}
+=cut
+sub read_servlets {
+    my $file = shift;
+    # The xml needs a root element, so we wrap it in one
+    my $xml='
+<!DOCTYPE doc [<!ENTITY real_doc SYSTEM "' . $file . '">] >
+    <__root__>
+        &real_doc;
+    </__root__>
+';
+    # Parse the data using XML::Parser
+    my $data = new XML::Parser (Style => 'Tree')->parse ($xml);
+
+    sub tidy {
+        my %hash;
+        # If the element has attributes, add them to the hash
+        my $attr = shift;
+        if (scalar keys %$attr > 0) {
+            $hash{'.attr'} = $attr;
+        }
+        # Read any child elements or text value
+        while (@_) {
+            my $element = shift;
+            my $value   = shift;
+            if ($element eq 0) {
+                $value =~ /^\s*$/ || ($hash{'.value'} .= $value);
+            } else {
+                # If there is more than one of a single tupe of child element,
+                # That child element must become an array
+                if (defined $hash{$element}) {
+                    unless (ref $hash{$element} eq 'ARRAY') {
+                        $hash{$element} = [ $hash{$element} ];
+                    }
+                    push @{$hash{$element}}, tidy (@{$value});
+                } else {
+                    $hash{$element} = tidy (@{$value});
+                }
+            }
+        }
+        # If the element only has a value, it can become a scalar
+        if (scalar keys %hash == 1 and defined $hash{'.value'}) {
+            return $hash{'.value'};
+        }
+        return \%hash;
+    }
+    return tidy (@{@$data[1]});
+}
+
+# Writes a data structure to an XML file
+sub write_servlets {
+    my ($hash, $file) = @_;
+    open OUT, '>', $file;
+    sub open_tag {
+        my ($indent, $tag, $attr) = @_;
+        print OUT $indent, "<", $tag;
+        if (defined $attr) {
+            for my $key (sort keys %$attr) {
+                print OUT " ", $key, '="', $attr->{$key}, '"';
+            }
+        }
+        print OUT ">";
+    }
+    sub write_xml {
+        my ($indent, $hash) = @_;
+        for my $key (sort keys %$hash) {
+            $key eq '.attr' && next;
+            my $val = $hash->{$key};
+            $key eq '.value' && do {
+                print OUT $val, "\n";
+                next;
+            };
+            for (ref $val) {
+                /^ARRAY$/ && do {
+                    for my $element (@$val) {
+                        open_tag ($indent, $key, $element->{'.attr'});
+                        for (ref $element) {
+                            /^HASH$/ && do {
+                                print OUT "\n";
+                                write_xml ("  $indent", $element);
+                                print OUT $indent, "</", $key, ">\n";
+                                last;
+                            };
+                            print OUT $element, "</", $key, ">\n";
+                        }
+                    }
+                    last;
+                };
+                /^HASH$/ && do {
+                    open_tag ($indent, $key, $val->{'.attr'});
+                    # If the element only has a value with attributes,
+                    # it can be formatted on one line
+                    if (scalar keys %$val == 2 and defined $val->{'.value'}) {
+                        print OUT $val->{'.value'}, "</", $key, ">\n";
+                    } else {
+                        print OUT "\n";
+                        write_xml ("  $indent", $val);
+                        print OUT $indent, "</", $key, ">\n";
+                    }
+                    last;
+                };
+                open_tag ($indent, $key);
+                print OUT $val;
+                print OUT "</", $key, ">\n";
+            }
+        }
+    }
+    write_xml ("", $hash);
+    close OUT;
+}
+
+my $hash;
+# Hackish non-interactive CLI parser
+while (@ARGV) {
+    for (shift) {
+        /^read$/i && do {
+            $hash = read_servlets (shift);
+            last;
+        };
+        /^write$/i && do {
+            write_servlets ($hash, shift);
+            last;
+        };
+        /^debug$/i && do {
+            print Dumper $hash;
+            last;
+        };
+        /^count$/i && do {
+            print "Found ", scalar @{$hash->{servlet}}, " servlets\n";
+            last;
+        };
+        /^list$/i && do {
+            print "Servlets:\n";
+            for my $servlet (@{$hash->{servlet}}) {
+                print "  ", $servlet->{'servlet-name'}, "\n";
+            }
+            last;
+        };
+    }
+}
