Changeset 29673


Ignore:
Timestamp:
2015-01-09T11:51:55+13:00 (9 years ago)
Author:
Jeremy Symon
Message:

Moved servlet XML handling code to a module

Location:
main/trunk/package-kits/scripts
Files:
4 added
1 moved

Legend:

Unmodified
Added
Removed

  • main/trunk/package-kits/scripts/gs-servlet.pl

    r29672 r29673  
    55use utf8;
    66
    7 use XML::Parser;
    87use Data::Dumper;
    98use POSIX 'isatty';
    109
    11 # Reads the servlets partial XML file using XML::Parser,
    12 # Then converts the obtained data structure to a more readable one
    13 # Example conversion:
    14 =xml
    15 <servlet>
    16   <servlet-name>library</servlet-name>
    17   <description attribute="example">The standard gsdl3 library program</description>
    18   <servlet-class>org.greenstone.gsdl3.LibraryServlet</servlet-class>
    19   <init-param>
    20     <param-name>library_name</param-name>
    21     <param-value>library</param-value>
    22   </init-param>
    23   <init-param>
    24     <param-name>site_name</param-name>
    25     <param-value>localsite</param-value>
    26   </init-param>
    27 </servlet>
    28 =cut
    29 =data_structure
    30 {
    31     'servlet' => {
    32         'servlet-class' => 'org.greenstone.gsdl3.LibraryServlet',
    33         'servlet-name' => 'library',
    34         'description' => {
    35             '.value' => 'The standard gsdl3 library program',
    36             '.attr' => {
    37                 'attribute' => 'example'
    38             }
    39         },
    40         'init-param' => [
    41             {
    42                 'param-value' => 'library',
    43                 'param-name' => 'library_name'
    44             },
    45             {
    46                 'param-name' => 'site_name',
    47                 'param-value' => 'localsite'
    48             }
    49         ]
    50     }
    51 }
    52 =cut
    53 sub read_xml {
    54     my $FH = shift;
    55     local $/ = undef;
    56     my $xml = <$FH>;
    57     # The xml needs a root element, so we wrap it in one
    58     $xml='<__root__>' . $xml . '</__root__>';
    59     # Parse the data using XML::Parser
    60     my $data = new XML::Parser (Style => 'Tree')->parse ($xml);
    61 
    62     sub tidy {
    63         my %hash;
    64         # If the element has attributes, add them to the hash
    65         my $attr = shift;
    66         if (scalar keys %$attr > 0) {
    67             $hash{'.attr'} = $attr;
    68         }
    69         # Read any child elements or text value
    70         while (@_) {
    71             my $element = shift;
    72             my $value   = shift;
    73             if ($element eq 0) {
    74                 $value =~ /^\s*$/ || ($hash{'.value'} .= $value);
    75             } else {
    76                 # If there is more than one of a single tupe of child element,
    77                 # That child element must become an array
    78                 if (defined $hash{$element}) {
    79                     unless (ref $hash{$element} eq 'ARRAY') {
    80                         $hash{$element} = [ $hash{$element} ];
    81                     }
    82                     push @{$hash{$element}}, tidy (@{$value});
    83                 } else {
    84                     $hash{$element} = tidy (@{$value});
    85                 }
    86             }
    87         }
    88         # If the element only has a value, it can become a scalar
    89         if (scalar keys %hash == 1 and defined $hash{'.value'}) {
    90             return $hash{'.value'};
    91         }
    92         return \%hash;
    93     }
    94     return tidy (@{@$data[1]});
    95 }
    96 
    97 # Writes a data structure to an XML file
    98 sub write_xml {
    99     my ($hash, $FH) = @_;
    100     select $FH;
    101     sub open_tag {
    102         my ($indent, $tag, $attr) = @_;
    103         print $indent, "<", $tag;
    104         if (defined $attr) {
    105             for my $key (sort keys %$attr) {
    106                 print " ", $key, '="', $attr->{$key}, '"';
    107             }
    108         }
    109         print ">";
    110     }
    111     sub write_element {
    112         my ($indent, $hash) = @_;
    113         for my $key (sort keys %$hash) {
    114             $key eq '.attr' && next;
    115             my $val = $hash->{$key};
    116             $key eq '.value' && do {
    117                 print $val, "\n";
    118                 next;
    119             };
    120             for (ref $val) {
    121                 /^ARRAY$/ && do {
    122                     for my $element (@$val) {
    123                         open_tag ($indent, $key, $element->{'.attr'});
    124                         for (ref $element) {
    125                             /^HASH$/ && do {
    126                                 print "\n";
    127                                 write_element ("  $indent", $element);
    128                                 print $indent, "</", $key, ">\n";
    129                                 last;
    130                             };
    131                             print $element, "</", $key, ">\n";
    132                         }
    133                     }
    134                     last;
    135                 };
    136                 /^HASH$/ && do {
    137                     open_tag ($indent, $key, $val->{'.attr'});
    138                     # If the element only has a value with attributes,
    139                     # it can be formatted on one line
    140                     if (scalar keys %$val == 2 and defined $val->{'.value'}) {
    141                         print $val->{'.value'}, "</", $key, ">\n";
    142                     } else {
    143                         print "\n";
    144                         write_element ("  $indent", $val);
    145                         print $indent, "</", $key, ">\n";
    146                     }
    147                     last;
    148                 };
    149                 open_tag ($indent, $key);
    150                 print $val;
    151                 print "</", $key, ">\n";
    152             }
    153         }
    154     }
    155     write_element ("", $hash);
    156     select STDOUT;
    157 }
     10use lib 'perllib';
     11use XML::Tidy;
    15812
    15913my $hash;
Note: See TracChangeset for help on using the changeset viewer.