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

Revision 29665, 5.6 KB (checked in by jts21, 6 years ago)

Added a perl script for managing the servlets XML fragment.

Currently can read the XML into a fairly sane looking data structure, and write it back out without breaking the file (although the elements do get reordered because they are stored in a hash).

Started adding some CLI functionality for managing the servlets (so far just reading and writing the XML, and counting and listing the servlets names)

  • 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='
56<!DOCTYPE doc [<!ENTITY real_doc SYSTEM "' . $file . '">] >
57    <__root__>
58        &real_doc;
59    </__root__>
60';
61    # Parse the data using XML::Parser
62    my $data = new XML::Parser (Style => 'Tree')->parse ($xml);
63
64    sub tidy {
65        my %hash;
66        # If the element has attributes, add them to the hash
67        my $attr = shift;
68        if (scalar keys %$attr > 0) {
69            $hash{'.attr'} = $attr;
70        }
71        # Read any child elements or text value
72        while (@_) {
73            my $element = shift;
74            my $value   = shift;
75            if ($element eq 0) {
76                $value =~ /^\s*$/ || ($hash{'.value'} .= $value);
77            } else {
78                # If there is more than one of a single tupe of child element,
79                # That child element must become an array
80                if (defined $hash{$element}) {
81                    unless (ref $hash{$element} eq 'ARRAY') {
82                        $hash{$element} = [ $hash{$element} ];
83                    }
84                    push @{$hash{$element}}, tidy (@{$value});
85                } else {
86                    $hash{$element} = tidy (@{$value});
87                }
88            }
89        }
90        # If the element only has a value, it can become a scalar
91        if (scalar keys %hash == 1 and defined $hash{'.value'}) {
92            return $hash{'.value'};
93        }
94        return \%hash;
95    }
96    return tidy (@{@$data[1]});
97}
98
99# Writes a data structure to an XML file
100sub write_servlets {
101    my ($hash, $file) = @_;
102    open OUT, '>', $file;
103    sub open_tag {
104        my ($indent, $tag, $attr) = @_;
105        print OUT $indent, "<", $tag;
106        if (defined $attr) {
107            for my $key (sort keys %$attr) {
108                print OUT " ", $key, '="', $attr->{$key}, '"';
109            }
110        }
111        print OUT ">";
112    }
113    sub write_xml {
114        my ($indent, $hash) = @_;
115        for my $key (sort keys %$hash) {
116            $key eq '.attr' && next;
117            my $val = $hash->{$key};
118            $key eq '.value' && do {
119                print OUT $val, "\n";
120                next;
121            };
122            for (ref $val) {
123                /^ARRAY$/ && do {
124                    for my $element (@$val) {
125                        open_tag ($indent, $key, $element->{'.attr'});
126                        for (ref $element) {
127                            /^HASH$/ && do {
128                                print OUT "\n";
129                                write_xml ("  $indent", $element);
130                                print OUT $indent, "</", $key, ">\n";
131                                last;
132                            };
133                            print OUT $element, "</", $key, ">\n";
134                        }
135                    }
136                    last;
137                };
138                /^HASH$/ && do {
139                    open_tag ($indent, $key, $val->{'.attr'});
140                    # If the element only has a value with attributes,
141                    # it can be formatted on one line
142                    if (scalar keys %$val == 2 and defined $val->{'.value'}) {
143                        print OUT $val->{'.value'}, "</", $key, ">\n";
144                    } else {
145                        print OUT "\n";
146                        write_xml ("  $indent", $val);
147                        print OUT $indent, "</", $key, ">\n";
148                    }
149                    last;
150                };
151                open_tag ($indent, $key);
152                print OUT $val;
153                print OUT "</", $key, ">\n";
154            }
155        }
156    }
157    write_xml ("", $hash);
158    close OUT;
159}
160
161my $hash;
162# Hackish non-interactive CLI parser
163while (@ARGV) {
164    for (shift) {
165        /^read$/i && do {
166            $hash = read_servlets (shift);
167            last;
168        };
169        /^write$/i && do {
170            write_servlets ($hash, shift);
171            last;
172        };
173        /^debug$/i && do {
174            print Dumper $hash;
175            last;
176        };
177        /^count$/i && do {
178            print "Found ", scalar @{$hash->{servlet}}, " servlets\n";
179            last;
180        };
181        /^list$/i && do {
182            print "Servlets:\n";
183            for my $servlet (@{$hash->{servlet}}) {
184                print "  ", $servlet->{'servlet-name'}, "\n";
185            }
186            last;
187        };
188    }
189}
Note: See TracBrowser for help on using the browser.