--- loncom/localize/lonlocal.pm 2003/09/22 18:16:43 1.10
+++ loncom/localize/lonlocal.pm 2009/02/01 21:54:30 1.54
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Localization routines
#
-# $Id: lonlocal.pm,v 1.10 2003/09/22 18:16:43 bowersj2 Exp $
+# $Id: lonlocal.pm,v 1.54 2009/02/01 21:54:30 lueken Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -144,11 +144,6 @@ like this:
'No purchase necessary. Illegal where not allowed.'
=> 'Es ist erlaubt, einfach zu verlieren, und das ist Ihre Schuld.'
-The German translation lexicon is in pretty okay shape, but not
-complete yet. Portuguese currently only covers the login screen.
-Russian is purely experimental. Looks like UTF-8 is the way to encode
-this, at least for latin/greek-based languages, but we still have to
-learn a lot.
Comments may be added with the # symbol, which outside of a string
(the things with the apostrophe surrounding them, which are the
@@ -167,14 +162,16 @@ package Apache::lonlocal;
use strict;
use Apache::localize;
-use Apache::File;
+use locale;
+use POSIX qw(locale_h strftime);
+use DateTime();
+use DateTime::TimeZone;
+use DateTime::Locale;
require Exporter;
our @ISA = qw (Exporter);
-our @EXPORT = qw(mt);
-
-my $reroute;
+our @EXPORT = qw(mt mtn ns mt_user);
# ========================================================= The language handle
@@ -182,37 +179,151 @@ use vars qw($lh);
# ===================================================== The "MakeText" function
+######### Localize Cache
+my @localize_cache;
+#########
+
sub mt (@) {
- unless ($ENV{'environment.translator'}) {
- return $lh->maketext(@_);
+# 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 {
+ ######### Localize Cache
+ foreach my $e (@localize_cache)
+ {
+ if($_[0] eq $$e[0]) { return $$e[1]; }
+ }
+
+ if($#localize_cache == 100) { pop(@localize_cache); }
+ my $localize_entry = $lh->maketext(@_);
+ unshift(@localize_cache, [ @_, $localize_entry ] );
+ #########
+
+ return $localize_entry;
+ }
} else {
- my $trans=$lh->maketext(@_);
- my $link='[['.$trans.']]';
- if ($ENV{'transreroute'}) {
- $reroute.=$link;
- return $trans;
+ if (wantarray) {
+ return @_;
} else {
- return $link;
+ return $_[0];
}
}
}
+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?
sub current_language {
- return $lh->language_tag();
+ if ($lh) {
+ my $lang=$lh->maketext('language_code');
+ return ($lang eq 'language_code'?'en':$lang);
+ }
+ return 'en';
+}
+
+sub preferred_languages {
+ 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'},
+ $Apache::lonnet::perlvar{'lonDefDomain'}) {
+ 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 $enc=$lh->maketext('char_encoding');
- return ($enc eq 'char_encoding'?'':$enc);
+ my $default='UTF-8';
+ 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'?$default:$enc);
+ } else {
+ return $default;
+ }
+}
+
+# =============================================================== Which locale?
+# Refer to locale -a
+#
+sub current_locale {
+ if ($lh) {
+ my $enc=$lh->maketext('lang_locale');
+ return ($enc eq 'lang_locale'?'':$enc);
+ } else {
+ return undef;
+ }
}
# ============================================================== Translate hash
@@ -224,41 +335,234 @@ sub texthash {
}
return %hash;
}
-# ======================================================== Re-route translation
-sub clearreroutetrans {
- &reroutetrans();
- $reroute='';
-}
+# ========= Get a handle (do not invoke in vain, leave this to access handlers)
-# ======================================================== Re-route translation
+sub get_language_handle {
+ my $r=shift;
+ 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);
+ if ($r) {
+ $r->content_languages([¤t_language()]);
+ }
+### setlocale(LC_ALL,¤t_locale);
+}
-sub reroutetrans {
- $ENV{'transreroute'}=1;
+# ========================================================== 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';
}
-# ==================================================== End re-route translation
-sub endreroutetrans {
- $ENV{'transreroute'}=0;
- if ($ENV{'environment.translator'}) {
- return $reroute;
+sub locallocaltime {
+ 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));
+ if ((¤t_language=~/^en/) || (!$lh)) {
+
+ return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
} else {
- return '';
+ my $format=$lh->maketext('date_locale');
+ if ($format eq 'date_locale') {
+ return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
+ }
+ 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;
+ }
+ if ($minutes<10) {
+ $minutes='0'.$minutes;
+ }
+ my $twelve=$twentyfour;
+ my $ampm;
+ if ($twelve>12) {
+ $twelve-=12;
+ $ampm=$lh->maketext('date_pm');
+ } else {
+ $ampm=$lh->maketext('date_am');
+ }
+ foreach ('seconds','minutes','twentyfour','twelve','day','year',
+ 'month','weekday','ampm') {
+ $format=~s/\$$_/eval('$'.$_)/gse;
+ }
+ return $format." ($time_zone)";
}
}
-# ========= Get a handle (do not invoke in vain, leave this to access handlers)
+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;
+}
-sub get_language_handle {
- my $r=shift;
- $lh=Apache::localize->get_handle(&Apache::loncommon::preferred_languages);
- $r->content_languages(["¤t_language()"]);
- my $enc=¤t_encoding();
- if ($enc) {
+=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
+
+sub normalize_string {
+ my $s = shift;
+ $s =~ s/\s+/ /g;
+ $s =~ s/<[^>]+>//g;
+ # Pop off beginning or ending spaces, which aren't good
+ $s =~ s/^\s+//;
+ $s =~ s/\s+$//;
+ return $s;
+}
+
+=pod
+
+=item * ns
+
+alias for normalize_string; recommend using it only in the lexicon
+=cut
+
+sub ns {
+ return normalize_string(@_);
+}
+
+=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]
+ # directly
+ $args[0] = normalize_string($args[0]);
+ my $translation = &mt(@args);
+ if ($translation ne $args[0]) {
+ return $translation;
+ } else {
+ return $_[0];
}
}
+# ---------------------------------------------------- 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__
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.