Annotation of loncom/localize/lonlocal.pm, revision 1.69
1.1 www 1: # The LearningOnline Network with CAPA
2: # Localization routines
3: #
1.69 ! raeburn 4: # $Id: lonlocal.pm,v 1.68 2020/10/29 23:04:39 raeburn 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
1.67 raeburn 41: C<https://metacpan.org/pod/Locale::Maketext>
1.10 bowersj2 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') {
1.64 bisitz 84: $message='You are a total loser.';
1.10 bowersj2 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') {
1.64 bisitz 106: $message='You are a total loser.';
1.10 bowersj2 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:
1.64 bisitz 138: 'You are a total loser.'
1.10 bowersj2 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
1.67 raeburn 156: C<https://metacpan.org/pod/Locale::Maketext>
1.10 bowersj2 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.66 damieng 174: our @EXPORT = qw(mt mtn ns mt_user js_escape html_escape);
1.1 www 175:
1.57 www 176: my %mtcache=();
177:
1.1 www 178: # ========================================================= The language handle
179:
1.57 www 180: use vars qw($lh $current_language);
1.1 www 181:
182: # ===================================================== The "MakeText" function
183:
184: sub mt (@) {
1.36 albertel 185: # open(LOG,'>>/home/www/loncapa/loncom/localize/localize/newphrases.txt');
186: # print LOG (@_[0]."\n");
187: # close(LOG);
1.26 www 188: if ($lh) {
1.44 raeburn 189: if ($_[0] eq '') {
190: if (wantarray) {
191: return @_;
192: } else {
193: return $_[0];
194: }
195: } else {
1.57 www 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;
1.44 raeburn 203: }
1.3 www 204: } else {
1.31 albertel 205: if (wantarray) {
206: return @_;
207: } else {
208: return $_[0];
209: }
1.4 www 210: }
211: }
212:
1.48 raeburn 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:
1.6 www 234: # ============================================================== What language?
235:
236: sub current_language {
1.20 albertel 237: if ($lh) {
238: my $lang=$lh->maketext('language_code');
239: return ($lang eq 'language_code'?'en':$lang);
240: }
1.21 www 241: return 'en';
1.6 www 242: }
243:
1.52 raeburn 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:
1.60 raeburn 265: my $defdom = &Apache::lonnet::default_login_domain();
266: foreach my $domtype ($Apache::lonnet::env{'user.domain'},$Apache::lonnet::env{'request.role.domain'},$defdom) {
1.63 raeburn 267: if (($domtype ne '') && ($domtype ne 'public')) {
1.52 raeburn 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:
1.8 www 294: # ============================================================== What encoding?
295:
296: sub current_encoding {
1.33 albertel 297: my $default='UTF-8';
1.61 raeburn 298: unless ($Apache::lonnet::env{'browser.unicode'}) {
299: if ($Apache::lonnet::env{'browser.os'} eq 'win' &&
300: $Apache::lonnet::env{'browser.type'} eq 'explorer') {
301: $default='ISO-8859-1';
302: }
303: }
1.12 albertel 304: if ($lh) {
305: my $enc=$lh->maketext('char_encoding');
1.33 albertel 306: return ($enc eq 'char_encoding'?$default:$enc);
1.12 albertel 307: } else {
1.33 albertel 308: return $default;
1.12 albertel 309: }
1.8 www 310: }
311:
1.15 www 312: # =============================================================== Which locale?
313: # Refer to locale -a
314: #
315: sub current_locale {
316: if ($lh) {
317: my $enc=$lh->maketext('lang_locale');
318: return ($enc eq 'lang_locale'?'':$enc);
319: } else {
320: return undef;
321: }
322: }
323:
1.4 www 324: # ============================================================== Translate hash
325:
326: sub texthash {
327: my %hash=@_;
1.65 raeburn 328: foreach (keys(%hash)) {
1.4 www 329: $hash{$_}=&mt($hash{$_});
330: }
331: return %hash;
1.1 www 332: }
333:
334: # ========= Get a handle (do not invoke in vain, leave this to access handlers)
335:
336: sub get_language_handle {
1.62 raeburn 337: my ($r,$chosen) = @_;
1.31 albertel 338: if ($r) {
339: my $headers=$r->headers_in;
340: $ENV{'HTTP_ACCEPT_LANGUAGE'}=$headers->{'Accept-language'};
341: }
1.62 raeburn 342: my @languages;
343: if ($chosen ne '') {
344: @languages=($chosen);
345: } else {
346: @languages=&preferred_languages();
347: }
1.29 www 348: $ENV{'HTTP_ACCEPT_LANGUAGE'}='';
349: $lh=Apache::localize->get_handle(@languages);
1.57 www 350: $current_language=¤t_language();
1.37 albertel 351: if ($r) {
1.12 albertel 352: $r->content_languages([¤t_language()]);
1.8 www 353: }
1.16 www 354: ### setlocale(LC_ALL,¤t_locale);
1.18 www 355: }
356:
357: # ========================================================== Localize localtime
1.35 www 358: sub gettimezone {
1.53 raeburn 359: my ($timezone) = @_;
360: if ($timezone ne '') {
361: if (!DateTime::TimeZone->is_valid_name($timezone)) {
362: $timezone = 'local';
363: }
364: return $timezone;
365: }
1.69 ! raeburn 366: my $cid = $Apache::lonnet::env{'request.course.id'};
! 367: if (&Apache::lonnet::usertools_access($Apache::lonnet::env{'user.name'},
! 368: $Apache::lonnet::env{'user.domain'},
! 369: 'timezone')) {
! 370: if ($Apache::lonnet::env{'environment.timezone'} ne '') {
! 371: $timezone = $Apache::lonnet::env{'environment.timezone'};
! 372: if ($cid ne '') {
! 373: if (($Apache::lonnet::env{'course.'.$cid.'.tzover'}) &&
! 374: ($Apache::lonnet::env{'course.'.$cid.'.timezone'} ne '')) {
! 375: $timezone = $Apache::lonnet::env{'course.'.$cid.'.timezone'};
! 376: }
! 377: }
! 378: if ($timezone ne '') {
! 379: if (DateTime::TimeZone->is_valid_name($timezone)) {
! 380: return $timezone;
! 381: }
! 382: }
! 383: }
! 384: }
1.53 raeburn 385: if ($cid ne '') {
386: if ($Apache::lonnet::env{'course.'.$cid.'.timezone'}) {
387: $timezone = $Apache::lonnet::env{'course.'.$cid.'.timezone'};
388: } else {
389: my $cdom = $Apache::lonnet::env{'course.'.$cid.'.domain'};
390: if ($cdom ne '') {
391: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
392: if ($domdefaults{'timezone_def'} ne '') {
393: $timezone = $domdefaults{'timezone_def'};
394: }
1.45 raeburn 395: }
396: }
1.50 raeburn 397: } elsif ($Apache::lonnet::env{'request.role.domain'} ne '') {
398: my %uroledomdefs =
399: &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'request.role.domain'});
400: if ($uroledomdefs{'timezone_def'} ne '') {
401: $timezone = $uroledomdefs{'timezone_def'};
402: }
1.63 raeburn 403: } elsif (($Apache::lonnet::env{'user.domain'} ne '') &&
404: ($Apache::lonnet::env{'user.domain'} ne 'public')) {
1.50 raeburn 405: my %udomdefaults =
406: &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'user.domain'});
407: if ($udomdefaults{'timezone_def'} ne '') {
408: $timezone = $udomdefaults{'timezone_def'};
409: }
1.42 albertel 410: }
1.46 raeburn 411: if ($timezone ne '') {
412: if (DateTime::TimeZone->is_valid_name($timezone)) {
413: return $timezone;
414: }
415: }
1.42 albertel 416: return 'local';
1.35 www 417: }
1.18 www 418:
419: sub locallocaltime {
1.59 droeschl 420: my ($thistime,$timezone) = @_;
1.58 lueken 421:
1.40 albertel 422: if (!defined($thistime) || $thistime eq '') {
423: return &mt('Never');
424: }
1.47 raeburn 425: if (($thistime < 0) || ($thistime eq 'NaN')) {
426: &Apache::lonnet::logthis("Unexpected time (negative or NaN) '$thistime' passed to lonlocal::locallocaltime");
427: return &mt('Never');
428: }
429: if ($thistime !~ /^\d+$/) {
430: &Apache::lonnet::logthis("Unexpected non-numeric time '$thistime' passed to lonlocal::locallocaltime");
431: return &mt('Never');
432: }
1.42 albertel 433:
1.59 droeschl 434: my $dt = DateTime->from_epoch(epoch => $thistime)
435: ->set_time_zone(gettimezone($timezone));
1.58 lueken 436:
1.59 droeschl 437: # TimeZone tries to determine the 'local' timezone from $ENV{TZ} if this
438: # fails it searches through various system files. Under certain
439: # circumstances this is an extremly expensive operation.
440: # So after the first run we store the timezone in $ENV{TZ} to significantly
441: # speed up future lookups.
442: $ENV{TZ} = $dt->time_zone()->name()
443: if (! $ENV{TZ} && gettimezone($timezone) eq 'local');
1.58 lueken 444:
1.18 www 445: if ((¤t_language=~/^en/) || (!$lh)) {
1.42 albertel 446:
447: return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
1.18 www 448: } else {
449: my $format=$lh->maketext('date_locale');
450: if ($format eq 'date_locale') {
1.42 albertel 451: return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
1.18 www 452: }
1.42 albertel 453: my $time_zone = $dt->time_zone_short_name();
454: my $seconds = $dt->second();
455: my $minutes = $dt->minute();
456: my $twentyfour = $dt->hour();
457: my $day = $dt->day_of_month();
458: my $mon = $dt->month()-1;
459: my $year = $dt->year();
1.43 www 460: my $wday = $dt->wday();
461: if ($wday==7) { $wday=0; }
1.42 albertel 462: my $month =(split(/\,/,$lh->maketext('date_months')))[$mon];
1.18 www 463: my $weekday=(split(/\,/,$lh->maketext('date_days')))[$wday];
464: if ($seconds<10) {
465: $seconds='0'.$seconds;
466: }
467: if ($minutes<10) {
468: $minutes='0'.$minutes;
469: }
470: my $twelve=$twentyfour;
1.19 www 471: my $ampm;
1.18 www 472: if ($twelve>12) {
473: $twelve-=12;
1.19 www 474: $ampm=$lh->maketext('date_pm');
1.18 www 475: } else {
1.19 www 476: $ampm=$lh->maketext('date_am');
1.18 www 477: }
1.42 albertel 478: foreach ('seconds','minutes','twentyfour','twelve','day','year',
479: 'month','weekday','ampm') {
1.18 www 480: $format=~s/\$$_/eval('$'.$_)/gse;
481: }
1.42 albertel 482: return $format." ($time_zone)";
1.18 www 483: }
1.1 www 484: }
485:
1.49 raeburn 486: sub getdatelocale {
487: my ($datelocale,$locale_obj);
488: if ($Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.datelocale'}) {
489: $datelocale = $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.datelocale'};
490: } elsif ($Apache::lonnet::env{'request.course.id'} ne '') {
491: my $cdom = $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.domain'};
492: if ($cdom ne '') {
493: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
494: if ($domdefaults{'datelocale_def'} ne '') {
495: $datelocale = $domdefaults{'datelocale_def'};
496: }
497: }
498: } elsif ($Apache::lonnet::env{'user.domain'} ne '') {
499: my %udomdefaults = &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'user.domain'});
500: if ($udomdefaults{'datelocale_def'} ne '') {
501: $datelocale = $udomdefaults{'datelocale_def'};
502: }
503: }
504: if ($datelocale ne '') {
505: eval {
506: $locale_obj = DateTime::Locale->load($datelocale);
507: };
508: if (!$@) {
509: if ($locale_obj->id() eq $datelocale) {
510: return $locale_obj;
511: }
512: }
513: }
514: return $locale_obj;
515: }
516:
1.67 raeburn 517: =pod
518:
519: =over
1.51 jms 520:
1.67 raeburn 521: =item * normalize_string()
1.51 jms 522:
523: Normalize string (reduce fragility in the lexicon files)
1.49 raeburn 524:
1.51 jms 525: This normalizes a string to reduce fragility in the lexicon files of
526: huge messages (such as are used by the helper), and allow useful
527: formatting: reduce all consecutive whitespace to a single space,
528: and remove all HTML
529:
530: =cut
1.17 bowersj2 531:
532: sub normalize_string {
533: my $s = shift;
534: $s =~ s/\s+/ /g;
535: $s =~ s/<[^>]+>//g;
1.22 bowersj2 536: # Pop off beginning or ending spaces, which aren't good
537: $s =~ s/^\s+//;
538: $s =~ s/\s+$//;
1.17 bowersj2 539: return $s;
540: }
1.22 bowersj2 541:
1.51 jms 542: =pod
543:
1.67 raeburn 544: =item * ns()
1.51 jms 545:
546: alias for normalize_string; recommend using it only in the lexicon
547:
548: =cut
549:
1.22 bowersj2 550: sub ns {
551: return normalize_string(@_);
552: }
553:
1.51 jms 554: =pod
555:
1.67 raeburn 556: =item * mtn()
1.51 jms 557:
558: mtn: call the mt function and the normalization function easily.
559: Returns original non-normalized string if there was no translation
560:
561: =cut
562:
1.22 bowersj2 563: sub mtn (@) {
564: my @args = @_; # don't want to modify caller's string; if we
565: # didn't care about that we could set $_[0]
566: # directly
567: $args[0] = normalize_string($args[0]);
568: my $translation = &mt(@args);
569: if ($translation ne $args[0]) {
570: return $translation;
571: } else {
572: return $_[0];
573: }
1.27 www 574: }
575:
576: # ---------------------------------------------------- Replace MT{...} in files
577:
578: sub transstatic {
579: my $strptr=shift;
580: $$strptr=~s/MT\{([^\}]*)\}/&mt($1)/gse;
581: }
582:
1.41 albertel 583: =pod
584:
1.67 raeburn 585: =item * mt_escape()
1.41 albertel 586:
587: mt_escape takes a string reference and escape the [] in there so mt
588: will leave them as is and not try to expand them
589:
590: =cut
591:
592: sub mt_escape {
593: my ($str_ref) = @_;
594: $$str_ref =~s/~/~~/g;
595: $$str_ref =~s/([\[\]])/~$1/g;
596: }
597:
1.66 damieng 598: =pod
599:
1.67 raeburn 600: =item * js_escape()
1.66 damieng 601:
602: js_escape takes a string, string reference or hash reference,
603: and escapes the values so that they can be used within a <script> element.
604: It replaces all instances of \ by \\, ' by \', " by \" and \n by \\n.
605: It is typically used with localized strings, which might contain quotes.
606:
607: =cut
608:
609: sub js_escape {
610: my ($v) = @_;
611: my $ref = ref($v);
612: if ($ref eq 'SCALAR') {
613: $$v =~ s/\\/\\\\/g;
614: $$v =~ s/'/\\'/g;
615: $$v =~ s/"/\\"/g;
616: $$v =~ s/\n/\\n/g;
617: } elsif ($ref eq 'HASH') {
618: foreach my $key (keys %$v) {
619: $v->{$key} =~ s/\\/\\\\/g;
620: $v->{$key} =~ s/'/\\'/g;
621: $v->{$key} =~ s/"/\\"/g;
622: $v->{$key} =~ s/\n/\\n/g;
623: }
624: } else {
625: $v =~ s/\\/\\\\/g;
626: $v =~ s/'/\\'/g;
627: $v =~ s/"/\\"/g;
628: $v =~ s/\n/\\n/g;
629: return $v;
630: }
631: }
632:
633: =pod
634:
1.67 raeburn 635: =item * html_escape()
1.66 damieng 636:
1.68 raeburn 637: html_escape takes a string, string reference or hash reference,
1.66 damieng 638: and escapes the values so that they can be used as HTML.
639: It encodes <, >, &, ' and ".
640:
641: =cut
642:
643: sub html_escape {
644: my ($v) = @_;
645: my $ref = ref($v);
646: if ($ref eq 'SCALAR') {
647: $$v =~ s/&/&/g;
648: $$v =~ s/</</g;
649: $$v =~ s/>/>/g;
650: $$v =~ s/'/'/g;
651: $$v =~ s/"/"/g;
652: } elsif ($ref eq 'HASH') {
653: foreach my $key (keys %$v) {
654: $v->{$key} =~ s/&/&/g;
655: $v->{$key} =~ s/</</g;
656: $v->{$key} =~ s/>/>/g;
657: $v->{$key} =~ s/'/'/g;
658: $v->{$key} =~ s/"/"/g;
659: }
660: } else {
661: $v =~ s/&/&/g;
662: $v =~ s/</</g;
663: $v =~ s/>/>/g;
664: $v =~ s/'/'/g;
665: $v =~ s/"/"/g;
666: return $v;
667: }
668: # NOTE: we could also turn \n into <br> if needed
669: }
670:
1.62 raeburn 671: =pod
672:
1.67 raeburn 673: =item * choose_language()
1.62 raeburn 674:
675: choose_language prompts a user to enter a two letter language code via
676: keyboard when running a script from the command line. Default is en.
677:
1.67 raeburn 678: =back
679:
1.62 raeburn 680: =cut
681:
682: sub choose_language {
683: my %languages = (
684: ar => 'Arabic',
685: de => 'German',
686: en => 'English',
687: es => 'Spanish',
688: fa => 'Persian',
689: fr => 'French',
690: he => 'Hebrew',
691: ja => 'Japanese',
692: pt => 'Portuguese',
693: ru => 'Russian',
694: tr => 'Turkish',
695: zh => 'Chinese (Simplified)'
696: );
697: my @posslangs = sort(keys(%languages));
698: my $langlist = join('|',@posslangs);
699: my $lang = 'en';
700: print 'Language: English (en). Change? ['.$langlist.']? ';
701: my $langchoice = <STDIN>;
702: chomp($langchoice);
703: $langchoice =~ s/(^\s+|\s+$)//g;
704: $langchoice = lc($langchoice);
705: if (defined($languages{$langchoice})) {
706: $lang = $langchoice;
707: }
708: return $lang;
709: }
710:
1.1 www 711: 1;
712:
713: __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