Changeset 18981 for gsdl/trunk/perllib/gsprintf.pm
- Timestamp:
- 2009-04-15T16:32:53+12:00 (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
gsdl/trunk/perllib/gsprintf.pm
r17533 r18981 58 58 # Return unless the required arguments were supplied 59 59 return unless (defined($handle) && defined($text_string)); 60 60 61 61 # Look up all the strings in the dictionary 62 62 $text_string =~ s/(\{[^\}]+\})/&lookup_string($1)/eg; … … 77 77 # Try the default resource bundle next 78 78 if (!defined($utf8string)) { 79 80 81 82 83 84 } 85 79 # Load the default resource bundle if it is not already loaded 80 &load_default_resource_bundle() if (!%defaultresourcebundle); 81 82 $utf8string = $defaultresourcebundle{$stringkey}; 83 $outputencoding = $defaultoutputencoding; 84 } 85 86 86 # Try the English resource bundle last 87 87 if (!defined($utf8string)) { 88 89 90 91 92 93 } 94 88 # Load the English resource bundle if it is not already loaded 89 &load_english_resource_bundle() if (!%englishresourcebundle); 90 91 $utf8string = $englishresourcebundle{$stringkey}; 92 $outputencoding = $englishoutputencoding; 93 } 94 95 95 # No matching string was found, so just return the key 96 96 if (!defined($utf8string)) { 97 98 } 99 97 return $stringkey; 98 } 99 100 100 # Return the string matching the key 101 101 return $utf8string if (!defined($outputencoding) || $outputstringsinUTF8 102 103 102 || $outputencoding eq "utf8"); 103 104 104 # If an 8-bit output encoding has been defined, encode the string appropriately 105 105 my $encoded=unicode::unicode2singlebyte(&unicode::utf82unicode($utf8string), $outputencoding); … … 107 107 # If we successfully encoded it, return it 108 108 if ($encoded) { return $encoded } 109 109 110 110 # Otherwise, we can't convert to the requested encoding. return the utf8? 111 111 $specialoutputencoding='utf8'; … … 117 117 { 118 118 my $language = shift(@_); 119 119 120 120 # Read the specified resource bundle 121 my $resourcebundlehome = &util::filename_cat("$ENV{'GSDLHOME'}", "perllib");122 121 my $resourcebundlename = "strings_" . $language . ".properties"; 123 my $resourcebundlefile = &util::filename_cat($resourcebundlehome, $resourcebundlename);124 125 %specialresourcebundle = &read_resource_bundle($resourcebundlefile);122 123 %specialresourcebundle 124 = &read_resource_bundle_and_extensions($ENV{'GSDLHOME'},"perllib",$resourcebundlename); 126 125 return if (!%specialresourcebundle); 127 126 128 127 # Read the output encoding to use from the resource bundle 129 128 if ($ENV{'GSDLOS'} =~ /windows/) { 130 129 $specialoutputencoding = $specialresourcebundle{"{OutputEncoding.windows}"}; 131 130 } 132 131 else { 133 134 135 136 137 138 139 140 141 142 143 144 145 132 # see if there is an encoding set in the appropriate locale env var 133 134 foreach my $envvar ('LC_ALL', 'LANG') { 135 if (!exists $ENV{$envvar}) { next } 136 my $locale=$ENV{$envvar}; 137 if ($locale !~ /^\w+\.(.+)$/) { next } 138 my $enc=lc($1); 139 $enc =~ s/-/_/g; 140 if ($enc eq 'utf_8') { $enc='utf8' } # normalise to this name 141 $specialoutputencoding = $enc; 142 return; 143 } 144 $specialoutputencoding = $specialresourcebundle{"{OutputEncoding.unix}"}; 146 145 } 147 146 } … … 151 150 { 152 151 # Read the default resource bundle 153 my $resourcebundlehome = &util::filename_cat("$ENV{'GSDLHOME'}", "perllib");154 152 my $resourcebundlename = "strings.properties"; 155 my $resourcebundlefile = &util::filename_cat($resourcebundlehome, $resourcebundlename); 156 157 %defaultresourcebundle = &read_resource_bundle($resourcebundlefile);153 154 %defaultresourcebundle 155 = &read_resource_bundle_and_extensions($ENV{'GSDLHOME'},"perllib",$resourcebundlename); 158 156 if (!%defaultresourcebundle) { 159 157 # $! will still have the error value for the last failed syscall 160 print STDERR "$! $resourcebundle file\n";161 162 158 print STDERR "$! $resourcebundlename\n"; 159 # set something so we don't bother trying to load it again 160 $defaultresourcebundle{0}=undef; 163 161 return; 164 162 } 165 163 166 164 # Read the output encoding to use from the resource bundle 167 165 if ($ENV{'GSDLOS'} =~ /windows/) { 168 166 $defaultoutputencoding = $defaultresourcebundle{"{OutputEncoding.windows}"}; 169 167 } 170 168 else { 171 169 $defaultoutputencoding = $defaultresourcebundle{"{OutputEncoding.unix}"}; 172 170 } 173 171 } … … 178 176 # Ensure the English resource bundle hasn't already been loaded 179 177 if (%specialresourcebundle && $specialresourcebundle{"{Language.code}"} eq "en") { 180 181 178 %englishresourcebundle = %specialresourcebundle; 179 $englishoutputencoding = $specialoutputencoding; 182 180 } 183 181 184 182 if ($defaultresourcebundle{"{Language.code}"} && 185 183 $defaultresourcebundle{"{Language.code}"} eq "en") { 186 187 188 } 189 184 %englishresourcebundle = %defaultresourcebundle; 185 $englishoutputencoding = $defaultoutputencoding; 186 } 187 190 188 # Read the English resource bundle 191 my $resourcebundlehome = &util::filename_cat("$ENV{'GSDLHOME'}", "perllib");192 189 my $resourcebundlename = "strings_en.properties"; 193 my $resourcebundlefile = &util::filename_cat($resourcebundlehome, $resourcebundlename); 194 195 %englishresourcebundle = &read_resource_bundle($resourcebundlefile);190 191 %englishresourcebundle 192 = &read_resource_bundle_and_extensions($ENV{'GSDLHOME'},"perllib",$resourcebundlename); 196 193 return if (!%englishresourcebundle); 197 194 198 195 # Read the output encoding to use from the resource bundle 199 196 if ($ENV{'GSDLOS'} =~ /windows/) { 200 197 $englishoutputencoding = $englishresourcebundle{"{OutputEncoding.windows}"}; 201 198 } 202 199 else { 203 $englishoutputencoding = $englishresourcebundle{"{OutputEncoding.unix}"}; 204 } 200 $englishoutputencoding = $englishresourcebundle{"{OutputEncoding.unix}"}; 201 } 202 } 203 204 205 sub read_resource_bundle_and_extensions 206 { 207 my ($bundle_base,$primary_dir,$resourcename) = @_; 208 209 my $primary_resourcebundlefile 210 = &util::filename_cat($bundle_base,$primary_dir,$resourcename); 211 212 my $resourcebundle = read_resource_bundle($primary_resourcebundlefile); 213 return if (!defined $resourcebundle); 214 215 my @extensions = split(/:/,$ENV{'GSDLEXTS'}); 216 foreach my $e (@extensions) { 217 my $ext_base 218 = &util::filename_cat($bundle_base,"ext",$e); 219 220 my $ext_resourcebundlefile 221 = &util::filename_cat($ext_base,$primary_dir,$resourcename); 222 223 # can ignore return value (will be same reference to $resourcebundle) 224 read_resource_bundle($ext_resourcebundlefile,$resourcebundle); 225 } 226 227 return %$resourcebundle; 205 228 } 206 229 … … 208 231 sub read_resource_bundle 209 232 { 210 my ($resourcebundlefilepath) = shift(@_); 211 212 # Return an empty hash if the specified resource bundle could not be read 213 return () if (!open(RESOURCE_BUNDLE, "<$resourcebundlefilepath")); 214 233 my ($resourcebundlefilepath,$resourcebundle) = @_; 234 235 if (!open(RESOURCE_BUNDLE, "<$resourcebundlefilepath")) { 236 # When called for the first time (primary resource), $resourcebundle 237 # is not defined (=undef). If the file does not exist, then we return 238 # this 'undef' to signal it was not found 239 # For an extension resource bundle, if it does not exist this 240 # is not so serious (in fact quite likely) => return what we 241 # have built up so far 242 243 return $resourcebundle; 244 } 245 246 if (!defined $resourcebundle) { 247 # resource files exists, so exect some content to be stored 248 $resourcebundle = {}; 249 } 250 215 251 # Load this resource bundle 216 252 my @resourcebundlelines = <RESOURCE_BUNDLE>; … … 218 254 219 255 # Parse the resource bundle 220 my %resourcebundle = (); 256 221 257 foreach my $line (@resourcebundlelines) { 222 258 # Remove any trailing whitespace … … 232 268 233 269 # Map key to text 234 $resourcebundle {$linekey} = $linetext;270 $resourcebundle->{$linekey} = $linetext; 235 271 } 236 272 } 237 273 } 238 274 239 return %resourcebundle;275 return $resourcebundle; 240 276 } 241 277
Note:
See TracChangeset
for help on using the changeset viewer.