source: main/trunk/package-kits/scripts/gs-mkservlet.pl@ 29684

#!/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,
        '>>'
    );
}