Annotation of loncom/localize/lonlocal.pm, revision 1.56
1.1 www 1: # The LearningOnline Network with CAPA
2: # Localization routines
3: #
1.56 ! bisitz 4: # $Id: lonlocal.pm,v 1.55 2009/02/05 10:39:09 bisitz Exp $
1.1 www 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA 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: # LON-CAPA 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 LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: ######################################################################
29: ######################################################################
1.10 bowersj2 30:
31: =pod
32:
33: =head1 NAME
34:
35: Apache::lonlocal - provides localization services
36:
37: =head1 SYNOPSIS
38:
39: lonlocal provides localization services for LON-CAPA programmers based
40: on Locale::Maketext. See
41: C<http://search.cpan.org/dist/Locale-Maketext/lib/Locale/Maketext.pod>
42: for more information on Maketext.
43:
44: =head1 OVERVIEWX<internationalization>
45:
46: As of LON-CAPA 1.1, we've started to localize LON-CAPA using the
47: Locale::Maketext module. Internationalization is the bulk of the work
48: right now (pre-1.1); localizing can be done anytime, and involves
49: little or no programming.
50:
51: The internationalization process involves putting a wrapper around
52: on-screen user messages and menus and turning them into keys,
53: which the MaketextX<Maketext> library translates into the desired
54: language output using a look-up table ("lexicon").X<lexicon>
55:
56: As keys we are currently using the plain English messages, and
57: Maketext is configured to replace the message by its own key if no
58: translation is found. This makes it easy to phase in the
59: internationalization without disturbing the screen output.
60:
61: Internationalization is somewhat tedious and effectively impossible
62: for a non-fluent speaker to perform, but is fairly easy to create
63: translations, requiring no programming skill. As a result, this is one
64: area where you can really help LON-CAPA out, even if you aren't a
65: programmer, and we'd really appreciate it.
66:
67: =head1 How To Localize Handlers For Programmers
68:
69: Into the "use" section of a module, we need to insert
70:
71: use Apache::lonlocal;
72:
73: Note that there are B<no parentheses>, we B<want> to pollute our
74: namespace.
75:
76: Inside might be something like this
77:
78: sub message {
79: my $status=shift;
80: my $message='Status unknown';
81: if ($status eq 'WON') {
82: $message='You have won.';
83: } elsif ($status eq 'LOST') {
84: $message='You are a total looser.';
85: }
86: return $message;
87: }
88: ...
89: $r->print('<h3>Gamble your Homework Points</h3>');
90: ...
91: $r->print(<<ENDMSG);
92: <font size="1">Rules:</font>
93: <font size="0">No purchase necessary. Illegal where not allowed.</font>
94: ENDMSG
95:
96: We have to now wrap the subroutine &mt()X<mt> ("maketext") around our
97: messages, but not around markup, etc. We also want minimal disturbance.
98: The first two examples are easy:
99:
100: sub message {
101: my $status=shift;
102: my $message='Status unknown';
103: if ($status eq 'WON') {
104: $message='You have won.';
105: } elsif ($status eq 'LOST') {
106: $message='You are a total looser.';
107: }
108: return &mt($message);
109: }
110: ...
111: $r->print('<h3>'.&mt('Gamble your Homework Points').'</h3>');
112:
113: The last one is a bummer, since you cannot call subroutines inside of
114: (<<MARKER). I have written a little subroutine to generate a translated
115: hash for that purpose:
116:
117: my %lt=&Apache::lonlocal::texthash('header' => 'Rules', 'disclaimer' =>
118: 'No purchase necessary. Illegal where not allowed.');
119: $r->print(<<ENDMSG);
120: <font size="1">$lt{'header'}:</font>
121: <font size="0">$lt{'disclaimer'}</font>
122: ENDMSG
123:
124: As a programmer, your job is done here. If everything worked, you
125: should see no changes on the screen.
126:
127: =head1 How To Localize LON-CAPA for Translators
128:
129: As a translator, you need to provide the lexicon for the keys, which in
130: this case is the plain text message. The lexicons sit in
131: loncom/localize/localize, with the language code as filename, for
132: example de.pm for the German translation. The file then simply looks
133: like this:
134:
135: 'You have won.'
136: => 'Sie haben gewonnen.',
137:
138: 'You are a total looser.'
139: => 'Sie sind der totale Verlierer.',
140:
141: 'Rules'
142: => 'Regeln',
143:
144: 'No purchase necessary. Illegal where not allowed.'
145: => 'Es ist erlaubt, einfach zu verlieren, und das ist Ihre Schuld.'
146:
147:
148: Comments may be added with the # symbol, which outside of a string
149: (the things with the apostrophe surrounding them, which are the
150: keys and translations) will cause the translation routines to
151: ignore the rest of the line.
152:
153: This is a relatively easy task, and any help is appreciated.
154:
155: Maketext can do a whole lot more, see
156: C<http://search.cpan.org/dist/Locale-Maketext/lib/Locale/Maketext.pod>
157: but for most purposes, we do not have to mess with that.
158:
159: =cut
1.1 www 160:
161: package Apache::lonlocal;
162:
163: use strict;
164: use Apache::localize;
1.14 www 165: use locale;
1.39 albertel 166: use POSIX qw(locale_h strftime);
1.42 albertel 167: use DateTime();
1.46 raeburn 168: use DateTime::TimeZone;
1.49 raeburn 169: use DateTime::Locale;
1.1 www 170:
171: require Exporter;
172:
173: our @ISA = qw (Exporter);
1.48 raeburn 174: our @EXPORT = qw(mt mtn ns mt_user);
1.1 www 175:
176: # ========================================================= The language handle
177:
178: use vars qw($lh);
179:
180: # ===================================================== The "MakeText" function
181:
1.55 bisitz 182: # ######### Localize Cache
183: # my @localize_cache;
184: # #########
1.54 lueken 185:
1.1 www 186: sub mt (@) {
1.36 albertel 187: # open(LOG,'>>/home/www/loncapa/loncom/localize/localize/newphrases.txt');
188: # print LOG (@_[0]."\n");
189: # close(LOG);
1.26 www 190: if ($lh) {
1.44 raeburn 191: if ($_[0] eq '') {
192: if (wantarray) {
193: return @_;
194: } else {
195: return $_[0];
196: }
197: } else {
1.55 bisitz 198: return $lh->maketext(@_);
199: # ######### Localize Cache
200: # foreach my $e (@localize_cache)
201: # {
202: # if($_[0] eq $$e[0]) { return $$e[1]; }
203: # }
204: #
205: # if($#localize_cache == 100) { pop(@localize_cache); }
206: # my $localize_entry = $lh->maketext(@_);
207: # unshift(@localize_cache, [ @_, $localize_entry ] );
208: # #########
209: #
210: # return $localize_entry;
1.44 raeburn 211: }
1.3 www 212: } else {
1.31 albertel 213: if (wantarray) {
214: return @_;
215: } else {
216: return $_[0];
217: }
1.4 www 218: }
219: }
220:
1.48 raeburn 221: sub mt_user {
222: my ($user_lh,@what) = @_;
223: if ($user_lh) {
224: if ($what[0] eq '') {
225: if (wantarray) {
226: return @what;
227: } else {
228: return $what[0];
229: }
230: } else {
231: return $user_lh->maketext(@what);
232: }
233: } else {
234: if (wantarray) {
235: return @what;
236: } else {
237: return $what[0];
238: }
239: }
240: }
241:
1.6 www 242: # ============================================================== What language?
243:
244: sub current_language {
1.20 albertel 245: if ($lh) {
246: my $lang=$lh->maketext('language_code');
247: return ($lang eq 'language_code'?'en':$lang);
248: }
1.21 www 249: return 'en';
1.6 www 250: }
251:
1.52 raeburn 252: sub preferred_languages {
253: my @languages=();
254: if (($Apache::lonnet::env{'request.role.adv'}) && ($Apache::lonnet::env{'form.languages'})) {
255: @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$Apache::lonnet::env{'form.languages'}));
256: }
257: if ($Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.languages'}) {
258: @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
259: $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.languages'}));
260: }
261:
262: if ($Apache::lonnet::env{'environment.languages'}) {
263: @languages=(@languages,
264: split(/\s*(\,|\;|\:)\s*/,$Apache::lonnet::env{'environment.languages'}));
265: }
266: my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
267: if ($browser) {
268: my @browser =
269: map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
270: push(@languages,@browser);
271: }
272:
273: foreach my $domtype ($Apache::lonnet::env{'user.domain'},$Apache::lonnet::env{'request.role.domain'},
274: $Apache::lonnet::perlvar{'lonDefDomain'}) {
275: if ($domtype ne '') {
276: my %domdefs = &Apache::lonnet::get_domain_defaults($domtype);
277: if ($domdefs{'lang_def'} ne '') {
278: push(@languages,$domdefs{'lang_def'});
279: }
280: }
281: }
282: return &get_genlanguages(@languages);
283: }
284:
285: sub get_genlanguages {
286: my (@languages) = @_;
287: # turn "en-ca" into "en-ca,en"
288: my @genlanguages;
289: foreach my $lang (@languages) {
290: unless ($lang=~/\w/) { next; }
291: push(@genlanguages,$lang);
292: if ($lang=~/(\-|\_)/) {
293: push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
294: }
295: }
296: #uniqueify the languages list
297: my %count;
298: @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
299: return @genlanguages;
300: }
301:
1.8 www 302: # ============================================================== What encoding?
303:
304: sub current_encoding {
1.33 albertel 305: my $default='UTF-8';
1.56 ! bisitz 306: # UTF-8 character encoding needed for the whole LON-CAPA system
! 307: # (interface language and homework problem content)
! 308: # See Bugzilla 5702 vs. 2189 and 4067
! 309: # if ($Apache::lonnet::env{'browser.os'} eq 'win' &&
! 310: # $Apache::lonnet::env{'browser.type'} eq 'explorer') {
! 311: # $default='ISO-8859-1';
! 312: # }
1.12 albertel 313: if ($lh) {
314: my $enc=$lh->maketext('char_encoding');
1.33 albertel 315: return ($enc eq 'char_encoding'?$default:$enc);
1.12 albertel 316: } else {
1.33 albertel 317: return $default;
1.12 albertel 318: }
1.8 www 319: }
320:
1.15 www 321: # =============================================================== Which locale?
322: # Refer to locale -a
323: #
324: sub current_locale {
325: if ($lh) {
326: my $enc=$lh->maketext('lang_locale');
327: return ($enc eq 'lang_locale'?'':$enc);
328: } else {
329: return undef;
330: }
331: }
332:
1.4 www 333: # ============================================================== Translate hash
334:
335: sub texthash {
336: my %hash=@_;
337: foreach (keys %hash) {
338: $hash{$_}=&mt($hash{$_});
339: }
340: return %hash;
1.1 www 341: }
342:
343: # ========= Get a handle (do not invoke in vain, leave this to access handlers)
344:
345: sub get_language_handle {
1.9 www 346: my $r=shift;
1.31 albertel 347: if ($r) {
348: my $headers=$r->headers_in;
349: $ENV{'HTTP_ACCEPT_LANGUAGE'}=$headers->{'Accept-language'};
350: }
1.52 raeburn 351: my @languages=&preferred_languages();
1.29 www 352: $ENV{'HTTP_ACCEPT_LANGUAGE'}='';
353: $lh=Apache::localize->get_handle(@languages);
1.37 albertel 354: if ($r) {
1.12 albertel 355: $r->content_languages([¤t_language()]);
1.8 www 356: }
1.16 www 357: ### setlocale(LC_ALL,¤t_locale);
1.18 www 358: }
359:
360: # ========================================================== Localize localtime
1.35 www 361: sub gettimezone {
1.53 raeburn 362: my ($timezone) = @_;
363: if ($timezone ne '') {
364: if (!DateTime::TimeZone->is_valid_name($timezone)) {
365: $timezone = 'local';
366: }
367: return $timezone;
368: }
369: my $cid = $Apache::lonnet::env{'request.course.id'};
370: if ($cid ne '') {
371: if ($Apache::lonnet::env{'course.'.$cid.'.timezone'}) {
372: $timezone = $Apache::lonnet::env{'course.'.$cid.'.timezone'};
373: } else {
374: my $cdom = $Apache::lonnet::env{'course.'.$cid.'.domain'};
375: if ($cdom ne '') {
376: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
377: if ($domdefaults{'timezone_def'} ne '') {
378: $timezone = $domdefaults{'timezone_def'};
379: }
1.45 raeburn 380: }
381: }
1.50 raeburn 382: } elsif ($Apache::lonnet::env{'request.role.domain'} ne '') {
383: my %uroledomdefs =
384: &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'request.role.domain'});
385: if ($uroledomdefs{'timezone_def'} ne '') {
386: $timezone = $uroledomdefs{'timezone_def'};
387: }
388: } elsif ($Apache::lonnet::env{'user.domain'} ne '') {
389: my %udomdefaults =
390: &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'user.domain'});
391: if ($udomdefaults{'timezone_def'} ne '') {
392: $timezone = $udomdefaults{'timezone_def'};
393: }
1.42 albertel 394: }
1.46 raeburn 395: if ($timezone ne '') {
396: if (DateTime::TimeZone->is_valid_name($timezone)) {
397: return $timezone;
398: }
399: }
1.42 albertel 400: return 'local';
1.35 www 401: }
1.18 www 402:
403: sub locallocaltime {
1.53 raeburn 404: my ($thistime,$timezone) = @_;
1.40 albertel 405: if (!defined($thistime) || $thistime eq '') {
406: return &mt('Never');
407: }
1.47 raeburn 408: if (($thistime < 0) || ($thistime eq 'NaN')) {
409: &Apache::lonnet::logthis("Unexpected time (negative or NaN) '$thistime' passed to lonlocal::locallocaltime");
410: return &mt('Never');
411: }
412: if ($thistime !~ /^\d+$/) {
413: &Apache::lonnet::logthis("Unexpected non-numeric time '$thistime' passed to lonlocal::locallocaltime");
414: return &mt('Never');
415: }
1.42 albertel 416:
417: my $dt = DateTime->from_epoch(epoch => $thistime)
1.53 raeburn 418: ->set_time_zone(&gettimezone($timezone));
1.18 www 419: if ((¤t_language=~/^en/) || (!$lh)) {
1.42 albertel 420:
421: return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
1.18 www 422: } else {
423: my $format=$lh->maketext('date_locale');
424: if ($format eq 'date_locale') {
1.42 albertel 425: return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
1.18 www 426: }
1.42 albertel 427: my $time_zone = $dt->time_zone_short_name();
428: my $seconds = $dt->second();
429: my $minutes = $dt->minute();
430: my $twentyfour = $dt->hour();
431: my $day = $dt->day_of_month();
432: my $mon = $dt->month()-1;
433: my $year = $dt->year();
1.43 www 434: my $wday = $dt->wday();
435: if ($wday==7) { $wday=0; }
1.42 albertel 436: my $month =(split(/\,/,$lh->maketext('date_months')))[$mon];
1.18 www 437: my $weekday=(split(/\,/,$lh->maketext('date_days')))[$wday];
438: if ($seconds<10) {
439: $seconds='0'.$seconds;
440: }
441: if ($minutes<10) {
442: $minutes='0'.$minutes;
443: }
444: my $twelve=$twentyfour;
1.19 www 445: my $ampm;
1.18 www 446: if ($twelve>12) {
447: $twelve-=12;
1.19 www 448: $ampm=$lh->maketext('date_pm');
1.18 www 449: } else {
1.19 www 450: $ampm=$lh->maketext('date_am');
1.18 www 451: }
1.42 albertel 452: foreach ('seconds','minutes','twentyfour','twelve','day','year',
453: 'month','weekday','ampm') {
1.18 www 454: $format=~s/\$$_/eval('$'.$_)/gse;
455: }
1.42 albertel 456: return $format." ($time_zone)";
1.18 www 457: }
1.1 www 458: }
459:
1.49 raeburn 460: sub getdatelocale {
461: my ($datelocale,$locale_obj);
462: if ($Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.datelocale'}) {
463: $datelocale = $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.datelocale'};
464: } elsif ($Apache::lonnet::env{'request.course.id'} ne '') {
465: my $cdom = $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.domain'};
466: if ($cdom ne '') {
467: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
468: if ($domdefaults{'datelocale_def'} ne '') {
469: $datelocale = $domdefaults{'datelocale_def'};
470: }
471: }
472: } elsif ($Apache::lonnet::env{'user.domain'} ne '') {
473: my %udomdefaults = &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'user.domain'});
474: if ($udomdefaults{'datelocale_def'} ne '') {
475: $datelocale = $udomdefaults{'datelocale_def'};
476: }
477: }
478: if ($datelocale ne '') {
479: eval {
480: $locale_obj = DateTime::Locale->load($datelocale);
481: };
482: if (!$@) {
483: if ($locale_obj->id() eq $datelocale) {
484: return $locale_obj;
485: }
486: }
487: }
488: return $locale_obj;
489: }
490:
1.51 jms 491: =pod
492:
493: =item * normalize_string
494:
495: Normalize string (reduce fragility in the lexicon files)
1.49 raeburn 496:
1.51 jms 497: This normalizes a string to reduce fragility in the lexicon files of
498: huge messages (such as are used by the helper), and allow useful
499: formatting: reduce all consecutive whitespace to a single space,
500: and remove all HTML
501:
502: =cut
1.17 bowersj2 503:
504: sub normalize_string {
505: my $s = shift;
506: $s =~ s/\s+/ /g;
507: $s =~ s/<[^>]+>//g;
1.22 bowersj2 508: # Pop off beginning or ending spaces, which aren't good
509: $s =~ s/^\s+//;
510: $s =~ s/\s+$//;
1.17 bowersj2 511: return $s;
512: }
1.22 bowersj2 513:
1.51 jms 514: =pod
515:
516: =item * ns
517:
518: alias for normalize_string; recommend using it only in the lexicon
519:
520: =cut
521:
1.22 bowersj2 522: sub ns {
523: return normalize_string(@_);
524: }
525:
1.51 jms 526: =pod
527:
528: =item * mtn
529:
530: mtn: call the mt function and the normalization function easily.
531: Returns original non-normalized string if there was no translation
532:
533: =cut
534:
1.22 bowersj2 535: sub mtn (@) {
536: my @args = @_; # don't want to modify caller's string; if we
537: # didn't care about that we could set $_[0]
538: # directly
539: $args[0] = normalize_string($args[0]);
540: my $translation = &mt(@args);
541: if ($translation ne $args[0]) {
542: return $translation;
543: } else {
544: return $_[0];
545: }
1.27 www 546: }
547:
548: # ---------------------------------------------------- Replace MT{...} in files
549:
550: sub transstatic {
551: my $strptr=shift;
552: $$strptr=~s/MT\{([^\}]*)\}/&mt($1)/gse;
553: }
554:
1.41 albertel 555: =pod
556:
557: =item * mt_escape
558:
559: mt_escape takes a string reference and escape the [] in there so mt
560: will leave them as is and not try to expand them
561:
562: =cut
563:
564: sub mt_escape {
565: my ($str_ref) = @_;
566: $$str_ref =~s/~/~~/g;
567: $$str_ref =~s/([\[\]])/~$1/g;
568: }
569:
1.1 www 570: 1;
571:
572: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonlocal.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / localize