1: # The LearningOnline Network with CAPA
2: # Localization routines
3: #
4: # $Id: lonlocal.pm,v 1.58 2009/05/04 21:44:00 lueken Exp $
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: ######################################################################
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
160:
161: package Apache::lonlocal;
162:
163: use strict;
164: use Apache::localize;
165: use locale;
166: use POSIX qw(locale_h strftime);
167: use DateTime();
168: use DateTime::TimeZone;
169: use DateTime::Locale;
170:
171: require Exporter;
172:
173: our @ISA = qw (Exporter);
174: our @EXPORT = qw(mt mtn ns mt_user);
175:
176: my %mtcache=();
177:
178: # ========================================================= The language handle
179:
180: use vars qw($lh $current_language);
181:
182: # ===================================================== The "MakeText" function
183:
184: sub mt (@) {
185: # open(LOG,'>>/home/www/loncapa/loncom/localize/localize/newphrases.txt');
186: # print LOG (@_[0]."\n");
187: # close(LOG);
188: if ($lh) {
189: if ($_[0] eq '') {
190: if (wantarray) {
191: return @_;
192: } else {
193: return $_[0];
194: }
195: } else {
196: if ($#_>0) { return $lh->maketext(@_); }
197: if ($mtcache{$current_language.':'.$_[0]}) {
198: return $mtcache{$current_language.':'.$_[0]};
199: }
200: my $translation=$lh->maketext(@_);
201: $mtcache{$current_language.':'.$_[0]}=$translation;
202: return $translation;
203: }
204: } else {
205: if (wantarray) {
206: return @_;
207: } else {
208: return $_[0];
209: }
210: }
211: }
212:
213: sub mt_user {
214: my ($user_lh,@what) = @_;
215: if ($user_lh) {
216: if ($what[0] eq '') {
217: if (wantarray) {
218: return @what;
219: } else {
220: return $what[0];
221: }
222: } else {
223: return $user_lh->maketext(@what);
224: }
225: } else {
226: if (wantarray) {
227: return @what;
228: } else {
229: return $what[0];
230: }
231: }
232: }
233:
234: # ============================================================== What language?
235:
236: sub current_language {
237: if ($lh) {
238: my $lang=$lh->maketext('language_code');
239: return ($lang eq 'language_code'?'en':$lang);
240: }
241: return 'en';
242: }
243:
244: sub preferred_languages {
245: my @languages=();
246: if (($Apache::lonnet::env{'request.role.adv'}) && ($Apache::lonnet::env{'form.languages'})) {
247: @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$Apache::lonnet::env{'form.languages'}));
248: }
249: if ($Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.languages'}) {
250: @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
251: $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.languages'}));
252: }
253:
254: if ($Apache::lonnet::env{'environment.languages'}) {
255: @languages=(@languages,
256: split(/\s*(\,|\;|\:)\s*/,$Apache::lonnet::env{'environment.languages'}));
257: }
258: my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
259: if ($browser) {
260: my @browser =
261: map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
262: push(@languages,@browser);
263: }
264:
265: foreach my $domtype ($Apache::lonnet::env{'user.domain'},$Apache::lonnet::env{'request.role.domain'},
266: $Apache::lonnet::perlvar{'lonDefDomain'}) {
267: if ($domtype ne '') {
268: my %domdefs = &Apache::lonnet::get_domain_defaults($domtype);
269: if ($domdefs{'lang_def'} ne '') {
270: push(@languages,$domdefs{'lang_def'});
271: }
272: }
273: }
274: return &get_genlanguages(@languages);
275: }
276:
277: sub get_genlanguages {
278: my (@languages) = @_;
279: # turn "en-ca" into "en-ca,en"
280: my @genlanguages;
281: foreach my $lang (@languages) {
282: unless ($lang=~/\w/) { next; }
283: push(@genlanguages,$lang);
284: if ($lang=~/(\-|\_)/) {
285: push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
286: }
287: }
288: #uniqueify the languages list
289: my %count;
290: @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
291: return @genlanguages;
292: }
293:
294: # ============================================================== What encoding?
295:
296: sub current_encoding {
297: my $default='UTF-8';
298: # UTF-8 character encoding needed for the whole LON-CAPA system
299: # (interface language and homework problem content)
300: # See Bugzilla 5702 vs. 2189 and 4067
301: # if ($Apache::lonnet::env{'browser.os'} eq 'win' &&
302: # $Apache::lonnet::env{'browser.type'} eq 'explorer') {
303: # $default='ISO-8859-1';
304: # }
305: if ($lh) {
306: my $enc=$lh->maketext('char_encoding');
307: return ($enc eq 'char_encoding'?$default:$enc);
308: } else {
309: return $default;
310: }
311: }
312:
313: # =============================================================== Which locale?
314: # Refer to locale -a
315: #
316: sub current_locale {
317: if ($lh) {
318: my $enc=$lh->maketext('lang_locale');
319: return ($enc eq 'lang_locale'?'':$enc);
320: } else {
321: return undef;
322: }
323: }
324:
325: # ============================================================== Translate hash
326:
327: sub texthash {
328: my %hash=@_;
329: foreach (keys %hash) {
330: $hash{$_}=&mt($hash{$_});
331: }
332: return %hash;
333: }
334:
335: # ========= Get a handle (do not invoke in vain, leave this to access handlers)
336:
337: sub get_language_handle {
338: my $r=shift;
339: if ($r) {
340: my $headers=$r->headers_in;
341: $ENV{'HTTP_ACCEPT_LANGUAGE'}=$headers->{'Accept-language'};
342: }
343: my @languages=&preferred_languages();
344: $ENV{'HTTP_ACCEPT_LANGUAGE'}='';
345: $lh=Apache::localize->get_handle(@languages);
346: $current_language=¤t_language();
347: if ($r) {
348: $r->content_languages([¤t_language()]);
349: }
350: ### setlocale(LC_ALL,¤t_locale);
351: }
352:
353: # ========================================================== Localize localtime
354: sub gettimezone {
355: my ($timezone) = @_;
356: if ($timezone ne '') {
357: if (!DateTime::TimeZone->is_valid_name($timezone)) {
358: $timezone = 'local';
359: }
360: return $timezone;
361: }
362: my $cid = $Apache::lonnet::env{'request.course.id'};
363: if ($cid ne '') {
364: if ($Apache::lonnet::env{'course.'.$cid.'.timezone'}) {
365: $timezone = $Apache::lonnet::env{'course.'.$cid.'.timezone'};
366: } else {
367: my $cdom = $Apache::lonnet::env{'course.'.$cid.'.domain'};
368: if ($cdom ne '') {
369: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
370: if ($domdefaults{'timezone_def'} ne '') {
371: $timezone = $domdefaults{'timezone_def'};
372: }
373: }
374: }
375: } elsif ($Apache::lonnet::env{'request.role.domain'} ne '') {
376: my %uroledomdefs =
377: &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'request.role.domain'});
378: if ($uroledomdefs{'timezone_def'} ne '') {
379: $timezone = $uroledomdefs{'timezone_def'};
380: }
381: } elsif ($Apache::lonnet::env{'user.domain'} ne '') {
382: my %udomdefaults =
383: &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'user.domain'});
384: if ($udomdefaults{'timezone_def'} ne '') {
385: $timezone = $udomdefaults{'timezone_def'};
386: }
387: }
388: if ($timezone ne '') {
389: if (DateTime::TimeZone->is_valid_name($timezone)) {
390: return $timezone;
391: }
392: }
393: return 'local';
394: }
395:
396: our $timezone_local;
397:
398: sub locallocaltime {
399: my ($thistime,$timezone,$datetime) = @_;
400:
401: if (!defined($thistime) || $thistime eq '') {
402: return &mt('Never');
403: }
404: if (($thistime < 0) || ($thistime eq 'NaN')) {
405: &Apache::lonnet::logthis("Unexpected time (negative or NaN) '$thistime' passed to lonlocal::locallocaltime");
406: return &mt('Never');
407: }
408: if ($thistime !~ /^\d+$/) {
409: &Apache::lonnet::logthis("Unexpected non-numeric time '$thistime' passed to lonlocal::locallocaltime");
410: return &mt('Never');
411: }
412:
413: my $dt;
414: my $convert_time;
415:
416: #### START # Speed up if this function is called often ####
417:
418: # Is a $datetime parameter set?
419: if(defined($datetime)) {
420: # Check for an instance of a DateTime object
421: if(!(defined $$datetime)) {
422: # No object, create one
423: $$datetime = DateTime->from_epoch(epoch => $thistime)
424: ->set_time_zone(&gettimezone($timezone));
425: $dt = $$datetime;
426: } else {
427: # If the return-value is "local", we have to convert it for DateTime
428:
429: # Converts the "local"-String only once
430: if(!defined($timezone_local))
431: {
432: $timezone_local = DateTime::TimeZone->new( name => gettimezone('local'))->name();
433: }
434:
435: my $timezone_now;
436:
437: if(gettimezone($timezone) == 'local')
438: {
439: $timezone_now = $timezone_local;
440: } else {
441: $timezone_now = gettimezone($timezone);
442: }
443:
444: # Has the timezone changed?
445: if($timezone_now eq $$datetime->time_zone_short_name() ||
446: $timezone_now eq $$datetime->time_zone_long_name())
447: {
448: # There is already an object (dereference)
449: $dt = $$datetime;
450:
451: # We need this as temporary value
452: $convert_time = DateTime->from_epoch( epoch => $thistime );
453: #->set_time_zone('floating');
454:
455: # Preventing a set_time_zone call (time consuming)
456: # Using old instance of DateTime with timezone
457: $dt->set( year => $convert_time->year(),
458: month => $convert_time->month(),
459: day => $convert_time->day(),
460: hour => $convert_time->hour(),
461: minute => $convert_time->minute(),
462: second => $convert_time->second() );
463: } else {
464: # The timezone has changed since last time
465: $$datetime = DateTime->from_epoch(epoch => $thistime)
466: ->set_time_zone(&gettimezone($timezone));
467: $dt = $$datetime;
468: }
469: }
470: } else {
471: # There is no $datetime parameter
472: $dt = DateTime->from_epoch(epoch => $thistime)
473: ->set_time_zone(&gettimezone($timezone));
474: }
475: #### END # Speed up if this function is called often ####
476:
477: if ((¤t_language=~/^en/) || (!$lh)) {
478:
479: return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
480: } else {
481: my $format=$lh->maketext('date_locale');
482: if ($format eq 'date_locale') {
483: return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
484: }
485: my $time_zone = $dt->time_zone_short_name();
486: my $seconds = $dt->second();
487: my $minutes = $dt->minute();
488: my $twentyfour = $dt->hour();
489: my $day = $dt->day_of_month();
490: my $mon = $dt->month()-1;
491: my $year = $dt->year();
492: my $wday = $dt->wday();
493: if ($wday==7) { $wday=0; }
494: my $month =(split(/\,/,$lh->maketext('date_months')))[$mon];
495: my $weekday=(split(/\,/,$lh->maketext('date_days')))[$wday];
496: if ($seconds<10) {
497: $seconds='0'.$seconds;
498: }
499: if ($minutes<10) {
500: $minutes='0'.$minutes;
501: }
502: my $twelve=$twentyfour;
503: my $ampm;
504: if ($twelve>12) {
505: $twelve-=12;
506: $ampm=$lh->maketext('date_pm');
507: } else {
508: $ampm=$lh->maketext('date_am');
509: }
510: foreach ('seconds','minutes','twentyfour','twelve','day','year',
511: 'month','weekday','ampm') {
512: $format=~s/\$$_/eval('$'.$_)/gse;
513: }
514: return $format." ($time_zone)";
515: }
516: }
517:
518: sub getdatelocale {
519: my ($datelocale,$locale_obj);
520: if ($Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.datelocale'}) {
521: $datelocale = $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.datelocale'};
522: } elsif ($Apache::lonnet::env{'request.course.id'} ne '') {
523: my $cdom = $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.domain'};
524: if ($cdom ne '') {
525: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
526: if ($domdefaults{'datelocale_def'} ne '') {
527: $datelocale = $domdefaults{'datelocale_def'};
528: }
529: }
530: } elsif ($Apache::lonnet::env{'user.domain'} ne '') {
531: my %udomdefaults = &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'user.domain'});
532: if ($udomdefaults{'datelocale_def'} ne '') {
533: $datelocale = $udomdefaults{'datelocale_def'};
534: }
535: }
536: if ($datelocale ne '') {
537: eval {
538: $locale_obj = DateTime::Locale->load($datelocale);
539: };
540: if (!$@) {
541: if ($locale_obj->id() eq $datelocale) {
542: return $locale_obj;
543: }
544: }
545: }
546: return $locale_obj;
547: }
548:
549: =pod
550:
551: =item * normalize_string
552:
553: Normalize string (reduce fragility in the lexicon files)
554:
555: This normalizes a string to reduce fragility in the lexicon files of
556: huge messages (such as are used by the helper), and allow useful
557: formatting: reduce all consecutive whitespace to a single space,
558: and remove all HTML
559:
560: =cut
561:
562: sub normalize_string {
563: my $s = shift;
564: $s =~ s/\s+/ /g;
565: $s =~ s/<[^>]+>//g;
566: # Pop off beginning or ending spaces, which aren't good
567: $s =~ s/^\s+//;
568: $s =~ s/\s+$//;
569: return $s;
570: }
571:
572: =pod
573:
574: =item * ns
575:
576: alias for normalize_string; recommend using it only in the lexicon
577:
578: =cut
579:
580: sub ns {
581: return normalize_string(@_);
582: }
583:
584: =pod
585:
586: =item * mtn
587:
588: mtn: call the mt function and the normalization function easily.
589: Returns original non-normalized string if there was no translation
590:
591: =cut
592:
593: sub mtn (@) {
594: my @args = @_; # don't want to modify caller's string; if we
595: # didn't care about that we could set $_[0]
596: # directly
597: $args[0] = normalize_string($args[0]);
598: my $translation = &mt(@args);
599: if ($translation ne $args[0]) {
600: return $translation;
601: } else {
602: return $_[0];
603: }
604: }
605:
606: # ---------------------------------------------------- Replace MT{...} in files
607:
608: sub transstatic {
609: my $strptr=shift;
610: $$strptr=~s/MT\{([^\}]*)\}/&mt($1)/gse;
611: }
612:
613: =pod
614:
615: =item * mt_escape
616:
617: mt_escape takes a string reference and escape the [] in there so mt
618: will leave them as is and not try to expand them
619:
620: =cut
621:
622: sub mt_escape {
623: my ($str_ref) = @_;
624: $$str_ref =~s/~/~~/g;
625: $$str_ref =~s/([\[\]])/~$1/g;
626: }
627:
628: 1;
629:
630: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>