Changeset 6920


Ignore:
Timestamp:
2004-03-04T15:44:37+13:00 (20 years ago)
Author:
mdewsnip
Message:

Tidied up gsprintf code in preparation for adding the French/Spanish/Russian translations.

Location:
trunk/gsdl/perllib
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/gsdl/perllib/gsprintf.pm

    r5613 r6920  
    3939
    4040    # Look up all the strings in the dictionary
    41     $text_string =~ s/(\{[^\}]+\})/&new_lookup_string($1)/eg;
     41    $text_string =~ s/(\{[^\}]+\})/&lookup_string("", $1)/eg;
    4242
    4343    # Resolve the string arguments using sprintf, then write out to the handle
    … …  
    4646
    4747
    48 sub new_lookup_string
     48sub lookup_string
    4949{
    50     local ($stringkey) = @_;
     50    local ($language, $stringkey) = @_;
    5151
    5252    # Load the default resource bundle
    53     local %resourcebundle = &load_resource_bundle("");
     53    local %resourcebundle = &load_resource_bundle($language);
    5454
    5555    # Return the text matching the key (or just the key, if no match was found)
    … …  
    109109
    110110
    111 #  sub gsprintf
    112 #  {
    113 #      my ($handle, $verbosity_threshold, $text_string, @text_arguments) = @_;
    114 
    115 #      # Return unless the required arguments were supplied
    116 #      return unless (defined($handle) && defined($verbosity_threshold) && defined($text_string));
    117 
    118 #      # Return if the verbosity threshold isn't met
    119 #      return if (defined($verbosity) && $verbosity < $verbosity_threshold);
    120 
    121 #      # Look up all the strings in the dictionary
    122 #      $text_string =~ s/(\{[^\}]+\})/&new_lookup_string($1)/eg;
    123 
    124 #      # Resolve the string arguments using sprintf, then write out to the handle
    125 #      print $handle sprintf($text_string, @text_arguments);
    126 #  }
    127 
    128 
    129 sub lookup_string
    130 {
    131     local ($language, $stringkey) = @_;
    132 
    133     $language = "" if !defined($language);
    134 
    135     # Load the appropriate resource bundle
    136     local %resourcebundle = &load_resource_bundle($language);
    137 
    138     # Return the text matching the key (or just the key, if no match was found)
    139     return $resourcebundle{$stringkey} || $stringkey;
    140 }
    141 
    142 
    1431111;
    144 
    145 

  • trunk/gsdl/perllib/printusage.pm

    r6408 r6920  
    3131
    3232
     33sub gsprintf
     34{
     35    return &gsprintf::gsprintf(@_);
     36}
     37
     38
     39sub print_xml_usage
     40{
     41    my $language = shift(@_);
     42    my $options = shift(@_);
     43
     44    &print_xml_header();
     45
     46    &gsprintf(STDERR, "<Info>\n");
     47    &gsprintf(STDERR, "  <Name>$options->{'name'}</Name>\n");
     48    &gsprintf(STDERR, "  <Desc>$options->{'desc'}</Desc>\n");
     49    &gsprintf(STDERR, "  <Arguments>\n");
     50    if (defined($options->{'args'})) {
     51    &print_options_xml($language, $options->{'args'});
     52    }
     53    &gsprintf(STDERR, "  </Arguments>\n");
     54    &gsprintf(STDERR, "</Info>\n");
     55}
     56
     57
    3358sub print_xml_header
    3459{
    35     print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
    36     print STDERR "<!DOCTYPE Info [\n";
    37     print STDERR "  <!ELEMENT Info      (Name, Desc, Arguments)>\n";
    38     print STDERR "  <!ELEMENT Arguments (Option*)>\n";
    39     print STDERR "  <!ELEMENT Option    (Name, Desc, Type, Required, Range, Default?, List?)>\n";
    40     print STDERR "  <!ELEMENT Name      (#PCDATA)>\n";
    41     print STDERR "  <!ELEMENT Desc      (#PCDATA)>\n";
    42     print STDERR "  <!ELEMENT Type      (#PCDATA)>\n";
    43     print STDERR "  <!ELEMENT Required  (#PCDATA)>\n";
    44     print STDERR "  <!ELEMENT Range     (#PCDATA)>\n";
    45     print STDERR "  <!ELEMENT Default   (#PCDATA)>\n";
    46     print STDERR "  <!ELEMENT List      (Value*)>\n";
    47     print STDERR "  <!ELEMENT Value     (Name, Desc?)>\n";
    48     print STDERR "  <!ELEMENT HiddenGLI (#PCDATA)>\n";
    49     print STDERR "]>\n\n";
     60    &gsprintf(STDERR, "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n");
     61    &gsprintf(STDERR, "<!DOCTYPE Info [\n");
     62    &gsprintf(STDERR, "  <!ELEMENT Info      (Name, Desc, Arguments)>\n");
     63    &gsprintf(STDERR, "  <!ELEMENT Arguments (Option*)>\n");
     64    &gsprintf(STDERR, "  <!ELEMENT Option    (Name, Desc, Type, Required, Range, Default?, List?)>\n");
     65    &gsprintf(STDERR, "  <!ELEMENT Name      (#PCDATA)>\n");
     66    &gsprintf(STDERR, "  <!ELEMENT Desc      (#PCDATA)>\n");
     67    &gsprintf(STDERR, "  <!ELEMENT Type      (#PCDATA)>\n");
     68    &gsprintf(STDERR, "  <!ELEMENT Required  (#PCDATA)>\n");
     69    &gsprintf(STDERR, "  <!ELEMENT Range     (#PCDATA)>\n");
     70    &gsprintf(STDERR, "  <!ELEMENT Default   (#PCDATA)>\n");
     71    &gsprintf(STDERR, "  <!ELEMENT List      (Value*)>\n");
     72    &gsprintf(STDERR, "  <!ELEMENT Value     (Name, Desc?)>\n");
     73    &gsprintf(STDERR, "  <!ELEMENT HiddenGLI (#PCDATA)>\n");
     74    &gsprintf(STDERR, "]>\n\n");
    5075}
    5176
    … …  
    5378sub print_options_xml
    5479{
    55     local $language = shift(@_);
    56     local $options = shift(@_);
     80    my $language = shift(@_);
     81    my $options = shift(@_);
    5782
    5883    foreach $option (@$options) {
    59     local $optionname = $option->{'name'};
    60     local $optiondesc = &gsprintf::lookup_string($language, $option->{'desc'});
     84    my $optionname = $option->{'name'};
     85    my $optiondesc = &gsprintf::lookup_string($language, $option->{'desc'});
    6186
    6287    # Escape '<' and '>' characters
    … …  
    6590
    6691    # Display option name, description and type
    67     print STDERR "    <Option>\n";
    68     print STDERR "      <Name>$optionname</Name>\n";
    69     print STDERR "      <Desc>$optiondesc</Desc>\n";
    70     print STDERR "      <Type>$option->{'type'}</Type>\n";
     92    &gsprintf(STDERR, "    <Option>\n");
     93    &gsprintf(STDERR, "      <Name>$optionname</Name>\n");
     94    &gsprintf(STDERR, "      <Desc>$optiondesc</Desc>\n");
     95    &gsprintf(STDERR, "      <Type>$option->{'type'}</Type>\n");
    7196
    7297    # If the option has a required field, display this
    7398    if (defined($option->{'reqd'})) {
    74         print STDERR "      <Required>$option->{'reqd'}</Required>\n";
     99        &gsprintf(STDERR, "      <Required>$option->{'reqd'}</Required>\n");
    75100    }
    76101
    77102    # If the option has a range field, display this
    78103    if (defined($option->{'range'})) {
    79         print STDERR "      <Range>$option->{'range'}</Range>\n";
     104        &gsprintf(STDERR, "      <Range>$option->{'range'}</Range>\n");
    80105    }
    81106
    82107    # If the option has a list of possible values, display these
    83108    if (defined $option->{'list'}) {
    84         print STDERR "      <List>\n";
    85         local $optionvalueslist = $option->{'list'};
     109        &gsprintf(STDERR, "      <List>\n");
     110        my $optionvalueslist = $option->{'list'};
    86111        foreach $optionvalue (@$optionvalueslist) {
    87         print STDERR "        <Value>\n";
    88         print STDERR "          <Name>$optionvalue->{'name'}</Name>\n";
     112        &gsprintf(STDERR, "        <Value>\n");
     113        &gsprintf(STDERR, "          <Name>$optionvalue->{'name'}</Name>\n");
    89114        if (defined $optionvalue->{'desc'}) {
    90             local $optionvaluedesc = &gsprintf::lookup_string($language, $optionvalue->{'desc'});
     115            my $optionvaluedesc = &gsprintf::lookup_string($language, $optionvalue->{'desc'});
    91116
    92117            # Escape '<' and '>' characters
    … …  
    94119            $optionvaluedesc =~ s/>/&gt;/g;
    95120
    96             print STDERR "          <Desc>$optionvaluedesc</Desc>\n";
     121            &gsprintf(STDERR, "          <Desc>$optionvaluedesc</Desc>\n");
    97122        }
    98         print STDERR "        </Value>\n";
     123        &gsprintf(STDERR, "        </Value>\n");
    99124        }
    100125
    … …  
    103128        my $e = $encodings::encodings;
    104129        foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
    105             print STDERR "        <Value>\n";
    106             print STDERR "          <Name>$enc</Name>\n";
    107             print STDERR "          <Desc>$e->{$enc}->{'name'}</Desc>\n";
    108             print STDERR "        </Value>\n";
     130            &gsprintf(STDERR, "        <Value>\n");
     131            &gsprintf(STDERR, "          <Name>$enc</Name>\n");
     132            &gsprintf(STDERR, "          <Desc>$e->{$enc}->{'name'}</Desc>\n");
     133            &gsprintf(STDERR, "        </Value>\n");
    109134        }
    110135        }
    111136
    112         print STDERR "      </List>\n";
     137        &gsprintf(STDERR, "      </List>\n");
    113138    }
    114139
    … …  
    121146        $optiondeftvalue =~ s/>/&gt;/g;
    122147
    123         print STDERR "      <Default>$optiondeftvalue</Default>\n";
     148        &gsprintf(STDERR, "      <Default>$optiondeftvalue</Default>\n");
    124149    }
    125150
    126151    # If the option is noted as being hidden in GLI, add that to the printout
    127152    if (defined($option->{'hiddengli'})) {
    128         print STDERR "      <HiddenGLI>$option->{'hiddengli'}</HiddenGLI>\n";
     153        &gsprintf(STDERR, "      <HiddenGLI>$option->{'hiddengli'}</HiddenGLI>\n");
    129154    }
    130155    # If the argument is not hidden then print out the lowest detail mode it is visible in
    131156    if (defined($option->{'modegli'})) {
    132         print STDERR "      <ModeGLI>$option->{'modegli'}</ModeGLI>\n";
    133     }
    134 
    135     print STDERR "    </Option>\n";
    136     }
    137 }
    138 
    139 
    140 sub find_longest_option_string
    141 {
    142     local $options = shift(@_);
    143 
    144     local $maxlength = 0;
    145     foreach $option (@$options) {
    146     local $optionname = $option->{'name'};
    147     local $optiontype = $option->{'type'};
    148 
    149     local $optionlength = length("  -$optionname");
    150     if ($optiontype ne "flag") {
    151         $optionlength = $optionlength + length(" <$optiontype>");
    152     }
    153 
    154     # Remember the longest
    155     if ($optionlength > $maxlength) {
    156         $maxlength = $optionlength;
    157     }
    158     }
    159     return $maxlength;
     157        &gsprintf(STDERR, "      <ModeGLI>$option->{'modegli'}</ModeGLI>\n");
     158    }
     159
     160    &gsprintf(STDERR, "    </Option>\n");
     161    }
     162}
     163
     164
     165sub print_txt_usage
     166{
     167    my $language = shift(@_);
     168    my $options = shift(@_);
     169    my $params = shift(@_);
     170    my $programdesc = shift(@_);
     171
     172    my $programname = $options->{'name'};
     173    my $programargs = $options->{'args'};
     174
     175    # Find the length of the longest option string
     176    my $descoffset = 0;
     177    if (defined($programargs)) {
     178    $descoffset = &find_longest_option_string($programargs);
     179    }
     180
     181    # Produce the usage information using the data structure above
     182    if ($programdesc) {
     183    &gsprintf(STDERR, $programname . ": $options->{'desc'}\n\n");
     184    }
     185    &gsprintf(STDERR, " {common.usage}: $programname $params\n\n");
     186
     187    # Display the program options, if there are some
     188    if (defined($programargs)) {
     189    # Calculate the column offset of the option descriptions
     190    my $optiondescoffset = $descoffset + 2;  # 2 spaces between options & descriptions
     191
     192    &gsprintf(STDERR, " {common.options}:\n");
     193
     194    # Display the program options
     195    &print_options_txt($language, $programargs, $optiondescoffset);
     196    }
    160197}
    161198
    … …  
    163200sub print_options_txt
    164201{
    165     local $language = shift(@_);
    166     local $options = shift(@_);
    167     local $optiondescoffset = shift(@_);
     202    my $language = shift(@_);
     203    my $options = shift(@_);
     204    my $optiondescoffset = shift(@_);
    168205
    169206    foreach $option (@$options) {
    170207    # Display option name
    171     local $optionname = $option->{'name'};
    172     print STDERR "  -$optionname";
    173     local $optionstringlength = length("  -$optionname");
     208    my $optionname = $option->{'name'};
     209    &gsprintf(STDERR, "  -$optionname");
     210    my $optionstringlength = length("  -$optionname");
    174211
    175212    # Display option type, if the option is not a flag
    176     local $optiontype = $option->{'type'};
     213    my $optiontype = $option->{'type'};
    177214    if ($optiontype ne "flag") {
    178         print STDERR " <$optiontype>";
     215        &gsprintf(STDERR, " <$optiontype>");
    179216        $optionstringlength = $optionstringlength + length(" <$optiontype>");
    180217    }
    181218
    182219    # Display the option description
    183     local $optiondesc = &gsprintf::lookup_string($language, $option->{'desc'});
    184     local $optionreqd = $option->{'reqd'};
     220    my $optiondesc = &gsprintf::lookup_string($language, $option->{'desc'});
     221    my $optionreqd = $option->{'reqd'};
    185222    if (defined($optionreqd) && $optionreqd eq "yes") {
    186223        $optiondesc = "(" . &gsprintf::lookup_string($language, "{PrintUsage.required}") . ") " . $optiondesc;
    … …  
    189226
    190227    # Show the default value for the option, if there is one
    191     local $optiondefault = $option->{'deft'};
     228    my $optiondefault = $option->{'deft'};
    192229    if (defined($optiondefault)) {
    193         print STDERR " " x $optiondescoffset;
    194         print STDERR &gsprintf::lookup_string($language, "{PrintUsage.default}");
    195         print STDERR ": " . &gsprintf::lookup_string($language, $optiondefault) . "\n";
     230        &gsprintf(STDERR, " " x $optiondescoffset);
     231        &gsprintf(STDERR, "{PrintUsage.default}: $optiondefault\n");
    196232    }
    197233
    198234    # If the option has a list of possible values, display these
    199     local $optionvalueslist = $option->{'list'};
     235    my $optionvalueslist = $option->{'list'};
    200236    if (defined($optionvalueslist)) {
    201         print STDERR "\n";
     237        &gsprintf(STDERR, "\n");
    202238        foreach $optionvalue (@$optionvalueslist) {
    203         local $optionvaluename = $optionvalue->{'name'};
    204         print STDERR " " x $optiondescoffset;
    205         print STDERR "$optionvaluename:";
    206 
    207         local $optionvaluedesc = &gsprintf::lookup_string($language, $optionvalue->{'desc'});
     239        my $optionvaluename = $optionvalue->{'name'};
     240        &gsprintf(STDERR, " " x $optiondescoffset);
     241        &gsprintf(STDERR, "$optionvaluename:");
     242
     243        my $optionvaluedesc = &gsprintf::lookup_string($language, $optionvalue->{'desc'});
    208244        &display_text_in_column($optionvaluedesc, $optiondescoffset + 2,
    209245                    $optiondescoffset + length($optionvaluename), 80);
    … …  
    215251        my $e = $encodings::encodings;
    216252        foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
    217         print STDERR " " x $optiondescoffset;
    218         print STDERR "$enc:";
    219 
    220         local $encodingdesc = $e->{$enc}->{'name'};
     253        &gsprintf(STDERR, " " x $optiondescoffset);
     254        &gsprintf(STDERR, "$enc:");
     255
     256        my $encodingdesc = $e->{$enc}->{'name'};
    221257        &display_text_in_column($encodingdesc, $optiondescoffset + 2,
    222258                    $optiondescoffset + length("$enc:"), 80);
    … …  
    225261
    226262    # Add a blank line to separate options
    227     print STDERR "\n";
     263    &gsprintf(STDERR, "\n");
    228264    }
    229265}
    … …  
    232268sub display_text_in_column
    233269{
    234     local ($text, $columnbeg, $firstlineoffset, $columnend) = @_;
     270    my ($text, $columnbeg, $firstlineoffset, $columnend) = @_;
    235271
    236272    # Spaces are put *before* words, so treat the column beginning as 1 smaller than it is
    … …  
    238274
    239275    # Add some padding (if needed) for the first line
    240     local $linelength = $columnbeg;
     276    my $linelength = $columnbeg;
    241277    if ($firstlineoffset < $columnbeg) {
    242     print STDERR " " x ($columnbeg - $firstlineoffset);
     278    &gsprintf(STDERR, " " x ($columnbeg - $firstlineoffset));
    243279    }
    244280    else {
    … …  
    247283
    248284    # Break the text into words, and display one at a time
    249     local @words = split(/ /, $text);
     285    my @words = split(/ /, $text);
    250286
    251287    foreach $word (@words) {
    252288    # If printing this word would exceed the column end, start a new line
    253289    if (($linelength + length($word)) >= $columnend) {
    254         print STDERR "\n";
    255         print STDERR " " x $columnbeg;
     290        &gsprintf(STDERR, "\n");
     291        &gsprintf(STDERR, " " x $columnbeg);
    256292        $linelength = $columnbeg;
    257293    }
    258294
    259295    # Write the word
    260     print STDERR " $word";
     296    &gsprintf(STDERR, " $word");
    261297    $linelength = $linelength + length(" $word");
    262298    }
    263299
    264     print STDERR "\n";
     300    &gsprintf(STDERR, "\n");
     301}
     302
     303
     304sub find_longest_option_string
     305{
     306    my $options = shift(@_);
     307
     308    my $maxlength = 0;
     309    foreach $option (@$options) {
     310    my $optionname = $option->{'name'};
     311    my $optiontype = $option->{'type'};
     312
     313    my $optionlength = length("  -$optionname");
     314    if ($optiontype ne "flag") {
     315        $optionlength = $optionlength + length(" <$optiontype>");
     316    }
     317
     318    # Remember the longest
     319    if ($optionlength > $maxlength) {
     320        $maxlength = $optionlength;
     321    }
     322    }
     323    return $maxlength;
    265324}
    266325
Note: See TracChangeset for help on using the changeset viewer.