Index: /main/trunk/package-kits/scripts/gs-mkservlet.pl
===================================================================
--- /main/trunk/package-kits/scripts/gs-mkservlet.pl	(revision 29684)
+++ /main/trunk/package-kits/scripts/gs-mkservlet.pl	(revision 29684)
@@ -0,0 +1,115 @@
+#!/usr/bin/env perl 
+
+use strict;
+use warnings;
+use utf8;
+
+use lib 'perllib';
+use Greenstone::XML::Tidy;
+use Greenstone::Interface;
+use Greenstone::Site;
+use Hash::Ordered;
+
+my $delete = 0;
+my $file = "/usr/share/greenstone/web/WEB-INF/servlets.xml";
+my $description = "";
+my $class = "org.greenstone.gsdl3.LibraryServlet";
+my ($name, $site, $interface);
+
+while (@ARGV) {
+    for (shift) {
+        if (/^-delete$/) {
+            $delete = 1;
+        } elsif (/^-file$/) {
+            ($file = shift) or die "Expected -file <file>\n";
+        } elsif (/^-name$/) {
+            ($name = shift) or die "Expected -name <name>\n";
+        } elsif (/^-desc\(ription\)?$/) {
+            ($description = shift) or die "Expected -desc <description>\n";
+        } elsif (/^-class$/) {
+            ($class = shift) or die "Expected -class <class>\n";
+        } elsif (/^-site$/) {
+            ($site = shift) or die "Expected -site <site>\n";
+        } elsif (/^-interface$/) {
+            ($interface = shift) or die "Expected -interface <interface>\n";
+        } else {
+            die "Unknown flag '$_'\n";
+        }
+    }
+}
+
+if ($delete) {
+    my $servlets = read_xml $file;
+
+    my $deleted = 0;
+
+    my $servlet_array = $servlets->get ("servlet");
+    if (ref $servlet_array eq 'ARRAY') {
+        my @array = grep { $_->get ("servlet-name") ne $name } @$servlet_array;
+        $deleted = (scalar @array < scalar @$servlet_array);
+        $servlets->set ("servlet" => \@array);
+    } elsif ($servlet_array->get ("servlet-name") eq $name) {
+        $servlets->delete ("servlet");
+        $deleted = 1;
+    }
+
+    die "Servlet not found\n" unless $deleted;
+    
+    write_xml ($servlets, $file);
+} else {
+    (defined $name and defined $site and defined $interface) or die "Requires name, site, interface\n";
+
+    Greenstone::Site->new ($site)->exists or die "Site '$site' does not exist\n";
+    Greenstone::Interface->new ($interface)->exists or die "Interface '$interface' does not exist\n";
+
+    my $servlets = read_xml $file;
+
+    my $servlet_array = $servlets->get ("servlet");
+    unless (ref $servlet_array eq 'ARRAY') {
+        $servlet_array = [ $servlet_array ];
+    }
+    for my $servlet (@$servlet_array) {
+        $servlet->get ("servlet-name") eq $name and die "A servlet already exists with that name\n";
+        my $servlet_params = $servlet->get ("init-param");
+        unless (ref $servlet_params eq 'ARRAY') {
+            $servlet_params = [ $servlet_params ];
+        }
+        my ($servlet_site, $servlet_interface);
+        for my $param (@$servlet_params) {
+            my $key = $param->get ("param-name");
+            my $val = $param->get ("param-value");
+            if ($key eq "site_name") {
+                $servlet_site = $val;
+            } elsif ($key eq "interface_name") {
+                $servlet_interface = $val;
+            }
+        }
+        $servlet_site eq $site and $servlet_interface eq $interface and
+            die "A servlet already exists with that combination of site and interface\n";
+    }
+
+    # Actually make the servlet now
+
+    sub init_param {
+        return Hash::Ordered->new (
+            'param-name' => shift,
+            'param-value'=> shift,
+        );
+    }
+
+    write_xml (
+        Hash::Ordered->new (
+            'servlet' => Hash::Ordered->new (
+                'servlet-name' => $name,
+                'description'  => $description,
+                'servlet-class'=> $class,
+                'init-param'   => [
+                    init_param ('site_name', $site),
+                    init_param ('interface_name', $interface),
+                ],
+            ),
+        ),
+        $file,
+        '>>'
+    );
+}
Index: /main/trunk/package-kits/scripts/perllib/Greenstone/XML/Tidy.pm
===================================================================
--- /main/trunk/package-kits/scripts/perllib/Greenstone/XML/Tidy.pm	(revision 29683)
+++ /main/trunk/package-kits/scripts/perllib/Greenstone/XML/Tidy.pm	(revision 29684)
@@ -116,8 +116,9 @@
 # Writes a data structure to an XML file
 sub write_xml {
-    my ($hash, $file) = @_;
+    my ($hash, $file, $mode) = @_;
+    $mode = '>' unless defined $mode;
     my $FH;
     if ($file ne '-') {
-        unless (open $FH, '>:utf8', $file) {
+        unless (open $FH, $mode . ':utf8', $file) {
             print STDERR "Failed to open output file '$file': $!\n";
             return 0;
