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

#!/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 %params = (
    'file'          => "/usr/share/greenstone/web/WEB-INF/servlets.xml",
    'name'          => undef,
    'description'   => "",
    'class'         => "org.greenstone.gsdl3.LibraryServlet",
    'library'       => undef,
    'site'          => undef,
    'interface'     => undef,
    'receptionist'  => "DefaultReceptionist",
    'default_lang'  => "en",
);

while (@ARGV) {
    for (shift) {
        if (s/^-//) {
            if (/^delete$/) {
                $delete = 1;
                last;
            } elsif (exists $params{$_}) {
                ($params{$_} = shift) or die "Expected -$_ <$_>\n";
                last;
            }
        }
        die "Unknown flag '$_'\n";
    }
}

if ($delete) {
    my $servlets = read_xml $params{file};

    my $deleted = 0;

    my $servlet_array = $servlets->get ("servlet");
    if (ref $servlet_array eq 'ARRAY') {
        my @array = grep { $_->get ("servlet-name") ne $params{name} } @$servlet_array;
        $deleted = (scalar @array < scalar @$servlet_array);
        $servlets->set ("servlet" => \@array);
    } elsif ($servlet_array->get ("servlet-name") eq $params{name}) {
        $servlets->delete ("servlet");
        $deleted = 1;
    }

    die "Servlet not found\n" unless $deleted;
    
    write_xml ($servlets, $params{file});
} else {
    (defined $params{name} and defined $params{site} and defined $params{interface}) or die "Requires name, site, interface\n";

    Greenstone::Site->new ($params{site})->exists or die "Site '$params{site}' does not exist\n";
    Greenstone::Interface->new ($params{interface})->exists or die "Interface '$params{interface}' does not exist\n";

    my $servlets = read_xml $params{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 $params{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 $params{site} and $servlet_interface eq $params{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' => $params{name},
                'description'  => $params{description},
                'servlet-class'=> $params{class},
                'init-param'   => [
                    init_param ('library_name',
                        (defined $params{library} ? $params{library} : $params{name} )),
                    init_param ('site_name', $params{site}),
                    init_param ('interface_name', $params{interface}),
                    init_param ('receptionist_class', $params{receptionist}),
                    init_param ('default_lang', $params{default_lang}),
                ],
            ),
        ),
        $params{file},
        '>>'
    );
}