Changeset 29668

Show
Ignore:
Timestamp:
07.01.2015 12:09:44 (4 years ago)
Author:
jts21
Message:

Tidied up command parsing

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • main/trunk/package-kits/linux/files/servlet.pl

    r29667 r29668  
    77use XML::Parser; 
    88use Data::Dumper; 
     9use POSIX 'isatty'; 
    910 
    1011# Reads the servlets partial XML file using XML::Parser, 
     
    5051} 
    5152=cut 
    52 sub read_servlets { 
    53     my $file = shift; 
     53sub read_xml { 
     54    my $FH = shift; 
     55    local $/ = undef; 
     56    my $xml = <$FH>; 
    5457    # 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 '; 
     58    $xml='<__root__>' . $xml . '</__root__>'; 
    6059    # Parse the data using XML::Parser 
    6160    my $data = new XML::Parser (Style => 'Tree')->parse ($xml); 
     
    9796 
    9897# Writes a data structure to an XML file 
    99 sub write_servlets { 
    100     my ($hash, $file) = @_; 
    101     my $OUT; 
    102     if ($file ne '-') { 
    103         open $OUT, '>', $file; 
    104         select $OUT; 
    105     } 
     98sub write_xml { 
     99    my ($hash, $FH) = @_; 
     100    select $FH; 
    106101    sub open_tag { 
    107102        my ($indent, $tag, $attr) = @_; 
     
    114109        print ">"; 
    115110    } 
    116     sub write_xml { 
     111    sub write_element { 
    117112        my ($indent, $hash) = @_; 
    118113        for my $key (sort keys %$hash) { 
     
    130125                            /^HASH$/ && do { 
    131126                                print "\n"; 
    132                                 write_xml ("  $indent", $element); 
     127                                write_element ("  $indent", $element); 
    133128                                print $indent, "</", $key, ">\n"; 
    134129                                last; 
     
    147142                    } else { 
    148143                        print "\n"; 
    149                         write_xml ("  $indent", $val); 
     144                        write_element ("  $indent", $val); 
    150145                        print $indent, "</", $key, ">\n"; 
    151146                    } 
     
    158153        } 
    159154    } 
    160     write_xml ("", $hash); 
    161     if (defined $OUT) { 
    162         close $OUT; 
    163     } 
     155    write_element ("", $hash); 
    164156    select STDOUT; 
    165157} 
    166 # The code above is for generic XML read/writing 
    167 # The code below is specific to Greenstone's servlets.xml 
    168158 
    169159my $hash; 
    170 # Hackish non-interactive CLI parser 
     160my %commands; 
     161# Command structure: 
     162# key: Case-insensitive name of the command 
     163# val: Array of info about the command 
     164#      [0]: Description of the command 
     165#      [1]: Function that is run for the command 
     166#      [2]: Number of arguments of the command (if any) 
     167%commands = ( 
     168    help => [ 
     169        'Prints help about the available commands', 
     170        sub { 
     171            for my $cmd (sort keys %commands) { 
     172                printf "%-10s %s\n", $cmd, $commands{$cmd}[0]; 
     173            } 
     174        }, 
     175    ], 
     176    clear => [ 
     177        'Clears the internal state', 
     178        sub { 
     179            undef $hash; 
     180        } 
     181    ], 
     182    read => [ 
     183        'Parses XML from a file into the internal state', 
     184        sub { 
     185            my $file = shift @ARGV; 
     186            if ($file eq '-') { 
     187                if (isatty *STDIN) { 
     188                    print STDERR "Reading XML from STDIN. Press ^D to end\n"; 
     189                } 
     190                $hash = read_xml *STDIN; 
     191            } else { 
     192                open FH, '<', $file; 
     193                $hash = read_xml *FH; 
     194                close FH; 
     195            } 
     196        }, 
     197        1, 
     198    ], 
     199    write => [ 
     200        'Writes the current internal state as XML to a file', 
     201        sub { 
     202            my $file = shift @ARGV; 
     203            if ($file eq '-') { 
     204                write_xml $hash, *STDOUT; 
     205            } else { 
     206                open FH, '>', $file; 
     207                write_xml $hash, *FH; 
     208                close FH; 
     209            } 
     210        }, 
     211        1, 
     212    ], 
     213    debug => [ 
     214        'Dumps the current state to stdout', 
     215        sub { 
     216            print Dumper $hash; 
     217        }, 
     218    ], 
     219    count => [ 
     220        'Returns the number of servlets in the internal state', 
     221        sub { 
     222            my $count = 0; 
     223            if (defined $hash->{servlet}) { 
     224                $count = 1; 
     225                my $servlets = $hash->{servlet}; 
     226                if (ref $servlets eq 'ARRAY') { 
     227                    $count = scalar @{$hash->{servlet}}; 
     228                } 
     229            } 
     230            print $count, "\n"; 
     231        }, 
     232    ], 
     233    list => [ 
     234        'Lists the servlets in the current internal state', 
     235        sub { 
     236            if (defined $hash->{servlet}) { 
     237                my $servlets = $hash->{servlet}; 
     238                if (ref $servlets eq 'ARRAY') { 
     239                    for my $servlet (@{$hash->{servlet}}) { 
     240                        print $servlet->{'servlet-name'}, "\n"; 
     241                    } 
     242                } else { 
     243                    print $servlets->{'servlet-name'}, "\n"; 
     244                } 
     245            } else { 
     246                print STDERR "No servlets found. Was valid XML provided?\n"; 
     247            } 
     248        }, 
     249    ], 
     250); 
     251 
     252# Check that all given commands are valid 
     253my $argc = 0; 
     254for my $cmd (@ARGV) { 
     255    if ($argc > 0) { 
     256        # skip arguments to a previous command 
     257        $argc --; 
     258    } elsif (defined $commands{$cmd}) { 
     259        # get the argument count of a valid command 
     260        $argc = @{$commands{$cmd}}[2]; 
     261        defined $argc or ($argc = 0); 
     262    } else { 
     263        # invalid command 
     264        print STDERR "Valid commands are:\n"; 
     265        @{$commands{help}}[1]->(); 
     266        die "Invalid command '" . $cmd . "'\n"; 
     267    } 
     268} 
     269 
     270# Run the commands 
    171271while (@ARGV) { 
    172     for (shift) { 
    173         /^read$/i && do { 
    174             $hash = read_servlets (shift); 
    175             last; 
    176         }; 
    177         /^write$/i && do { 
    178             write_servlets ($hash, shift); 
    179             last; 
    180         }; 
    181         /^debug$/i && do { 
    182             print Dumper $hash; 
    183             last; 
    184         }; 
    185         /^count$/i && do { 
    186             my $servlets = $hash->{servlet}; 
    187             my $count = 1; 
    188             if (ref $servlets eq 'ARRAY') { 
    189                 $count = scalar @{$hash->{servlet}}; 
    190             } 
    191             print "Found ", $count, " servlets\n"; 
    192             last; 
    193         }; 
    194         /^list$/i && do { 
    195             print "Servlets:\n"; 
    196             my $servlets = $hash->{servlet}; 
    197             if (ref $servlets eq 'ARRAY') { 
    198                 for my $servlet (@{$hash->{servlet}}) { 
    199                     print "  ", $servlet->{'servlet-name'}, "\n"; 
    200                 } 
    201             } else { 
    202                 print "  ", $servlets->{'servlet-name'}, "\n"; 
    203             } 
    204             last; 
    205         }; 
    206     } 
    207 } 
     272    @{$commands{lc shift}}[1]->(); 
     273}