Changeset 4778


Ignore:
Timestamp:
2003-06-24T13:11:34+12:00 (21 years ago)
Author:
mdewsnip
Message:

Modified the code for generating the usage texts to use the methods in the new PrintUsage module.

Location:
trunk/gsdl/perllib
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/gsdl/perllib/classify/BasClas.pm

    r4761 r4778  
    5353
    5454use parsargv;
     55use printusage;
    5556
    5657my $verbosity_list =
    … …  
    8586        'args'     => $arguments };
    8687
    87 sub print_xml_usage {
    88     my $self = shift (@_);
     88
     89sub print_xml_usage
     90{
     91    local $self = shift(@_);
     92
    8993    print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\n";
    9094    $self->print_xml();
    9195}
    9296
    93 sub print_xml {
    94     my $self = shift (@_);
    95     my $option_list = $self->{'option_list'};
    96     my $option = pop( @{$option_list} );
    97     if(defined $option)
    98     {
    99     print STDERR "<ClassInfo>\n";
    100     print STDERR "  <Name>$option->{'name'}</Name>\n";
    101     print STDERR "  <Desc>$option->{'desc'}</Desc>\n";
    102     print STDERR "  <Inherits>$option->{'inherits'}</Inherits>\n";
    103     print STDERR "  <Arguments>\n";
    104     if(defined $option->{'args'})
    105     {
    106         my $args = $option->{'args'};
    107         my $x;
    108         foreach $x ( @{$args} )
    109         {
    110         print STDERR "    <Option>\n";
    111         print STDERR "      <Name>$x->{'name'}</Name>\n";
    112         print STDERR "      <Desc>$x->{'desc'}</Desc>\n";
    113         print STDERR "      <Type>$x->{'type'}</Type>\n";
    114         print STDERR "      <Required>$x->{'reqd'}</Required>\n";
    115         if(defined $x->{'list'})
    116         {
    117             print STDERR "      <List>\n";
    118             my $list = $x->{'list'};
    119             my $y;
    120             foreach $y ( @{$list} )
    121             {
    122             print STDERR "        <Value>\n";
    123             print STDERR "          <Name>$y->{'name'}</Name>\n";
    124             print STDERR "          <Desc>$y->{'desc'}</Desc>\n";
    125             print STDERR "        </Value>\n";
    126             }
    127             # Special case of 'input_encoding'
    128             if( $x->{'name'} =~ m/^input_encoding$/i ) {
    129             my $e = $encodings::encodings;
    130             foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
    131                 print STDERR "        <Value>\n";
    132                 print STDERR "          <Name>$enc</Name>\n";
    133                 print STDERR "          <Desc>$e->{$enc}->{'name'}</Desc>\n";
    134                 print STDERR "        </Value>\n";
    135             }
    136             }
    137             print STDERR "      </List>\n";
    138         }
    139         if(defined $x->{'deft'})
    140         {
    141             print STDERR "      <Default>$x->{'deft'}</Default>\n";
    142         }
    143         print STDERR "    </Option>\n";
    144         }
    145     }
    146     if(defined $option_list) {
    147         $self->print_xml();
    148     }
    149 
    150     print STDERR "  </Arguments>\n";
    151     print STDERR "</ClassInfo>\n";
    152     }
    153 }
    154 
    155 
    156 sub new_print_usage
     97
     98sub print_xml
     99{
     100    local $self = shift(@_);
     101
     102    local $optionlistref = $self->{'option_list'};
     103    local @optionlist = @$optionlistref;
     104    local $classifieroptions = pop(@$optionlistref);
     105    return if (!defined($classifieroptions));
     106
     107    print STDERR "<ClassInfo>\n";
     108    print STDERR "  <Name>$classifieroptions->{'name'}</Name>\n";
     109    print STDERR "  <Desc>$classifieroptions->{'desc'}</Desc>\n";
     110    print STDERR "  <Inherits>$classifieroptions->{'inherits'}</Inherits>\n";
     111    print STDERR "  <Arguments>\n";
     112    if (defined($classifieroptions->{'args'})) {
     113    &PrintUsage::print_options_xml($classifieroptions->{'args'});
     114    }
     115
     116    # Recurse up the classifier hierarchy
     117    $self->print_xml();
     118
     119    print STDERR "  </Arguments>\n";
     120    print STDERR "</ClassInfo>\n";
     121}
     122
     123
     124sub print_txt_usage
    157125{
    158126    local $self = shift(@_);
    … …  
    177145    local $classifierargs = $classifieroptions->{'args'};
    178146    if (defined($classifierargs)) {
    179     foreach $option (@$classifierargs) {
    180         local $optionname = $option->{'name'};
    181         local $optiontype = $option->{'type'};
    182 
    183         local $optiondescoffset = 3 + length($optionname);
    184         if ($optiontype ne "flag") {
    185         $optiondescoffset = $optiondescoffset + 2 + length($optiontype) + 1;
    186         }
    187 
    188         # Remember the longest
    189         if ($optiondescoffset > $maxoffset) {
    190         $maxoffset = $optiondescoffset;
    191         }
     147    local $longest = &PrintUsage::find_longest_option_string($classifierargs);
     148    if ($longest > $maxoffset) {
     149        $maxoffset = $longest;
    192150    }
    193151    }
    … …  
    232190
    233191    # Display the classifier options
    234     foreach $option (@$classifierargs) {
    235         # Display option name
    236         local $optionname = $option->{'name'};
    237         print STDERR "  -$optionname";
    238         local $optionstringlength = length("  -$optionname");
    239 
    240         # Display option type, if the option is not a flag
    241         local $optiontype = $option->{'type'};
    242         if ($optiontype ne "flag") {
    243         print STDERR " <$optiontype>";
    244         $optionstringlength = $optionstringlength + length(" <$optiontype>");
    245         }
    246 
    247         # Display the option description
    248         local $optiondesc = $option->{'desc'};
    249         &display_text_in_column($optiondesc, $optiondescoffset, $optionstringlength, 80);
    250 
    251         # Show the default value for the option, if there is one
    252         local $optiondefault = $option->{'deft'};
    253         if (defined($optiondefault)) {
    254         print STDERR " " x $optiondescoffset;
    255         print STDERR "Default: " . $optiondefault . "\n";
    256         }
    257 
    258         # If the option has a list of possible values, display these
    259         local $optionvalueslist = $option->{'list'};
    260         if (defined($optionvalueslist)) {
    261         print STDERR "\n";
    262         foreach $optionvalue (@$optionvalueslist) {
    263             local $optionvaluename = $optionvalue->{'name'};
    264             print STDERR " " x $optiondescoffset;
    265             print STDERR "$optionvaluename:";
    266 
    267             local $optionvaluedesc = $optionvalue->{'desc'};
    268             &display_text_in_column($optionvaluedesc, ($optiondescoffset + 2),
    269                         $optiondescoffset + length($optionvaluename), 80);
    270         }
    271         }
    272 
    273         # Special case for 'input_encoding'
    274         if ($optionname =~ m/^input_encoding$/i) {
    275         my $e = $encodings::encodings;
    276         foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
    277             local $encodingname = $enc;
    278             print STDERR " " x $optiondescoffset;
    279             print STDERR "$encodingname:";
    280 
    281             local $encodingdesc = $e->{$enc}->{'name'};
    282             &display_text_in_column($encodingdesc, ($optiondescoffset + 2),
    283                         $optiondescoffset + length($encodingname), 80);
    284         }
    285         }
    286 
    287         # Add a blank line to separate options
    288         print STDERR "\n";
    289     }
     192    &PrintUsage::print_options_txt($classifierargs, $optiondescoffset);
    290193    }
    291194
    … …  
    296199
    297200
    298 sub display_text_in_column
    299 {
    300     local ($text, $columnbeg, $firstlineoffset, $columnend) = @_;
    301 
    302     # Spaces are put *before* words, so treat the column beginning as 1 smaller than it is
    303     $columnbeg = $columnbeg - 1;
    304 
    305     # Add some padding (if needed) for the first line
    306     local $linelength = $columnbeg;
    307     if ($firstlineoffset < $columnbeg) {
    308     print STDERR " " x ($columnbeg - $firstlineoffset);
    309     }
    310     else {
    311     $linelength = $firstlineoffset;
    312     }
    313 
    314     # Break the text into words, and display one at a time
    315     local @words = split(/ /, $text);
    316 
    317     foreach $word (@words) {
    318     # Unescape '<' and '>' characters
    319     $word =~ s/&lt;/</g;
    320     $word =~ s/&gt;/>/g;
    321 
    322     # If printing this word would except the column end, start a new line
    323     if (($linelength + length($word)) >= $columnend) {
    324         print STDERR "\n";
    325         print STDERR " " x $columnbeg;
    326         $linelength = $columnbeg;
    327     }
    328 
    329     # Write the word
    330     print STDERR " $word";
    331     $linelength = $linelength + length(" $word");
    332     }
    333 
    334     print STDERR "\n";
    335 }
    336 
    337 
    338 sub print_general_usage {
    339     my ($plugin_name) = @_;
    340     print STDERR "
    341    -verbosity N    Controls the quantity of output. 
    342                    Defaults to verbosity of buildcol.pl, which is usually 2.
    343 
    344    (Most general classifier options are set internally by buildcol.)
    345 
    346 ";
    347 }
     201#  sub print_general_usage {
     202#      my ($plugin_name) = @_;
     203#      print STDERR "
     204#     -verbosity N    Controls the quantity of output. 
     205#                     Defaults to verbosity of buildcol.pl, which is usually 2.
     206
     207#     (Most general classifier options are set internally by buildcol.)
     208
     209#  ";
     210#  }
    348211
    349212# print_usage should be overridden for any sub-classes
    … …  
    375238    print STDERR "(general options are those available to all classifiers).\n";
    376239    print STDERR "Check your collect.cfg configuration file.\n";
    377         &print_general_usage($plugin_name);
     240        # &print_general_usage($plugin_name);
     241    &print_txt_usage();
    378242    die "\n";
    379243    }

  • trunk/gsdl/perllib/plugins/BasPlug.pm

    r4764 r4778  
    4343use DateExtract;
    4444use ghtml;
     45use printusage;
    4546
    4647my $unicode_list =
    … …  
    116117    'reqd' => "no" },
    117118      { 'name' => "no_bibliography",
    118     'desc' => "Do not try and block bibliographic dates when extracting historical dates.",
     119    'desc' => "Do not try to block bibliographic dates when extracting historical dates.",
    119120    'type' => "flag",
    120121    'reqd' => "no"},
    … …  
    129130        'args'     => $arguments };
    130131
    131 sub print_xml_usage {
    132     my $self = shift (@_);
     132
     133sub print_xml_usage
     134{
     135    local $self = shift(@_);
     136
    133137    print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\n";
    134138    $self->print_xml();
    135139}
    136140
    137 sub print_xml {
    138     my $self = shift (@_);
    139     my $option_list = $self->{'option_list'};
    140     my $option = pop( @{$option_list} );
    141     if(defined $option)
    142     {
    143     print STDERR "<PlugInfo>\n";
    144     print STDERR "  <Name>$option->{'name'}</Name>\n";
    145     print STDERR "  <Desc>$option->{'desc'}</Desc>\n";
    146     print STDERR "  <Inherits>$option->{'inherits'}</Inherits>\n";
    147     print STDERR "  <Arguments>\n";
    148     if(defined $option->{'args'})
    149     {
    150         my $args = $option->{'args'};
    151         my $x;
    152         foreach $x ( @{$args} )
    153         {
    154         print STDERR "    <Option>\n";
    155         print STDERR "      <Name>$x->{'name'}</Name>\n";
    156         print STDERR "      <Desc>$x->{'desc'}</Desc>\n";
    157         print STDERR "      <Type>$x->{'type'}</Type>\n";
    158         print STDERR "      <Required>$x->{'reqd'}</Required>\n";
    159         if(defined $x->{'list'})
    160         {
    161             print STDERR "      <List>\n";
    162             my $list = $x->{'list'};
    163             my $y;
    164             foreach $y ( @{$list} )
    165             {
    166             print STDERR "        <Value>\n";
    167             print STDERR "          <Name>$y->{'name'}</Name>\n";
    168             print STDERR "          <Desc>$y->{'desc'}</Desc>\n";
    169             print STDERR "        </Value>\n";
    170             }
    171             # Special case of 'input_encoding'
    172             if( $x->{'name'} =~ m/^input_encoding$/i ) {
    173             my $e = $encodings::encodings;
    174             foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
    175                 print STDERR "        <Value>\n";
    176                 print STDERR "          <Name>$enc</Name>\n";
    177                 print STDERR "          <Desc>$e->{$enc}->{'name'}</Desc>\n";
    178                 print STDERR "        </Value>\n";
    179             }
    180             }
    181             print STDERR "      </List>\n";
    182         }
    183         if(defined $x->{'deft'})
    184         {
    185             print STDERR "      <Default>$x->{'deft'}</Default>\n";
    186         }
    187         print STDERR "    </Option>\n";
    188         }
    189     }
    190     if(defined $option_list) {
    191         $self->print_xml();
    192     }
    193    
    194     print STDERR "  </Arguments>\n";
    195     print STDERR "</PlugInfo>\n";
    196     }
    197 }
    198 
    199 
    200 sub new_print_usage
     141
     142sub print_xml
     143{
     144    local $self = shift(@_);
     145
     146    local $optionlistref = $self->{'option_list'};
     147    local @optionlist = @$optionlistref;
     148    local $pluginoptions = pop(@$optionlistref);
     149    return if (!defined($pluginoptions));
     150
     151    print STDERR "<PlugInfo>\n";
     152    print STDERR "  <Name>$pluginoptions->{'name'}</Name>\n";
     153    print STDERR "  <Desc>$pluginoptions->{'desc'}</Desc>\n";
     154    print STDERR "  <Inherits>$pluginoptions->{'inherits'}</Inherits>\n";
     155    print STDERR "  <Arguments>\n";
     156    if (defined($pluginoptions->{'args'})) {
     157    &PrintUsage::print_options_xml($pluginoptions->{'args'});
     158    }
     159
     160    # Recurse up the plugin hierarchy
     161    $self->print_xml();
     162
     163    print STDERR "  </Arguments>\n";
     164    print STDERR "</PlugInfo>\n";
     165}
     166
     167
     168sub print_txt_usage
    201169{
    202170    local $self = shift(@_);
    … …  
    221189    local $pluginargs = $pluginoptions->{'args'};
    222190    if (defined($pluginargs)) {
    223     foreach $option (@$pluginargs) {
    224         local $optionname = $option->{'name'};
    225         local $optiontype = $option->{'type'};
    226 
    227         local $optiondescoffset = 3 + length($optionname);
    228         if ($optiontype ne "flag") {
    229         $optiondescoffset = $optiondescoffset + 2 + length($optiontype) + 1;
    230         }
    231 
    232         # Remember the longest
    233         if ($optiondescoffset > $maxoffset) {
    234         $maxoffset = $optiondescoffset;
    235         }
     191    local $longest = &PrintUsage::find_longest_option_string($pluginargs);
     192    if ($longest > $maxoffset) {
     193        $maxoffset = $longest;
    236194    }
    237195    }
    … …  
    276234
    277235    # Display the plugin options
    278     foreach $option (@$pluginargs) {
    279         # Display option name
    280         local $optionname = $option->{'name'};
    281         print STDERR "  -$optionname";
    282         local $optionstringlength = length("  -$optionname");
    283 
    284         # Display option type, if the option is not a flag
    285         local $optiontype = $option->{'type'};
    286         if ($optiontype ne "flag") {
    287         print STDERR " <$optiontype>";
    288         $optionstringlength = $optionstringlength + length(" <$optiontype>");
    289         }
    290 
    291         # Display the option description
    292         local $optiondesc = $option->{'desc'};
    293         &display_text_in_column($optiondesc, $optiondescoffset, $optionstringlength, 80);
    294 
    295         # Show the default value for the option, if there is one
    296         local $optiondefault = $option->{'deft'};
    297         if (defined($optiondefault)) {
    298         print STDERR " " x $optiondescoffset;
    299         print STDERR "Default: " . $optiondefault . "\n";
    300         }
    301 
    302         # If the option has a list of possible values, display these
    303         local $optionvalueslist = $option->{'list'};
    304         if (defined($optionvalueslist)) {
    305         print STDERR "\n";
    306         foreach $optionvalue (@$optionvalueslist) {
    307             local $optionvaluename = $optionvalue->{'name'};
    308             print STDERR " " x $optiondescoffset;
    309             print STDERR "$optionvaluename:";
    310 
    311             local $optionvaluedesc = $optionvalue->{'desc'};
    312             &display_text_in_column($optionvaluedesc, ($optiondescoffset + 2),
    313                         $optiondescoffset + length($optionvaluename), 80);
    314         }
    315         }
    316 
    317         # Special case for 'input_encoding'
    318         if ($optionname =~ m/^input_encoding$/i) {
    319         my $e = $encodings::encodings;
    320         foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
    321             local $encodingname = $enc;
    322             print STDERR " " x $optiondescoffset;
    323             print STDERR "$encodingname:";
    324 
    325             local $encodingdesc = $e->{$enc}->{'name'};
    326             &display_text_in_column($encodingdesc, ($optiondescoffset + 2),
    327                         $optiondescoffset + length($encodingname), 80);
    328         }
    329         }
    330 
    331         # Add a blank line to separate options
    332         print STDERR "\n";
    333     }
     236    &PrintUsage::print_options_txt($pluginargs, $optiondescoffset);
    334237    }
    335238
    … …  
    337240    $self->print_plugin_usage($descoffset, 0);
    338241    $self->{'option_list'} = \@optionlist;
    339 }
    340 
    341 
    342 sub display_text_in_column
    343 {
    344     local ($text, $columnbeg, $firstlineoffset, $columnend) = @_;
    345 
    346     # Spaces are put *before* words, so treat the column beginning as 1 smaller than it is
    347     $columnbeg = $columnbeg - 1;
    348 
    349     # Add some padding (if needed) for the first line
    350     local $linelength = $columnbeg;
    351     if ($firstlineoffset < $columnbeg) {
    352     print STDERR " " x ($columnbeg - $firstlineoffset);
    353     }
    354     else {
    355     $linelength = $firstlineoffset;
    356     }
    357 
    358     # Break the text into words, and display one at a time
    359     local @words = split(/ /, $text);
    360 
    361     foreach $word (@words) {
    362     # Unescape '<' and '>' characters
    363     $word =~ s/&lt;/</g;
    364     $word =~ s/&gt;/>/g;
    365 
    366     # If printing this word would except the column end, start a new line
    367     if (($linelength + length($word)) >= $columnend) {
    368         print STDERR "\n";
    369         print STDERR " " x $columnbeg;
    370         $linelength = $columnbeg;
    371     }
    372 
    373     # Write the word
    374     print STDERR " $word";
    375     $linelength = $linelength + length(" $word");
    376     }
    377 
    378     print STDERR "\n";
    379242}
    380243
    … …  
    520383    print STDERR "available to all plugins). Check your collect.cfg configuration file.\n";
    521384        # &print_general_usage($plugin_name);
    522     $self->new_print_usage();
     385    $self->print_txt_usage();
    523386    die "\n";
    524387    }
Note: See TracChangeset for help on using the changeset viewer.