root/main/trunk/package-kits/linux/files/servlet.pl @ 29666

Revision 29666, 6.0 KB (checked in by jts21, 6 years ago)

Fixed bug in CLI commands (was assuming there to be multiple servlets)

  • Property svn:executable set to *
Line 
1#!/usr/bin/env perl
2
3use strict;
4use warnings;
5use utf8;
6
7use XML::Parser;
8use Data::Dumper;
9
10# Reads the servlets partial XML file using XML::Parser,
11# Then converts the obtained data structure to a more readable one
12# Example conversion:
13=xml
14<servlet>
15  <servlet-name>library</servlet-name>
16  <description attribute="example">The standard gsdl3 library program</description>
17  <servlet-class>org.greenstone.gsdl3.LibraryServlet</servlet-class>
18  <init-param>
19    <param-name>library_name</param-name>
20    <param-value>library</param-value>
21  </init-param>
22  <init-param>
23    <param-name>site_name</param-name>
24    <param-value>localsite</param-value>
25  </init-param>
26</servlet>
27=cut
28=data_structure
29{
30    'servlet' => {
31        'servlet-class' => 'org.greenstone.gsdl3.LibraryServlet',
32        'servlet-name' => 'library',
33        'description' => {
34            '.value' => 'The standard gsdl3 library program',
35            '.attr' => {
36                'attribute' => 'example'
37            }
38        },
39        'init-param' => [
40            {
41                'param-value' => 'library',
42                'param-name' => 'library_name'
43            },
44            {
45                'param-name' => 'site_name',
46                'param-value' => 'localsite'
47            }
48        ]
49    }
50}
51=cut
52sub read_servlets {
53    my $file = shift;
54    # The xml needs a root element, so we wrap it in one
55    my $xml='<!DOCTYPE doc [<!ENTITY real_doc SYSTEM "' . $file . '">] >
56    <__root__>
57        &real_doc;
58    </__root__>
59';
60    # Parse the data using XML::Parser
61    my $data = new XML::Parser (Style => 'Tree')->parse ($xml);
62
63    sub tidy {
64        my %hash;
65        # If the element has attributes, add them to the hash
66        my $attr = shift;
67        if (scalar keys %$attr > 0) {
68            $hash{'.attr'} = $attr;
69        }
70        # Read any child elements or text value
71        while (@_) {
72            my $element = shift;
73            my $value   = shift;
74            if ($element eq 0) {
75                $value =~ /^\s*$/ || ($hash{'.value'} .= $value);
76            } else {
77                # If there is more than one of a single tupe of child element,
78                # That child element must become an array
79                if (defined $hash{$element}) {
80                    unless (ref $hash{$element} eq 'ARRAY') {
81                        $hash{$element} = [ $hash{$element} ];
82                    }
83                    push @{$hash{$element}}, tidy (@{$value});
84                } else {
85                    $hash{$element} = tidy (@{$value});
86                }
87            }
88        }
89        # If the element only has a value, it can become a scalar
90        if (scalar keys %hash == 1 and defined $hash{'.value'}) {
91            return $hash{'.value'};
92        }
93        return \%hash;
94    }
95    return tidy (@{@$data[1]});
96}
97
98# Writes a data structure to an XML file
99sub write_servlets {
100    my ($hash, $file) = @_;
101    open OUT, '>', $file;
102    sub open_tag {
103        my ($indent, $tag, $attr) = @_;
104        print OUT $indent, "<", $tag;
105        if (defined $attr) {
106            for my $key (sort keys %$attr) {
107                print OUT " ", $key, '="', $attr->{$key}, '"';
108            }
109        }
110        print OUT ">";
111    }
112    sub write_xml {
113        my ($indent, $hash) = @_;
114        for my $key (sort keys %$hash) {
115            $key eq '.attr' && next;
116            my $val = $hash->{$key};
117            $key eq '.value' && do {
118                print OUT $val, "\n";
119                next;
120            };
121            for (ref $val) {
122                /^ARRAY$/ && do {
123                    for my $element (@$val) {
124                        open_tag ($indent, $key, $element->{'.attr'});
125                        for (ref $element) {
126                            /^HASH$/ && do {
127                                print OUT "\n";
128                                write_xml ("  $indent", $element);
129                                print OUT $indent, "</", $key, ">\n";
130                                last;
131                            };
132                            print OUT $element, "</", $key, ">\n";
133                        }
134                    }
135                    last;
136                };
137                /^HASH$/ && do {
138                    open_tag ($indent, $key, $val->{'.attr'});
139                    # If the element only has a value with attributes,
140                    # it can be formatted on one line
141                    if (scalar keys %$val == 2 and defined $val->{'.value'}) {
142                        print OUT $val->{'.value'}, "</", $key, ">\n";
143                    } else {
144                        print OUT "\n";
145                        write_xml ("  $indent", $val);
146                        print OUT $indent, "</", $key, ">\n";
147                    }
148                    last;
149                };
150                open_tag ($indent, $key);
151                print OUT $val;
152                print OUT "</", $key, ">\n";
153            }
154        }
155    }
156    write_xml ("", $hash);
157    close OUT;
158}
159
160my $hash;
161# Hackish non-interactive CLI parser
162while (@ARGV) {
163    for (shift) {
164        /^read$/i && do {
165            $hash = read_servlets (shift);
166            last;
167        };
168        /^write$/i && do {
169            write_servlets ($hash, shift);
170            last;
171        };
172        /^debug$/i && do {
173            print Dumper $hash;
174            last;
175        };
176        /^count$/i && do {
177            my $servlets = $hash->{servlet};
178            my $count = 1;
179            if (ref $servlets eq 'ARRAY') {
180                $count = scalar @{$hash->{servlet}};
181            }
182            print "Found ", $count, " servlets\n";
183            last;
184        };
185        /^list$/i && do {
186            print "Servlets:\n";
187            my $servlets = $hash->{servlet};
188            if (ref $servlets eq 'ARRAY') {
189                for my $servlet (@{$hash->{servlet}}) {
190                    print "  ", $servlet->{'servlet-name'}, "\n";
191                }
192            } else {
193                print "  ", $servlets->{'servlet-name'}, "\n";
194            }
195            last;
196        };
197    }
198}
Note: See TracBrowser for help on using the browser.