1 | #!/usr/bin/env perl
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 | use warnings;
|
---|
5 | use utf8;
|
---|
6 |
|
---|
7 | use lib 'perllib';
|
---|
8 | use Greenstone::XML::Tidy;
|
---|
9 | use Greenstone::Interface;
|
---|
10 | use Greenstone::Site;
|
---|
11 | use Hash::Ordered;
|
---|
12 |
|
---|
13 | my $delete = 0;
|
---|
14 | my %params = (
|
---|
15 | 'file' => "/usr/share/greenstone/web/WEB-INF/servlets.xml",
|
---|
16 | 'name' => undef,
|
---|
17 | 'description' => "",
|
---|
18 | 'class' => "org.greenstone.gsdl3.LibraryServlet",
|
---|
19 | 'library' => undef,
|
---|
20 | 'site' => undef,
|
---|
21 | 'interface' => undef,
|
---|
22 | 'receptionist' => "DefaultReceptionist",
|
---|
23 | 'default_lang' => "en",
|
---|
24 | );
|
---|
25 |
|
---|
26 | while (@ARGV) {
|
---|
27 | for (shift) {
|
---|
28 | if (s/^-//) {
|
---|
29 | if (/^delete$/) {
|
---|
30 | $delete = 1;
|
---|
31 | last;
|
---|
32 | } elsif (exists $params{$_}) {
|
---|
33 | ($params{$_} = shift) or die "Expected -$_ <$_>\n";
|
---|
34 | last;
|
---|
35 | }
|
---|
36 | }
|
---|
37 | die "Unknown flag '$_'\n";
|
---|
38 | }
|
---|
39 | }
|
---|
40 |
|
---|
41 | if ($delete) {
|
---|
42 | my $servlets = read_xml $params{file};
|
---|
43 |
|
---|
44 | my $deleted = 0;
|
---|
45 |
|
---|
46 | my $servlet_array = $servlets->get ("servlet");
|
---|
47 | if (ref $servlet_array eq 'ARRAY') {
|
---|
48 | my @array = grep { $_->get ("servlet-name") ne $params{name} } @$servlet_array;
|
---|
49 | $deleted = (scalar @array < scalar @$servlet_array);
|
---|
50 | $servlets->set ("servlet" => \@array);
|
---|
51 | } elsif ($servlet_array->get ("servlet-name") eq $params{name}) {
|
---|
52 | $servlets->delete ("servlet");
|
---|
53 | $deleted = 1;
|
---|
54 | }
|
---|
55 |
|
---|
56 | die "Servlet not found\n" unless $deleted;
|
---|
57 |
|
---|
58 | write_xml ($servlets, $params{file});
|
---|
59 | } else {
|
---|
60 | (defined $params{name} and defined $params{site} and defined $params{interface}) or die "Requires name, site, interface\n";
|
---|
61 |
|
---|
62 | Greenstone::Site->new ($params{site})->exists or die "Site '$params{site}' does not exist\n";
|
---|
63 | Greenstone::Interface->new ($params{interface})->exists or die "Interface '$params{interface}' does not exist\n";
|
---|
64 |
|
---|
65 | my $servlets = read_xml $params{file};
|
---|
66 |
|
---|
67 | my $servlet_array = $servlets->get ("servlet");
|
---|
68 | unless (ref $servlet_array eq 'ARRAY') {
|
---|
69 | $servlet_array = [ $servlet_array ];
|
---|
70 | }
|
---|
71 | for my $servlet (@$servlet_array) {
|
---|
72 | $servlet->get ("servlet-name") eq $params{name} and die "A servlet already exists with that name\n";
|
---|
73 | my $servlet_params = $servlet->get ("init-param");
|
---|
74 | unless (ref $servlet_params eq 'ARRAY') {
|
---|
75 | $servlet_params = [ $servlet_params ];
|
---|
76 | }
|
---|
77 | my ($servlet_site, $servlet_interface);
|
---|
78 | for my $param (@$servlet_params) {
|
---|
79 | my $key = $param->get ("param-name");
|
---|
80 | my $val = $param->get ("param-value");
|
---|
81 | if ($key eq "site_name") {
|
---|
82 | $servlet_site = $val;
|
---|
83 | } elsif ($key eq "interface_name") {
|
---|
84 | $servlet_interface = $val;
|
---|
85 | }
|
---|
86 | }
|
---|
87 | $servlet_site eq $params{site} and $servlet_interface eq $params{interface} and
|
---|
88 | die "A servlet already exists with that combination of site and interface\n";
|
---|
89 | }
|
---|
90 |
|
---|
91 | # Actually make the servlet now
|
---|
92 |
|
---|
93 | sub init_param {
|
---|
94 | return Hash::Ordered->new (
|
---|
95 | 'param-name' => shift,
|
---|
96 | 'param-value'=> shift,
|
---|
97 | );
|
---|
98 | }
|
---|
99 |
|
---|
100 | write_xml (
|
---|
101 | Hash::Ordered->new (
|
---|
102 | 'servlet' => Hash::Ordered->new (
|
---|
103 | 'servlet-name' => $params{name},
|
---|
104 | 'description' => $params{description},
|
---|
105 | 'servlet-class'=> $params{class},
|
---|
106 | 'init-param' => [
|
---|
107 | init_param ('library_name',
|
---|
108 | (defined $params{library} ? $params{library} : $params{name} )),
|
---|
109 | init_param ('site_name', $params{site}),
|
---|
110 | init_param ('interface_name', $params{interface}),
|
---|
111 | init_param ('receptionist_class', $params{receptionist}),
|
---|
112 | init_param ('default_lang', $params{default_lang}),
|
---|
113 | ],
|
---|
114 | ),
|
---|
115 | ),
|
---|
116 | $params{file},
|
---|
117 | '>>'
|
---|
118 | );
|
---|
119 | }
|
---|