Changeset 6920
- Timestamp:
- 2004-03-04T15:44:37+13:00 (20 years ago)
- Location:
- trunk/gsdl/perllib
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gsdl/perllib/gsprintf.pm
r5613 r6920 39 39 40 40 # 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; 42 42 43 43 # Resolve the string arguments using sprintf, then write out to the handle … … 46 46 47 47 48 sub new_lookup_string48 sub lookup_string 49 49 { 50 local ($ stringkey) = @_;50 local ($language, $stringkey) = @_; 51 51 52 52 # Load the default resource bundle 53 local %resourcebundle = &load_resource_bundle( "");53 local %resourcebundle = &load_resource_bundle($language); 54 54 55 55 # Return the text matching the key (or just the key, if no match was found) … … 109 109 110 110 111 # sub gsprintf112 # {113 # my ($handle, $verbosity_threshold, $text_string, @text_arguments) = @_;114 115 # # Return unless the required arguments were supplied116 # return unless (defined($handle) && defined($verbosity_threshold) && defined($text_string));117 118 # # Return if the verbosity threshold isn't met119 # return if (defined($verbosity) && $verbosity < $verbosity_threshold);120 121 # # Look up all the strings in the dictionary122 # $text_string =~ s/(\{[^\}]+\})/&new_lookup_string($1)/eg;123 124 # # Resolve the string arguments using sprintf, then write out to the handle125 # print $handle sprintf($text_string, @text_arguments);126 # }127 128 129 sub lookup_string130 {131 local ($language, $stringkey) = @_;132 133 $language = "" if !defined($language);134 135 # Load the appropriate resource bundle136 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 143 111 1; 144 145 -
trunk/gsdl/perllib/printusage.pm
r6408 r6920 31 31 32 32 33 sub gsprintf 34 { 35 return &gsprintf::gsprintf(@_); 36 } 37 38 39 sub 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 33 58 sub print_xml_header 34 59 { 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"); 50 75 } 51 76 … … 53 78 sub print_options_xml 54 79 { 55 local$language = shift(@_);56 local$options = shift(@_);80 my $language = shift(@_); 81 my $options = shift(@_); 57 82 58 83 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'}); 61 86 62 87 # Escape '<' and '>' characters … … 65 90 66 91 # 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"); 71 96 72 97 # If the option has a required field, display this 73 98 if (defined($option->{'reqd'})) { 74 print STDERR " <Required>$option->{'reqd'}</Required>\n";99 &gsprintf(STDERR, " <Required>$option->{'reqd'}</Required>\n"); 75 100 } 76 101 77 102 # If the option has a range field, display this 78 103 if (defined($option->{'range'})) { 79 print STDERR " <Range>$option->{'range'}</Range>\n";104 &gsprintf(STDERR, " <Range>$option->{'range'}</Range>\n"); 80 105 } 81 106 82 107 # If the option has a list of possible values, display these 83 108 if (defined $option->{'list'}) { 84 print STDERR " <List>\n";85 local$optionvalueslist = $option->{'list'};109 &gsprintf(STDERR, " <List>\n"); 110 my $optionvalueslist = $option->{'list'}; 86 111 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"); 89 114 if (defined $optionvalue->{'desc'}) { 90 local$optionvaluedesc = &gsprintf::lookup_string($language, $optionvalue->{'desc'});115 my $optionvaluedesc = &gsprintf::lookup_string($language, $optionvalue->{'desc'}); 91 116 92 117 # Escape '<' and '>' characters … … 94 119 $optionvaluedesc =~ s/>/>/g; 95 120 96 print STDERR " <Desc>$optionvaluedesc</Desc>\n";121 &gsprintf(STDERR, " <Desc>$optionvaluedesc</Desc>\n"); 97 122 } 98 print STDERR " </Value>\n";123 &gsprintf(STDERR, " </Value>\n"); 99 124 } 100 125 … … 103 128 my $e = $encodings::encodings; 104 129 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"); 109 134 } 110 135 } 111 136 112 print STDERR " </List>\n";137 &gsprintf(STDERR, " </List>\n"); 113 138 } 114 139 … … 121 146 $optiondeftvalue =~ s/>/>/g; 122 147 123 print STDERR " <Default>$optiondeftvalue</Default>\n";148 &gsprintf(STDERR, " <Default>$optiondeftvalue</Default>\n"); 124 149 } 125 150 126 151 # If the option is noted as being hidden in GLI, add that to the printout 127 152 if (defined($option->{'hiddengli'})) { 128 print STDERR " <HiddenGLI>$option->{'hiddengli'}</HiddenGLI>\n";153 &gsprintf(STDERR, " <HiddenGLI>$option->{'hiddengli'}</HiddenGLI>\n"); 129 154 } 130 155 # If the argument is not hidden then print out the lowest detail mode it is visible in 131 156 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 165 sub 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 } 160 197 } 161 198 … … 163 200 sub print_options_txt 164 201 { 165 local$language = shift(@_);166 local$options = shift(@_);167 local$optiondescoffset = shift(@_);202 my $language = shift(@_); 203 my $options = shift(@_); 204 my $optiondescoffset = shift(@_); 168 205 169 206 foreach $option (@$options) { 170 207 # 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"); 174 211 175 212 # Display option type, if the option is not a flag 176 local$optiontype = $option->{'type'};213 my $optiontype = $option->{'type'}; 177 214 if ($optiontype ne "flag") { 178 print STDERR " <$optiontype>";215 &gsprintf(STDERR, " <$optiontype>"); 179 216 $optionstringlength = $optionstringlength + length(" <$optiontype>"); 180 217 } 181 218 182 219 # 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'}; 185 222 if (defined($optionreqd) && $optionreqd eq "yes") { 186 223 $optiondesc = "(" . &gsprintf::lookup_string($language, "{PrintUsage.required}") . ") " . $optiondesc; … … 189 226 190 227 # Show the default value for the option, if there is one 191 local$optiondefault = $option->{'deft'};228 my $optiondefault = $option->{'deft'}; 192 229 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"); 196 232 } 197 233 198 234 # If the option has a list of possible values, display these 199 local$optionvalueslist = $option->{'list'};235 my $optionvalueslist = $option->{'list'}; 200 236 if (defined($optionvalueslist)) { 201 print STDERR "\n";237 &gsprintf(STDERR, "\n"); 202 238 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'}); 208 244 &display_text_in_column($optionvaluedesc, $optiondescoffset + 2, 209 245 $optiondescoffset + length($optionvaluename), 80); … … 215 251 my $e = $encodings::encodings; 216 252 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'}; 221 257 &display_text_in_column($encodingdesc, $optiondescoffset + 2, 222 258 $optiondescoffset + length("$enc:"), 80); … … 225 261 226 262 # Add a blank line to separate options 227 print STDERR "\n";263 &gsprintf(STDERR, "\n"); 228 264 } 229 265 } … … 232 268 sub display_text_in_column 233 269 { 234 local($text, $columnbeg, $firstlineoffset, $columnend) = @_;270 my ($text, $columnbeg, $firstlineoffset, $columnend) = @_; 235 271 236 272 # Spaces are put *before* words, so treat the column beginning as 1 smaller than it is … … 238 274 239 275 # Add some padding (if needed) for the first line 240 local$linelength = $columnbeg;276 my $linelength = $columnbeg; 241 277 if ($firstlineoffset < $columnbeg) { 242 print STDERR " " x ($columnbeg - $firstlineoffset);278 &gsprintf(STDERR, " " x ($columnbeg - $firstlineoffset)); 243 279 } 244 280 else { … … 247 283 248 284 # Break the text into words, and display one at a time 249 local@words = split(/ /, $text);285 my @words = split(/ /, $text); 250 286 251 287 foreach $word (@words) { 252 288 # If printing this word would exceed the column end, start a new line 253 289 if (($linelength + length($word)) >= $columnend) { 254 print STDERR "\n";255 print STDERR " " x $columnbeg;290 &gsprintf(STDERR, "\n"); 291 &gsprintf(STDERR, " " x $columnbeg); 256 292 $linelength = $columnbeg; 257 293 } 258 294 259 295 # Write the word 260 print STDERR " $word";296 &gsprintf(STDERR, " $word"); 261 297 $linelength = $linelength + length(" $word"); 262 298 } 263 299 264 print STDERR "\n"; 300 &gsprintf(STDERR, "\n"); 301 } 302 303 304 sub 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; 265 324 } 266 325
Note:
See TracChangeset
for help on using the changeset viewer.