--- loncom/localize/lonlocal.pm 2003/10/11 14:06:01 1.24
+++ loncom/localize/lonlocal.pm 2010/12/06 17:52:20 1.60.4.3
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Localization routines
#
-# $Id: lonlocal.pm,v 1.24 2003/10/11 14:06:01 www Exp $
+# $Id: lonlocal.pm,v 1.60.4.3 2010/12/06 17:52:20 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -162,66 +162,73 @@ package Apache::lonlocal;
use strict;
use Apache::localize;
-use Apache::File;
use locale;
-use POSIX qw(locale_h);
+use POSIX qw(locale_h strftime);
+use DateTime();
+use DateTime::TimeZone;
+use DateTime::Locale;
require Exporter;
our @ISA = qw (Exporter);
-our @EXPORT = qw(mt mtn ns);
+our @EXPORT = qw(mt mtn ns mt_user);
-my $reroute;
+my %mtcache=();
# ========================================================= The language handle
-use vars qw($lh);
+use vars qw($lh $current_language);
# ===================================================== The "MakeText" function
sub mt (@) {
-# my $fh=Apache::File->new('>>/home/www/loncapa/loncom/localize/localize/newphrases.txt');
-# print $fh join('',@_)."\n";
-# $fh->close();
- unless ($ENV{'environment.translator'}) {
- if ($lh) {
- return $lh->maketext(@_);
- } else {
- return @_;
- }
+# open(LOG,'>>/home/www/loncapa/loncom/localize/localize/newphrases.txt');
+# print LOG (@_[0]."\n");
+# close(LOG);
+ if ($lh) {
+ if ($_[0] eq '') {
+ if (wantarray) {
+ return @_;
+ } else {
+ return $_[0];
+ }
+ } else {
+ if ($#_>0) { return $lh->maketext(@_); }
+ if ($mtcache{$current_language.':'.$_[0]}) {
+ return $mtcache{$current_language.':'.$_[0]};
+ }
+ my $translation=$lh->maketext(@_);
+ $mtcache{$current_language.':'.$_[0]}=$translation;
+ return $translation;
+ }
} else {
- if ($lh) {
- my $trans=$lh->maketext(@_);
- my $link='[['.$trans.']]';
- if ($ENV{'transreroute'}) {
- $reroute.=$link;
- return $trans;
- } else {
- return $link;
- }
- } else {
+ if (wantarray) {
return @_;
+ } else {
+ return $_[0];
}
}
}
-# ================================================================ The tag
-
-BEGIN {
-}
-
-sub start_mt {
- my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
- return &mt(&Apache::lonxml::get_all_text("/mt",$parser));
-}
-
-sub end_mt {
- return '';
+sub mt_user {
+ my ($user_lh,@what) = @_;
+ if ($user_lh) {
+ if ($what[0] eq '') {
+ if (wantarray) {
+ return @what;
+ } else {
+ return $what[0];
+ }
+ } else {
+ return $user_lh->maketext(@what);
+ }
+ } else {
+ if (wantarray) {
+ return @what;
+ } else {
+ return $what[0];
+ }
+ }
}
# ============================================================== What language?
@@ -234,14 +241,82 @@ sub current_language {
return 'en';
}
+sub preferred_languages {
+ my $defdom = &Apache::lonnet::default_login_domain();
+ foreach my $domtype ($Apache::lonnet::env{'user.domain'},$Apache::lonnet::env{'request.role.domain'},$defdom) {
+ next if ($domtype eq '');
+ if ($domtype =~ /^(\w{2})\w?i$/) {
+ return ($1.'i');
+ } elsif ($domtype =~ /^(\w{2})\w?itest$/) {
+ return ($1.'t');
+ } else {
+ return ('gci');
+ }
+ }
+ my @languages=();
+ if (($Apache::lonnet::env{'request.role.adv'}) && ($Apache::lonnet::env{'form.languages'})) {
+ @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$Apache::lonnet::env{'form.languages'}));
+ }
+ if ($Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.languages'}) {
+ @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
+ $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.languages'}));
+ }
+
+ if ($Apache::lonnet::env{'environment.languages'}) {
+ @languages=(@languages,
+ split(/\s*(\,|\;|\:)\s*/,$Apache::lonnet::env{'environment.languages'}));
+ }
+ my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
+ if ($browser) {
+ my @browser =
+ map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
+ push(@languages,@browser);
+ }
+
+ foreach my $domtype ($Apache::lonnet::env{'user.domain'},$Apache::lonnet::env{'request.role.domain'},$defdom) {
+ if ($domtype ne '') {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($domtype);
+ if ($domdefs{'lang_def'} ne '') {
+ push(@languages,$domdefs{'lang_def'});
+ }
+ }
+ }
+ return &get_genlanguages(@languages);
+}
+
+sub get_genlanguages {
+ my (@languages) = @_;
+# turn "en-ca" into "en-ca,en"
+ my @genlanguages;
+ foreach my $lang (@languages) {
+ unless ($lang=~/\w/) { next; }
+ push(@genlanguages,$lang);
+ if ($lang=~/(\-|\_)/) {
+ push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
+ }
+ }
+ #uniqueify the languages list
+ my %count;
+ @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
+ return @genlanguages;
+}
+
# ============================================================== What encoding?
sub current_encoding {
+ my $default='UTF-8';
+# UTF-8 character encoding needed for the whole LON-CAPA system
+# (interface language and homework problem content)
+# See Bugzilla 5702 vs. 2189 and 4067
+# if ($Apache::lonnet::env{'browser.os'} eq 'win' &&
+# $Apache::lonnet::env{'browser.type'} eq 'explorer') {
+# $default='ISO-8859-1';
+# }
if ($lh) {
my $enc=$lh->maketext('char_encoding');
- return ($enc eq 'char_encoding'?'':$enc);
+ return ($enc eq 'char_encoding'?$default:$enc);
} else {
- return undef;
+ return $default;
}
}
@@ -266,55 +341,112 @@ sub texthash {
}
return %hash;
}
-# ======================================================== Re-route translation
-
-sub clearreroutetrans {
- &reroutetrans();
- $reroute='';
-}
-
-# ======================================================== Re-route translation
-
-sub reroutetrans {
- $ENV{'transreroute'}=1;
-}
-
-# ==================================================== End re-route translation
-sub endreroutetrans {
- $ENV{'transreroute'}=0;
- if ($ENV{'environment.translator'}) {
- return $reroute;
- } else {
- return '';
- }
-}
# ========= Get a handle (do not invoke in vain, leave this to access handlers)
sub get_language_handle {
my $r=shift;
- $lh=Apache::localize->get_handle(&Apache::loncommon::preferred_languages);
- if (&Apache::lonnet::mod_perl_version == 1) {
+ if ($r) {
+ my $headers=$r->headers_in;
+ $ENV{'HTTP_ACCEPT_LANGUAGE'}=$headers->{'Accept-language'};
+ }
+ my @languages=&preferred_languages();
+ $ENV{'HTTP_ACCEPT_LANGUAGE'}='';
+ $lh=Apache::localize->get_handle(@languages);
+ $current_language=¤t_language();
+ if ($r) {
$r->content_languages([¤t_language()]);
}
- &Apache::lonxml::register('Apache::lonlocal',('mt'));
### setlocale(LC_ALL,¤t_locale);
}
# ========================================================== Localize localtime
+sub gettimezone {
+ my ($timezone) = @_;
+ if ($timezone ne '') {
+ if (!DateTime::TimeZone->is_valid_name($timezone)) {
+ $timezone = 'local';
+ }
+ return $timezone;
+ }
+ my $cid = $Apache::lonnet::env{'request.course.id'};
+ if ($cid ne '') {
+ if ($Apache::lonnet::env{'course.'.$cid.'.timezone'}) {
+ $timezone = $Apache::lonnet::env{'course.'.$cid.'.timezone'};
+ } else {
+ my $cdom = $Apache::lonnet::env{'course.'.$cid.'.domain'};
+ if ($cdom ne '') {
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
+ if ($domdefaults{'timezone_def'} ne '') {
+ $timezone = $domdefaults{'timezone_def'};
+ }
+ }
+ }
+ } elsif ($Apache::lonnet::env{'request.role.domain'} ne '') {
+ my %uroledomdefs =
+ &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'request.role.domain'});
+ if ($uroledomdefs{'timezone_def'} ne '') {
+ $timezone = $uroledomdefs{'timezone_def'};
+ }
+ } elsif ($Apache::lonnet::env{'user.domain'} ne '') {
+ my %udomdefaults =
+ &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'user.domain'});
+ if ($udomdefaults{'timezone_def'} ne '') {
+ $timezone = $udomdefaults{'timezone_def'};
+ }
+ }
+ if ($timezone ne '') {
+ if (DateTime::TimeZone->is_valid_name($timezone)) {
+ return $timezone;
+ }
+ }
+ return 'local';
+}
sub locallocaltime {
- my $thistime=shift;
+ my ($thistime,$timezone) = @_;
+
+ if (!defined($thistime) || $thistime eq '') {
+ return &mt('Never');
+ }
+ if (($thistime < 0) || ($thistime eq 'NaN')) {
+ &Apache::lonnet::logthis("Unexpected time (negative or NaN) '$thistime' passed to lonlocal::locallocaltime");
+ return &mt('Never');
+ }
+ if ($thistime !~ /^\d+$/) {
+ &Apache::lonnet::logthis("Unexpected non-numeric time '$thistime' passed to lonlocal::locallocaltime");
+ return &mt('Never');
+ }
+
+ my $dt = DateTime->from_epoch(epoch => $thistime)
+ ->set_time_zone(gettimezone($timezone));
+
+ # TimeZone tries to determine the 'local' timezone from $ENV{TZ} if this
+ # fails it searches through various system files. Under certain
+ # circumstances this is an extremly expensive operation.
+ # So after the first run we store the timezone in $ENV{TZ} to significantly
+ # speed up future lookups.
+ $ENV{TZ} = $dt->time_zone()->name()
+ if (! $ENV{TZ} && gettimezone($timezone) eq 'local');
+
if ((¤t_language=~/^en/) || (!$lh)) {
- return ''.localtime($thistime);
+
+ return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
} else {
my $format=$lh->maketext('date_locale');
if ($format eq 'date_locale') {
- return ''.localtime($thistime);
+ return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
}
- my ($seconds,$minutes,$twentyfour,$day,$mon,$year,$wday,$yday,$isdst)=
- localtime($thistime);
- my $month=(split(/\,/,$lh->maketext('date_months')))[$mon];
+ my $time_zone = $dt->time_zone_short_name();
+ my $seconds = $dt->second();
+ my $minutes = $dt->minute();
+ my $twentyfour = $dt->hour();
+ my $day = $dt->day_of_month();
+ my $mon = $dt->month()-1;
+ my $year = $dt->year();
+ my $wday = $dt->wday();
+ if ($wday==7) { $wday=0; }
+ my $month =(split(/\,/,$lh->maketext('date_months')))[$mon];
my $weekday=(split(/\,/,$lh->maketext('date_days')))[$wday];
if ($seconds<10) {
$seconds='0'.$seconds;
@@ -322,7 +454,6 @@ sub locallocaltime {
if ($minutes<10) {
$minutes='0'.$minutes;
}
- $year+=1900;
my $twelve=$twentyfour;
my $ampm;
if ($twelve>12) {
@@ -331,21 +462,58 @@ sub locallocaltime {
} else {
$ampm=$lh->maketext('date_am');
}
- foreach
- ('seconds','minutes','twentyfour','twelve','day','year',
- 'month','weekday','ampm') {
+ foreach ('seconds','minutes','twentyfour','twelve','day','year',
+ 'month','weekday','ampm') {
$format=~s/\$$_/eval('$'.$_)/gse;
}
- return $format;
+ return $format." ($time_zone)";
+ }
+}
+
+sub getdatelocale {
+ my ($datelocale,$locale_obj);
+ if ($Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.datelocale'}) {
+ $datelocale = $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.datelocale'};
+ } elsif ($Apache::lonnet::env{'request.course.id'} ne '') {
+ my $cdom = $Apache::lonnet::env{'course.'.$Apache::lonnet::env{'request.course.id'}.'.domain'};
+ if ($cdom ne '') {
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
+ if ($domdefaults{'datelocale_def'} ne '') {
+ $datelocale = $domdefaults{'datelocale_def'};
+ }
+ }
+ } elsif ($Apache::lonnet::env{'user.domain'} ne '') {
+ my %udomdefaults = &Apache::lonnet::get_domain_defaults($Apache::lonnet::env{'user.domain'});
+ if ($udomdefaults{'datelocale_def'} ne '') {
+ $datelocale = $udomdefaults{'datelocale_def'};
+ }
+ }
+ if ($datelocale ne '') {
+ eval {
+ $locale_obj = DateTime::Locale->load($datelocale);
+ };
+ if (!$@) {
+ if ($locale_obj->id() eq $datelocale) {
+ return $locale_obj;
+ }
+ }
}
+ return $locale_obj;
}
-# ==================== Normalize string (reduce fragility in the lexicon files)
+=pod
+
+=item * normalize_string
+
+Normalize string (reduce fragility in the lexicon files)
+
+This normalizes a string to reduce fragility in the lexicon files of
+huge messages (such as are used by the helper), and allow useful
+formatting: reduce all consecutive whitespace to a single space,
+and remove all HTML
+
+=cut
-# This normalizes a string to reduce fragility in the lexicon files of
-# huge messages (such as are used by the helper), and allow useful
-# formatting: reduce all consecutive whitespace to a single space,
-# and remove all HTML
sub normalize_string {
my $s = shift;
$s =~ s/\s+/ /g;
@@ -356,13 +524,27 @@ sub normalize_string {
return $s;
}
-# alias for normalize_string; recommend using it only in the lexicon
+=pod
+
+=item * ns
+
+alias for normalize_string; recommend using it only in the lexicon
+
+=cut
+
sub ns {
return normalize_string(@_);
}
-# mtn: call the mt function and the normalization function easily.
-# Returns original non-normalized string if there was no translation
+=pod
+
+=item * mtn
+
+mtn: call the mt function and the normalization function easily.
+Returns original non-normalized string if there was no translation
+
+=cut
+
sub mtn (@) {
my @args = @_; # don't want to modify caller's string; if we
# didn't care about that we could set $_[0]
@@ -376,6 +558,28 @@ sub mtn (@) {
}
}
+# ---------------------------------------------------- Replace MT{...} in files
+
+sub transstatic {
+ my $strptr=shift;
+ $$strptr=~s/MT\{([^\}]*)\}/&mt($1)/gse;
+}
+
+=pod
+
+=item * mt_escape
+
+mt_escape takes a string reference and escape the [] in there so mt
+will leave them as is and not try to expand them
+
+=cut
+
+sub mt_escape {
+ my ($str_ref) = @_;
+ $$str_ref =~s/~/~~/g;
+ $$str_ref =~s/([\[\]])/~$1/g;
+}
+
1;
__END__