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