source: main/trunk/greenstone2/perllib/gsprintf.pm@ 21289

Last change on this file since 21289 was 21289, checked in by kjdon, 12 years ago

extension handling extended to include gs3 extensions

  • Property svn:keywords set to Author Date Id Revision
File size: 9.4 KB
Line 
1###########################################################################
2#
3# gsprintf.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25use strict;
26no strict 'refs';
27
28package gsprintf;
29require Exporter;
30@gsprintf::ISA=qw(Exporter);
31
32use unicode;
33use util;
34
35@gsprintf::EXPORT_OK = qw(gsprintf); # functions we can export into namespace
36
37
38# Language-specific resource bundle
39my %specialresourcebundle = ();
40our $specialoutputencoding; # our, so that it can be changed outside.
41
42# Default resource bundle
43my %defaultresourcebundle;
44my $defaultoutputencoding;
45
46# English resource bundle
47my %englishresourcebundle;
48my $englishoutputencoding;
49
50# Ignore the OutputEncoding strings in the resource bundles and output all text in UTF-8
51my $outputstringsinUTF8 = 0;
52
53
54sub gsprintf
55{
56 my ($handle, $text_string, @text_arguments) = @_;
57
58 # Return unless the required arguments were supplied
59 return unless (defined($handle) && defined($text_string));
60
61 # Look up all the strings in the dictionary
62 $text_string =~ s/(\{[^\}]+\})/&lookup_string($1)/eg;
63
64 # Resolve the string arguments using sprintf, then write out to the handle
65 print $handle sprintf($text_string, @text_arguments);
66}
67
68
69sub lookup_string
70{
71 my ($stringkey) = @_;
72 return "" unless defined $stringkey;
73 # Try the language-specific resource bundle first
74 my $utf8string = $specialresourcebundle{$stringkey};
75 my $outputencoding = $specialoutputencoding;
76
77 # Try the default resource bundle next
78 if (!defined($utf8string)) {
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 # Try the English resource bundle last
87 if (!defined($utf8string)) {
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 # No matching string was found, so just return the key
96 if (!defined($utf8string)) {
97 return $stringkey;
98 }
99
100 # Return the string matching the key
101 return $utf8string if (!defined($outputencoding) || $outputstringsinUTF8
102 || $outputencoding eq "utf8");
103
104 # If an 8-bit output encoding has been defined, encode the string appropriately
105 my $encoded=unicode::unicode2singlebyte(&unicode::utf82unicode($utf8string), $outputencoding);
106
107 # If we successfully encoded it, return it
108 if ($encoded) { return $encoded }
109
110 # Otherwise, we can't convert to the requested encoding. return the utf8?
111 $specialoutputencoding='utf8';
112 return $utf8string;
113}
114
115
116sub load_language_specific_resource_bundle
117{
118 my $language = shift(@_);
119
120 # Read the specified resource bundle
121 my $resourcebundlename = "strings_" . $language . ".properties";
122
123 %specialresourcebundle
124 = &read_resource_bundle_and_extensions($ENV{'GSDLHOME'},"perllib",$resourcebundlename);
125 return if (!%specialresourcebundle);
126
127 # Read the output encoding to use from the resource bundle
128 if ($ENV{'GSDLOS'} =~ /windows/) {
129 $specialoutputencoding = $specialresourcebundle{"{OutputEncoding.windows}"};
130 }
131 else {
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}"};
145 }
146}
147
148
149sub load_default_resource_bundle
150{
151 # Read the default resource bundle
152 my $resourcebundlename = "strings.properties";
153
154 %defaultresourcebundle
155 = &read_resource_bundle_and_extensions($ENV{'GSDLHOME'},"perllib",$resourcebundlename);
156 if (!%defaultresourcebundle) {
157 # $! will still have the error value for the last failed syscall
158 print STDERR "$! $resourcebundlename\n";
159 # set something so we don't bother trying to load it again
160 $defaultresourcebundle{0}=undef;
161 return;
162 }
163
164 # Read the output encoding to use from the resource bundle
165 if ($ENV{'GSDLOS'} =~ /windows/) {
166 $defaultoutputencoding = $defaultresourcebundle{"{OutputEncoding.windows}"};
167 }
168 else {
169 $defaultoutputencoding = $defaultresourcebundle{"{OutputEncoding.unix}"};
170 }
171}
172
173
174sub load_english_resource_bundle
175{
176 # Ensure the English resource bundle hasn't already been loaded
177 if (%specialresourcebundle && $specialresourcebundle{"{Language.code}"} eq "en") {
178 %englishresourcebundle = %specialresourcebundle;
179 $englishoutputencoding = $specialoutputencoding;
180 }
181
182 if ($defaultresourcebundle{"{Language.code}"} &&
183 $defaultresourcebundle{"{Language.code}"} eq "en") {
184 %englishresourcebundle = %defaultresourcebundle;
185 $englishoutputencoding = $defaultoutputencoding;
186 }
187
188 # Read the English resource bundle
189 my $resourcebundlename = "strings_en.properties";
190
191 %englishresourcebundle
192 = &read_resource_bundle_and_extensions($ENV{'GSDLHOME'},"perllib",$resourcebundlename);
193 return if (!%englishresourcebundle);
194
195 # Read the output encoding to use from the resource bundle
196 if ($ENV{'GSDLOS'} =~ /windows/) {
197 $englishoutputencoding = $englishresourcebundle{"{OutputEncoding.windows}"};
198 }
199 else {
200 $englishoutputencoding = $englishresourcebundle{"{OutputEncoding.unix}"};
201 }
202}
203
204
205sub 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 if (defined $ENV{'GSDLEXTS'}) {
216 my @extensions = split(/:/,$ENV{'GSDLEXTS'});
217 foreach my $e (@extensions) {
218 my $ext_base
219 = &util::filename_cat($bundle_base,"ext",$e);
220
221 my $ext_resourcebundlefile
222 = &util::filename_cat($ext_base,$primary_dir,$resourcename);
223
224 # can ignore return value (will be same reference to $resourcebundle)
225 read_resource_bundle($ext_resourcebundlefile,$resourcebundle);
226 }
227 }
228 if (defined $ENV{'GSDL3EXTS'}) {
229 my @extensions = split(/:/,$ENV{'GSDL3EXTS'});
230 foreach my $e (@extensions) {
231 my $ext_base
232 = &util::filename_cat($ENV{'GSDL3SRCHOME'},"ext",$e);
233
234 my $ext_resourcebundlefile
235 = &util::filename_cat($ext_base,$primary_dir,$resourcename);
236
237 # can ignore return value (will be same reference to $resourcebundle)
238 read_resource_bundle($ext_resourcebundlefile,$resourcebundle);
239 }
240 }
241
242 return %$resourcebundle;
243}
244
245
246sub read_resource_bundle
247{
248 my ($resourcebundlefilepath,$resourcebundle) = @_;
249
250 if (!open(RESOURCE_BUNDLE, "<$resourcebundlefilepath")) {
251 # When called for the first time (primary resource), $resourcebundle
252 # is not defined (=undef). If the file does not exist, then we return
253 # this 'undef' to signal it was not found
254 # For an extension resource bundle, if it does not exist this
255 # is not so serious (in fact quite likely) => return what we
256 # have built up so far
257
258 return $resourcebundle;
259 }
260
261 if (!defined $resourcebundle) {
262 # resource files exists, so exect some content to be stored
263 $resourcebundle = {};
264 }
265
266 # Load this resource bundle
267 my @resourcebundlelines = <RESOURCE_BUNDLE>;
268 close(RESOURCE_BUNDLE);
269
270 # Parse the resource bundle
271
272 foreach my $line (@resourcebundlelines) {
273 # Remove any trailing whitespace
274 $line =~ s/(\s*)$//;
275
276 # Ignore comments and empty lines
277 if ($line !~ /^\#/ && $line ne "") {
278 # Parse key (everything up to the first colon)
279 if ($line =~ m/^([^:]+):(.+)$/) {
280 my $linekey = "{" . $1 . "}";
281 my $linetext = $2;
282 $linetext =~ s/(\s*)\#\s+Updated\s+(\d?\d-\D\D\D-\d\d\d\d).*$//i;
283
284 # Map key to text
285 $resourcebundle->{$linekey} = $linetext;
286 }
287 }
288 }
289
290 return $resourcebundle;
291}
292
293
294sub output_strings_in_UTF8
295{
296 $outputstringsinUTF8 = 1;
297}
298
299
300sub debug_unicode_string
301{
302 join("",
303 map { $_ > 255 ? # if wide character...
304 sprintf("\\x{%04X}", $_) : # \x{...}
305 chr($_)
306 } unpack("U*", $_[0])); # unpack Unicode characters
307}
308
309
3101;
Note: See TracBrowser for help on using the repository browser.