Filename | /var/www/foswiki11/lib/Foswiki/I18N.pm |
Statements | Executed 28 statements in 3.44ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 890µs | 1.00ms | new | Foswiki::I18N::
1 | 1 | 1 | 29µs | 56µs | BEGIN@13 | Foswiki::I18N::
1 | 1 | 1 | 23µs | 65µs | BEGIN@15 | Foswiki::I18N::
1 | 1 | 1 | 18µs | 30µs | BEGIN@14 | Foswiki::I18N::
1 | 1 | 1 | 10µs | 10µs | BEGIN@58 | Foswiki::I18N::
1 | 1 | 1 | 7µs | 7µs | finish | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | __ANON__[:200] | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | _add_language | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | _discover_languages | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | _normalize_language_tag | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | available_languages | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | enabled_languages | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | fromSiteCharSet | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | language | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | maketext | Foswiki::I18N::
0 | 0 | 0 | 0s | 0s | toSiteCharSet | Foswiki::I18N::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # See bottom of file for license and copyright information | ||||
2 | |||||
3 | =begin TML | ||||
4 | |||||
5 | ---+ package Foswiki::I18N | ||||
6 | |||||
7 | Support for strings translation and language detection. | ||||
8 | |||||
9 | =cut | ||||
10 | |||||
11 | package Foswiki::I18N; | ||||
12 | |||||
13 | 2 | 58µs | 2 | 82µs | # spent 56µs (29+26) within Foswiki::I18N::BEGIN@13 which was called:
# once (29µs+26µs) by Foswiki::i18n at line 13 # spent 56µs making 1 call to Foswiki::I18N::BEGIN@13
# spent 26µs making 1 call to strict::import |
14 | 2 | 49µs | 2 | 41µs | # spent 30µs (18+11) within Foswiki::I18N::BEGIN@14 which was called:
# once (18µs+11µs) by Foswiki::i18n at line 14 # spent 30µs making 1 call to Foswiki::I18N::BEGIN@14
# spent 11µs making 1 call to warnings::import |
15 | 2 | 821µs | 2 | 107µs | # spent 65µs (23+42) within Foswiki::I18N::BEGIN@15 which was called:
# once (23µs+42µs) by Foswiki::i18n at line 15 # spent 65µs making 1 call to Foswiki::I18N::BEGIN@15
# spent 42µs making 1 call to Assert::import |
16 | |||||
17 | 1 | 200ns | our $initialised; | ||
18 | 1 | 600ns | our @initErrors; | ||
19 | |||||
20 | =begin TML | ||||
21 | |||||
22 | ---++ ClassMethod available_languages | ||||
23 | |||||
24 | Lists languages tags for languages available at Foswiki installation. Returns a | ||||
25 | list containing the tags of the available languages. | ||||
26 | |||||
27 | __Note__: the languages available to users are determined in the =configure= | ||||
28 | interface. | ||||
29 | |||||
30 | =cut | ||||
31 | |||||
32 | sub available_languages { | ||||
33 | |||||
34 | my @available; | ||||
35 | |||||
36 | while ( my ( $langCode, $langOptions ) = | ||||
37 | each %{ $Foswiki::cfg{Languages} } ) | ||||
38 | { | ||||
39 | if ( $langOptions->{Enabled} ) { | ||||
40 | push( @available, _normalize_language_tag($langCode) ); | ||||
41 | } | ||||
42 | } | ||||
43 | |||||
44 | return @available; | ||||
45 | } | ||||
46 | |||||
47 | # utility function: normalize language tags like ab_CD to ab-cd | ||||
48 | # also renove any character there is not a letter [a-z] or a hyphen. | ||||
49 | sub _normalize_language_tag { | ||||
50 | my $tag = shift; | ||||
51 | $tag = lc( $tag || '' ); | ||||
52 | $tag =~ s/\_/-/g; | ||||
53 | $tag =~ s/[^a-z-]//g; | ||||
54 | return $tag; | ||||
55 | } | ||||
56 | |||||
57 | # initialisation block | ||||
58 | # spent 10µs within Foswiki::I18N::BEGIN@58 which was called:
# once (10µs+0s) by Foswiki::i18n at line 129 | ||||
59 | |||||
60 | # we only need to proceed if user wants internationalisation support | ||||
61 | 1 | 17µs | return unless $Foswiki::cfg{UserInterfaceInternationalisation}; | ||
62 | |||||
63 | # no languages enabled is the same as disabling | ||||
64 | # {UserInterfaceInternationalisation} | ||||
65 | my @languages = available_languages(); | ||||
66 | return unless ( scalar(@languages) ); | ||||
67 | |||||
68 | # we first assume it's ok | ||||
69 | $initialised = 1; | ||||
70 | |||||
71 | eval "use Locale::Maketext ()"; | ||||
72 | if ($@) { | ||||
73 | $initialised = 0; | ||||
74 | push( @initErrors, | ||||
75 | "I18N: Couldn't load required perl module Locale::Maketext: " | ||||
76 | . $@ | ||||
77 | . "\nInstall the module or turn off {UserInterfaceInternationalisation}" | ||||
78 | ); | ||||
79 | } | ||||
80 | else { | ||||
81 | @Foswiki::I18N::ISA = ('Locale::Maketext'); | ||||
82 | } | ||||
83 | |||||
84 | unless ( $Foswiki::cfg{LocalesDir} && -e $Foswiki::cfg{LocalesDir} ) { | ||||
85 | push( @initErrors, | ||||
86 | 'I18N: {LocalesDir} not configured. Define it or turn off {UserInterfaceInternationalisation}' | ||||
87 | ); | ||||
88 | $initialised = 0; | ||||
89 | } | ||||
90 | |||||
91 | # dynamically build languages to be loaded according to admin-enabled | ||||
92 | # languages. | ||||
93 | eval "use Locale::Maketext::Lexicon{ en => [ 'Auto' ] } ;"; | ||||
94 | if ($@) { | ||||
95 | $initialised = 0; | ||||
96 | push( @initErrors, | ||||
97 | "I18N - Couldn't load default English messages: $@\n" | ||||
98 | . "Install Locale::Maketext::Lexicon or turn off {UserInterfaceInternationalisation}" | ||||
99 | ); | ||||
100 | } | ||||
101 | foreach my $lang (@languages) { | ||||
102 | my $langFile = "$Foswiki::cfg{LocalesDir}/$lang.po"; | ||||
103 | |||||
104 | # Use the compressed version if it exists | ||||
105 | if ( $langFile =~ m/^(.*)\.po$/ | ||||
106 | && -f "$1.mo" ) | ||||
107 | { | ||||
108 | $langFile = "$1.mo"; | ||||
109 | } | ||||
110 | if ( -f $langFile ) { | ||||
111 | unless ( | ||||
112 | eval { | ||||
113 | Locale::Maketext::Lexicon->import( | ||||
114 | { $lang => [ Gettext => $langFile ] } ); | ||||
115 | 1; | ||||
116 | } | ||||
117 | ) | ||||
118 | { | ||||
119 | push( @initErrors, | ||||
120 | "I18N - Error loading language $lang: $@\n" ); | ||||
121 | } | ||||
122 | } | ||||
123 | else { | ||||
124 | push( @initErrors, | ||||
125 | "I18N - Ignoring enabled language $lang as $langFile does not exist.\n" | ||||
126 | ); | ||||
127 | } | ||||
128 | } | ||||
129 | 1 | 2.29ms | 1 | 10µs | } # spent 10µs making 1 call to Foswiki::I18N::BEGIN@58 |
130 | |||||
131 | =begin TML | ||||
132 | |||||
133 | ---++ ClassMethod new ( $session ) | ||||
134 | |||||
135 | Constructor. Gets the language object corresponding to the current users | ||||
136 | language. If $session is not a Foswiki object reference, just calls | ||||
137 | Local::Maketext::new (the superclass constructor) | ||||
138 | |||||
139 | =cut | ||||
140 | |||||
141 | # spent 1.00ms (890µs+115µs) within Foswiki::I18N::new which was called:
# once (890µs+115µs) by Foswiki::i18n at line 2053 of /var/www/foswiki11/lib/Foswiki.pm | ||||
142 | 1 | 1µs | my $class = shift; | ||
143 | 1 | 1µs | my ($session) = @_; | ||
144 | |||||
145 | 1 | 25µs | 1 | 3µs | unless ( ref($session) && $session->isa('Foswiki') ) { # spent 3µs making 1 call to UNIVERSAL::isa |
146 | |||||
147 | # it's recursive | ||||
148 | return $class->SUPER::new(@_); | ||||
149 | } | ||||
150 | |||||
151 | 1 | 700ns | if (@initErrors) { | ||
152 | foreach my $error (@initErrors) { | ||||
153 | $session->logger->log( $initialised ? 'warning' : 'error', $error ); | ||||
154 | } | ||||
155 | } | ||||
156 | |||||
157 | # guesses the language from the CGI environment | ||||
158 | # TODO: | ||||
159 | # web/user/session setting must override the language detected from the | ||||
160 | # browser. | ||||
161 | 1 | 200ns | my $this; | ||
162 | 1 | 900ns | if ($initialised) { | ||
163 | $session->enterContext('i18n_enabled'); | ||||
164 | my $userLanguage = _normalize_language_tag( | ||||
165 | $session->{prefs}->getPreference('LANGUAGE') ); | ||||
166 | if ($userLanguage) { | ||||
167 | $this = Foswiki::I18N->get_handle($userLanguage); | ||||
168 | } | ||||
169 | else { | ||||
170 | $this = Foswiki::I18N->get_handle(); | ||||
171 | } | ||||
172 | } | ||||
173 | else { | ||||
174 | 1 | 132µs | require Foswiki::I18N::Fallback; | ||
175 | |||||
176 | 1 | 7µs | 1 | 20µs | $this = new Foswiki::I18N::Fallback(); # spent 20µs making 1 call to Foswiki::I18N::Fallback::new |
177 | |||||
178 | # we couldn't initialise 'optional' I18N infrastructure, warn that we | ||||
179 | # can only use English if I18N has been requested with configure | ||||
180 | 1 | 2µs | $session->logger->log( 'warning', | ||
181 | 'Could not load I18N infrastructure; falling back to English' ) | ||||
182 | if $Foswiki::cfg{UserInterfaceInternationalisation}; | ||||
183 | } | ||||
184 | |||||
185 | # keep a reference to the session object | ||||
186 | 1 | 2µs | $this->{session} = $session; | ||
187 | |||||
188 | # languages we know about | ||||
189 | 1 | 3µs | $this->{enabled_languages} = { en => 'English' }; | ||
190 | 1 | 900ns | $this->{checked_enabled} = undef; | ||
191 | |||||
192 | # what to do with failed translations (only needed when already initialised | ||||
193 | # and language is not English); | ||||
194 | 1 | 400ns | if ( $initialised and ( $this->language ne 'en' ) ) { | ||
195 | my $fallback_handle = Foswiki::I18N->get_handle('en'); | ||||
196 | $this->fail_with( | ||||
197 | sub { | ||||
198 | shift; # get rid of the handle | ||||
199 | return $fallback_handle->maketext(@_); | ||||
200 | } | ||||
201 | ); | ||||
202 | } | ||||
203 | |||||
204 | # finally! :-p | ||||
205 | 1 | 6µs | return $this; | ||
206 | } | ||||
207 | |||||
208 | =begin TML | ||||
209 | |||||
210 | ---++ ObjectMethod finish() | ||||
211 | Break circular references. | ||||
212 | |||||
213 | =cut | ||||
214 | |||||
215 | # Note to developers; please undef *all* fields in the object explicitly, | ||||
216 | # whether they are references or not. That way this method is "golden | ||||
217 | # documentation" of the live fields in the object. | ||||
218 | # spent 7µs within Foswiki::I18N::finish which was called:
# once (7µs+0s) by Foswiki::I18N::Fallback::finish at line 24 of /var/www/foswiki11/lib/Foswiki/I18N/Fallback.pm | ||||
219 | 1 | 600ns | my $this = shift; | ||
220 | 1 | 4µs | undef $this->{enabled_languages}; | ||
221 | 1 | 500ns | undef $this->{checked_enabled}; | ||
222 | 1 | 5µs | undef $this->{session}; | ||
223 | } | ||||
224 | |||||
225 | =begin TML | ||||
226 | |||||
227 | ---++ ObjectMethod maketext( $text ) -> $translation | ||||
228 | |||||
229 | Translates the given string (assumed to be written in English) into the | ||||
230 | current language, as detected in the constructor, and converts it into | ||||
231 | the site charset. | ||||
232 | |||||
233 | Wraps around Locale::Maketext's maketext method, adding charset conversion and checking | ||||
234 | |||||
235 | Return value: translated string, or the argument itself if no translation is | ||||
236 | found for thet argument. | ||||
237 | |||||
238 | =cut | ||||
239 | |||||
240 | sub maketext { | ||||
241 | my ( $this, $text, @args ) = @_; | ||||
242 | |||||
243 | # these can be user-supplied data. They can be in {Site}{CharSet}. Convert | ||||
244 | # into "internal representation" as expected by Foswiki::I18N::maketext | ||||
245 | @args = map { $this->fromSiteCharSet($_) } @args; | ||||
246 | |||||
247 | if ( $text =~ /^_/ && $text ne '_language_name' ) { | ||||
248 | require CGI; | ||||
249 | import CGI(); | ||||
250 | |||||
251 | return CGI::span( | ||||
252 | { -class => 'foswikiAlert' }, | ||||
253 | "Error: MAKETEXT argument's can't start with an underscore (\"_\")." | ||||
254 | ); | ||||
255 | } | ||||
256 | |||||
257 | my $result = $this->SUPER::maketext( $text, @args ); | ||||
258 | if ( $result && $this->{session} ) { | ||||
259 | |||||
260 | # external calls get the resultant text in the right charset: | ||||
261 | $result = $this->toSiteCharSet($result); | ||||
262 | } | ||||
263 | |||||
264 | return $result; | ||||
265 | } | ||||
266 | |||||
267 | =begin TML | ||||
268 | |||||
269 | ---++ ObjectMethod language() -> $language_tag | ||||
270 | |||||
271 | Indicates the language tag of the current user's language, as detected from the | ||||
272 | information sent by the browser. Returns the empty string if the language | ||||
273 | could not be determined. | ||||
274 | |||||
275 | =cut | ||||
276 | |||||
277 | sub language { | ||||
278 | my $this = shift; | ||||
279 | |||||
280 | return $this->language_tag(); | ||||
281 | } | ||||
282 | |||||
283 | =begin TML | ||||
284 | |||||
285 | ---++ ObjectMethod enabled_languages() -> %languages | ||||
286 | |||||
287 | Returns an array with language tags as keys and language (native) names as | ||||
288 | values, for all the languages enabled in this site. Useful for | ||||
289 | listing available languages to the user. | ||||
290 | |||||
291 | =cut | ||||
292 | |||||
293 | sub enabled_languages { | ||||
294 | my $this = shift; | ||||
295 | |||||
296 | unless ( $this->{checked_enabled} ) { | ||||
297 | _discover_languages($this); | ||||
298 | } | ||||
299 | |||||
300 | $this->{checked_enabled} = 1; | ||||
301 | return $this->{enabled_languages}; | ||||
302 | |||||
303 | } | ||||
304 | |||||
305 | # discovers the available language. | ||||
306 | sub _discover_languages { | ||||
307 | my $this = shift; | ||||
308 | my $cache_open = 0; | ||||
309 | |||||
310 | #use the cache, if available | ||||
311 | if ( open LANGUAGE, '<', "$Foswiki::cfg{WorkingDir}/languages.cache" ) { | ||||
312 | $cache_open = 1; | ||||
313 | foreach my $line (<LANGUAGE>) { | ||||
314 | my ( $key, $name ) = split( '=', $line ); | ||||
315 | |||||
316 | # Filter on enabled languages | ||||
317 | next | ||||
318 | unless ( $Foswiki::cfg{Languages}{$key} | ||||
319 | && $Foswiki::cfg{Languages}{$key}{Enabled} ); | ||||
320 | chop($name); | ||||
321 | _add_language( $this, $key, $name ); | ||||
322 | } | ||||
323 | } | ||||
324 | else { | ||||
325 | |||||
326 | # Rebuild the cache, filtering on enabled languages. | ||||
327 | $cache_open = | ||||
328 | open( LANGUAGE, '>', "$Foswiki::cfg{WorkingDir}/languages.cache" ); | ||||
329 | foreach my $tag ( available_languages() ) { | ||||
330 | my $h = Foswiki::I18N->get_handle($tag); | ||||
331 | my $name = eval { $h->maketext("_language_name") } or next; | ||||
332 | $name = $this->toSiteCharSet($name); | ||||
333 | print LANGUAGE "$tag=$name\n" if $cache_open; | ||||
334 | |||||
335 | # Filter on enabled languages | ||||
336 | next | ||||
337 | unless ( $Foswiki::cfg{Languages}{$tag} | ||||
338 | && $Foswiki::cfg{Languages}{$tag}{Enabled} ); | ||||
339 | _add_language( $this, $tag, $name ); | ||||
340 | } | ||||
341 | } | ||||
342 | |||||
343 | close LANGUAGE if $cache_open; | ||||
344 | $this->{checked_enabled} = 1; | ||||
345 | |||||
346 | } | ||||
347 | |||||
348 | =begin TML | ||||
349 | |||||
350 | ---++ ObjectMethod fromSiteCharSet ( $text ) -> $encoded | ||||
351 | |||||
352 | This method receives =$text=, assumed to be encoded in {Site}{CharSet}, and | ||||
353 | converts it to a internal representation. | ||||
354 | |||||
355 | Currently this representation will be a UTF-8 string, but this may change in | ||||
356 | the future. This way, you can't assume any property on the returned value, and | ||||
357 | should only use the returned value of this function as input to toSiteCharSet. | ||||
358 | If you change the returnd value, either by removing, updating or appending | ||||
359 | characters, be sure to touch only ASCII characters (i.e., characters that have | ||||
360 | ord() less than 128). | ||||
361 | |||||
362 | =cut | ||||
363 | |||||
364 | sub fromSiteCharSet { | ||||
365 | my ( $this, $text ) = @_; | ||||
366 | |||||
367 | return $text | ||||
368 | if ( !defined $Foswiki::cfg{Site}{CharSet} | ||||
369 | || $Foswiki::cfg{Site}{CharSet} =~ m/^utf-?8$/i ); | ||||
370 | |||||
371 | if ( $] < 5.008 ) { | ||||
372 | |||||
373 | # use Unicode::MapUTF8 for Perl older than 5.8 | ||||
374 | require Unicode::MapUTF8; | ||||
375 | my $encoding = $Foswiki::cfg{Site}{CharSet}; | ||||
376 | if ( Unicode::MapUTF8::utf8_supported_charset($encoding) ) { | ||||
377 | return Unicode::MapUTF8::to_utf8( | ||||
378 | { | ||||
379 | -string => $text, | ||||
380 | -charset => $encoding | ||||
381 | } | ||||
382 | ); | ||||
383 | } | ||||
384 | else { | ||||
385 | $this->{session}->logger->log( 'warning', | ||||
386 | 'Conversion from $encoding no supported, ' | ||||
387 | . 'or name not recognised - check perldoc Unicode::MapUTF8' ); | ||||
388 | return $text; | ||||
389 | } | ||||
390 | } | ||||
391 | else { | ||||
392 | |||||
393 | # good Perl version, just use Encode | ||||
394 | require Encode; | ||||
395 | import Encode; | ||||
396 | my $encoding = Encode::resolve_alias( $Foswiki::cfg{Site}{CharSet} ); | ||||
397 | if ( not $encoding ) { | ||||
398 | $this->{session}->logger->log( 'warning', | ||||
399 | 'Conversion to "' | ||||
400 | . $Foswiki::cfg{Site}{CharSet} | ||||
401 | . '" not supported, or name not recognised - check ' | ||||
402 | . '"perldoc Encode::Supported"' ); | ||||
403 | return; | ||||
404 | } | ||||
405 | else { | ||||
406 | my $octets = | ||||
407 | Encode::decode( $encoding, $text, &Encode::FB_PERLQQ() ); | ||||
408 | return Encode::encode( 'utf-8', $octets ); | ||||
409 | } | ||||
410 | } | ||||
411 | } | ||||
412 | |||||
413 | =begin TML | ||||
414 | |||||
415 | |||||
416 | ---++ ObjectMethod toSiteCharSet ( $encoded ) -> $text | ||||
417 | |||||
418 | This method receives a string, assumed to be encoded in Foswiki's internal string | ||||
419 | representation (as generated by the fromSiteCharSet method, and converts it | ||||
420 | into {Site}{CharSet}. | ||||
421 | |||||
422 | When converting into {Site}{CharSet}, characters that are not present at that | ||||
423 | charset are represented as HTML numerical character entities (NCR's), in the | ||||
424 | format <code>&#NNNN;</code>, where NNNN is the character's Unicode | ||||
425 | codepoint. | ||||
426 | |||||
427 | See also: the =fromSiteCharSet= method. | ||||
428 | |||||
429 | =cut | ||||
430 | |||||
431 | sub toSiteCharSet { | ||||
432 | my ( $this, $encoded ) = @_; | ||||
433 | |||||
434 | return $encoded | ||||
435 | if ( !defined $Foswiki::cfg{Site}{CharSet} | ||||
436 | || $Foswiki::cfg{Site}{CharSet} =~ m/^utf-?8$/i ); | ||||
437 | |||||
438 | if ( $] < 5.008 ) { | ||||
439 | |||||
440 | # use Unicode::MapUTF8 for Perl older than 5.8 | ||||
441 | require Unicode::MapUTF8; | ||||
442 | my $encoding = $Foswiki::cfg{Site}{CharSet}; | ||||
443 | if ( Unicode::MapUTF8::utf8_supported_charset($encoding) ) { | ||||
444 | return Unicode::MapUTF8::from_utf8( | ||||
445 | { | ||||
446 | -string => $encoded, | ||||
447 | -charset => $encoding | ||||
448 | } | ||||
449 | ); | ||||
450 | } | ||||
451 | else { | ||||
452 | $this->{session}->logger->log( 'warning', | ||||
453 | 'Conversion to $encoding no supported, ' | ||||
454 | . 'or name not recognised - check perldoc Unicode::MapUTF8' ); | ||||
455 | return $encoded; | ||||
456 | } | ||||
457 | } | ||||
458 | else { | ||||
459 | require Encode; | ||||
460 | import Encode; | ||||
461 | my $encoding = Encode::resolve_alias( $Foswiki::cfg{Site}{CharSet} ); | ||||
462 | if ( not $encoding ) { | ||||
463 | $this->{session}->logger->log( 'warning', | ||||
464 | 'Conversion from "' | ||||
465 | . $Foswiki::cfg{Site}{CharSet} | ||||
466 | . '" not supported, or name not recognised - check ' | ||||
467 | . '"perldoc Encode::Supported"' ); | ||||
468 | return $encoded; | ||||
469 | } | ||||
470 | else { | ||||
471 | |||||
472 | # converts to {Site}{CharSet}, generating HTML NCR's when needed | ||||
473 | my $octets = Encode::decode( 'utf-8', $encoded ); | ||||
474 | return Encode::encode( $encoding, $octets, &Encode::FB_HTMLCREF() ); | ||||
475 | } | ||||
476 | } | ||||
477 | } | ||||
478 | |||||
479 | # private utility method: add a pair tag/language name | ||||
480 | sub _add_language { | ||||
481 | my ( $this, $tag, $name ) = @_; | ||||
482 | $this->{enabled_languages}->{$tag} = $name; | ||||
483 | } | ||||
484 | |||||
485 | 1 | 5µs | 1; | ||
486 | __END__ |