Changeset 6925 for trunk/gsdl/perllib
- Timestamp:
- 2004-03-04T16:37:57+13:00 (20 years ago)
- Location:
- trunk/gsdl/perllib
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gsdl/perllib/classify/BasClas.pm
r6918 r6925 93 93 { 94 94 local $self = shift(@_); 95 local $language = shift(@_);96 95 97 96 &PrintUsage::print_xml_header(); 98 $self->print_xml( $language);97 $self->print_xml(); 99 98 } 100 99 … … 103 102 { 104 103 local $self = shift(@_); 105 local $language = shift(@_);106 104 107 105 local $optionlistref = $self->{'option_list'}; … … 117 115 print STDERR " <Arguments>\n"; 118 116 if (defined($classifieroptions->{'args'})) { 119 &PrintUsage::print_options_xml($ language, $classifieroptions->{'args'});117 &PrintUsage::print_options_xml($classifieroptions->{'args'}); 120 118 } 121 119 122 120 # Recurse up the classifier hierarchy 123 $self->print_xml( $language);121 $self->print_xml(); 124 122 125 123 print STDERR " </Arguments>\n"; … … 131 129 { 132 130 local $self = shift(@_); 133 local $language = shift(@_);134 131 135 132 # Print the usage message for a classifier (recursively) 136 133 local $descoffset = $self->determine_description_offset(0); 137 $self->print_classifier_usage($ language, $descoffset, 1);134 $self->print_classifier_usage($descoffset, 1); 138 135 } 139 136 … … 168 165 { 169 166 local $self = shift(@_); 170 local $language = shift(@_);171 167 local $descoffset = shift(@_); 172 168 local $isleafclass = shift(@_); … … 198 194 199 195 # Display the classifier options 200 &PrintUsage::print_options_txt($ language, $classifierargs, $optiondescoffset);196 &PrintUsage::print_options_txt($classifierargs, $optiondescoffset); 201 197 } 202 198 203 199 # Recurse up the classifier hierarchy 204 $self->print_classifier_usage($ language, $descoffset, 0);200 $self->print_classifier_usage($descoffset, 0); 205 201 $self->{'option_list'} = \@optionlist; 206 202 } -
trunk/gsdl/perllib/gsprintf.pm
r6920 r6925 31 31 32 32 33 my $loadedlanguage = "<none>"; 34 my %loadedresourcebundle = (); 35 36 33 37 sub gsprintf 34 38 { … … 39 43 40 44 # Look up all the strings in the dictionary 41 $text_string =~ s/(\{[^\}]+\})/&lookup_string( "",$1)/eg;45 $text_string =~ s/(\{[^\}]+\})/&lookup_string($1)/eg; 42 46 43 47 # Resolve the string arguments using sprintf, then write out to the handle … … 48 52 sub lookup_string 49 53 { 50 local ($ language, $stringkey) = @_;54 local ($stringkey) = @_; 51 55 52 # Load the default resource bundle 53 local %resourcebundle = &load_resource_bundle($language); 56 # Load the default resource bundle if one isn't already loaded 57 if ($loadedlanguage eq "<none>") { 58 &load_resource_bundle(""); 59 } 54 60 55 61 # Return the text matching the key (or just the key, if no match was found) 56 return $ resourcebundle{$stringkey} || $stringkey;62 return $loadedresourcebundle{$stringkey} || $stringkey; 57 63 } 58 64 59 60 my $cachedlanguage = "<none>";61 my %cachedresourcebundle = ();62 65 63 66 sub load_resource_bundle … … 65 68 local $language = shift(@_); 66 69 67 # If the desired resource bundle is the one cached, return it68 if ($language eq $ cachedlanguage) {69 return %cachedresourcebundle;70 # If the desired resource bundle is the one already loaded, no action is necessary 71 if ($language eq $loadedlanguage) { 72 return; 70 73 } 71 74 … … 86 89 close(RESOURCE_BUNDLE); 87 90 88 # Load and cachethis resource bundle89 $ cachedlanguage = $language;90 % cachedresourcebundle = ();91 # Load this resource bundle 92 $loadedlanguage = $language; 93 %loadedresourcebundle = (); 91 94 foreach $line (@resourcebundlelines) { 92 95 # Remove any trailing whitespace … … 101 104 102 105 # Map key to text 103 $ cachedresourcebundle{$linekey} = $linetext;106 $loadedresourcebundle{$linekey} = $linetext; 104 107 } 105 108 } 106 107 return %cachedresourcebundle;108 109 } 109 110 -
trunk/gsdl/perllib/plugins/BasPlug.pm
r6918 r6925 155 155 { 156 156 local $self = shift(@_); 157 local $language = shift(@_);158 157 159 158 &PrintUsage::print_xml_header(); 160 $self->print_xml( $language);159 $self->print_xml(); 161 160 } 162 161 … … 165 164 { 166 165 local $self = shift(@_); 167 local $language = shift(@_);168 166 169 167 local $optionlistref = $self->{'option_list'}; … … 179 177 print STDERR " <Arguments>\n"; 180 178 if (defined($pluginoptions->{'args'})) { 181 &PrintUsage::print_options_xml($ language, $pluginoptions->{'args'});179 &PrintUsage::print_options_xml($pluginoptions->{'args'}); 182 180 } 183 181 184 182 # Recurse up the plugin hierarchy 185 $self->print_xml( $language);183 $self->print_xml(); 186 184 187 185 print STDERR " </Arguments>\n"; … … 193 191 { 194 192 local $self = shift(@_); 195 local $language = shift(@_);196 193 197 194 # Print the usage message for a plugin (recursively) 198 195 local $descoffset = $self->determine_description_offset(0); 199 $self->print_plugin_usage($ language, $descoffset, 1);196 $self->print_plugin_usage($descoffset, 1); 200 197 } 201 198 … … 230 227 { 231 228 local $self = shift(@_); 232 local $language = shift(@_);233 229 local $descoffset = shift(@_); 234 230 local $isleafclass = shift(@_); … … 260 256 261 257 # Display the plugin options 262 &PrintUsage::print_options_txt($ language, $pluginargs, $optiondescoffset);258 &PrintUsage::print_options_txt($pluginargs, $optiondescoffset); 263 259 } 264 260 265 261 # Recurse up the plugin hierarchy 266 $self->print_plugin_usage($ language, $descoffset, 0);262 $self->print_plugin_usage($descoffset, 0); 267 263 $self->{'option_list'} = \@optionlist; 268 264 } -
trunk/gsdl/perllib/printusage.pm
r6920 r6925 39 39 sub print_xml_usage 40 40 { 41 my $language = shift(@_);42 41 my $options = shift(@_); 43 42 … … 49 48 &gsprintf(STDERR, " <Arguments>\n"); 50 49 if (defined($options->{'args'})) { 51 &print_options_xml($ language, $options->{'args'});50 &print_options_xml($options->{'args'}); 52 51 } 53 52 &gsprintf(STDERR, " </Arguments>\n"); … … 78 77 sub print_options_xml 79 78 { 80 my $language = shift(@_);81 79 my $options = shift(@_); 82 80 83 81 foreach $option (@$options) { 84 82 my $optionname = $option->{'name'}; 85 my $optiondesc = &gsprintf::lookup_string($ language, $option->{'desc'});83 my $optiondesc = &gsprintf::lookup_string($option->{'desc'}); 86 84 87 85 # Escape '<' and '>' characters … … 113 111 &gsprintf(STDERR, " <Name>$optionvalue->{'name'}</Name>\n"); 114 112 if (defined $optionvalue->{'desc'}) { 115 my $optionvaluedesc = &gsprintf::lookup_string($ language, $optionvalue->{'desc'});113 my $optionvaluedesc = &gsprintf::lookup_string($optionvalue->{'desc'}); 116 114 117 115 # Escape '<' and '>' characters … … 165 163 sub print_txt_usage 166 164 { 167 my $language = shift(@_);168 165 my $options = shift(@_); 169 166 my $params = shift(@_); … … 193 190 194 191 # Display the program options 195 &print_options_txt($ language, $programargs, $optiondescoffset);192 &print_options_txt($programargs, $optiondescoffset); 196 193 } 197 194 } … … 200 197 sub print_options_txt 201 198 { 202 my $language = shift(@_);203 199 my $options = shift(@_); 204 200 my $optiondescoffset = shift(@_); … … 218 214 219 215 # Display the option description 220 my $optiondesc = &gsprintf::lookup_string($ language, $option->{'desc'});216 my $optiondesc = &gsprintf::lookup_string($option->{'desc'}); 221 217 my $optionreqd = $option->{'reqd'}; 222 218 if (defined($optionreqd) && $optionreqd eq "yes") { 223 $optiondesc = "(" . &gsprintf::lookup_string( $language,"{PrintUsage.required}") . ") " . $optiondesc;219 $optiondesc = "(" . &gsprintf::lookup_string("{PrintUsage.required}") . ") " . $optiondesc; 224 220 } 225 221 &display_text_in_column($optiondesc, $optiondescoffset, $optionstringlength, 80); … … 241 237 &gsprintf(STDERR, "$optionvaluename:"); 242 238 243 my $optionvaluedesc = &gsprintf::lookup_string($ language, $optionvalue->{'desc'});239 my $optionvaluedesc = &gsprintf::lookup_string($optionvalue->{'desc'}); 244 240 &display_text_in_column($optionvaluedesc, $optiondescoffset + 2, 245 241 $optiondescoffset + length($optionvaluename), 80);
Note:
See TracChangeset
for help on using the changeset viewer.