[BACK]Return to lonlocal.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / localize

Diff for /loncom/localize/lonlocal.pm between versions 1.36 and 1.64

version 1.36, 2005/11/14 19:53:03 version 1.64, 2012/10/25 13:47:31
Line 81  Inside might be something like this Line 81  Inside might be something like this
      if ($status eq 'WON') {       if ($status eq 'WON') {
         $message='You have won.';          $message='You have won.';
      } elsif ($status eq 'LOST') {       } elsif ($status eq 'LOST') {
         $message='You are a total looser.';          $message='You are a total loser.';
      }       }
      return $message;       return $message;
  }   }
Line 103  The first two examples are easy: Line 103  The first two examples are easy:
      if ($status eq 'WON') {       if ($status eq 'WON') {
         $message='You have won.';          $message='You have won.';
      } elsif ($status eq 'LOST') {       } elsif ($status eq 'LOST') {
         $message='You are a total looser.';          $message='You are a total loser.';
      }       }
      return &mt($message);       return &mt($message);
  }   }
Line 135  like this: Line 135  like this:
     'You have won.'      'You have won.'
  => 'Sie haben gewonnen.',   => 'Sie haben gewonnen.',
   
     'You are a total looser.'      'You are a total loser.'
  => 'Sie sind der totale Verlierer.',   => 'Sie sind der totale Verlierer.',
   
     'Rules'      'Rules'
Line 161  but for most purposes, we do not have to Line 161  but for most purposes, we do not have to
 package Apache::lonlocal;  package Apache::lonlocal;
   
 use strict;  use strict;
 use Apache::Constants qw(:common);  
 use Apache::localize;  use Apache::localize;
 use locale;  use locale;
 use POSIX qw(locale_h);  use POSIX qw(locale_h strftime);
   use DateTime();
   use DateTime::TimeZone;
   use DateTime::Locale;
   
 require Exporter;  require Exporter;
   
 our @ISA = qw (Exporter);  our @ISA = qw (Exporter);
 our @EXPORT = qw(mt mtn ns);  our @EXPORT = qw(mt mtn ns mt_user);
   
   my %mtcache=();
   
 # ========================================================= The language handle  # ========================================================= The language handle
   
 use vars qw($lh);  use vars qw($lh $current_language);
   
 # ===================================================== The "MakeText" function  # ===================================================== The "MakeText" function
   
Line 182  sub mt (@) { Line 186  sub mt (@) {
 #    print LOG (@_[0]."\n");  #    print LOG (@_[0]."\n");
 #    close(LOG);  #    close(LOG);
     if ($lh) {      if ($lh) {
  return $lh->maketext(@_);          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 {      } else {
  if (wantarray) {   if (wantarray) {
     return @_;      return @_;
Line 192  sub mt (@) { Line 210  sub mt (@) {
     }      }
 }  }
   
   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?  # ============================================================== What language?
   
 sub current_language {  sub current_language {
Line 202  sub current_language { Line 241  sub current_language {
     return 'en';      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);
       }
   
       my $defdom = &Apache::lonnet::default_login_domain();
       foreach my $domtype ($Apache::lonnet::env{'user.domain'},$Apache::lonnet::env{'request.role.domain'},$defdom) {
           if (($domtype ne '') && ($domtype ne 'public')) {
               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?  # ============================================================== What encoding?
   
 sub current_encoding {  sub current_encoding {
     my $default='UTF-8';      my $default='UTF-8';
     if ($Apache::lonnet::env{'browser.os'} eq 'win' &&       unless ($Apache::lonnet::env{'browser.unicode'}) {
  $Apache::lonnet::env{'browser.type'} eq 'explorer') {          if ($Apache::lonnet::env{'browser.os'} eq 'win' && 
         $default='ISO-8859-1';      $Apache::lonnet::env{'browser.type'} eq 'explorer') {
               $default='ISO-8859-1';
           }
     }      }
     if ($lh) {      if ($lh) {
  my $enc=$lh->maketext('char_encoding');   my $enc=$lh->maketext('char_encoding');
Line 243  sub texthash { Line 334  sub texthash {
 # ========= Get a handle (do not invoke in vain, leave this to access handlers)  # ========= Get a handle (do not invoke in vain, leave this to access handlers)
   
 sub get_language_handle {  sub get_language_handle {
     my $r=shift;      my ($r,$chosen) = @_;
     if ($r) {      if ($r) {
  my $headers=$r->headers_in;   my $headers=$r->headers_in;
  $ENV{'HTTP_ACCEPT_LANGUAGE'}=$headers->{'Accept-language'};   $ENV{'HTTP_ACCEPT_LANGUAGE'}=$headers->{'Accept-language'};
     }      }
     my @languages=&Apache::loncommon::preferred_languages;      my @languages;
       if ($chosen ne '') {
           @languages=($chosen);
       } else {
           @languages=&preferred_languages();
       }
     $ENV{'HTTP_ACCEPT_LANGUAGE'}='';      $ENV{'HTTP_ACCEPT_LANGUAGE'}='';
     $lh=Apache::localize->get_handle(@languages);      $lh=Apache::localize->get_handle(@languages);
     if ($r && &Apache::lonnet::mod_perl_version == 1) {      $current_language=&current_language();
       if ($r) {
  $r->content_languages([&current_language()]);   $r->content_languages([&current_language()]);
     }      }
 ###    setlocale(LC_ALL,&current_locale);  ###    setlocale(LC_ALL,&current_locale);
Line 259  sub get_language_handle { Line 356  sub get_language_handle {
   
 # ========================================================== Localize localtime  # ========================================================== Localize localtime
 sub gettimezone {  sub gettimezone {
     return ' ('.$Apache::lonnet::env{'server.timezone'}.')';      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 '') && 
                ($Apache::lonnet::env{'user.domain'} ne 'public')) {
           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 {  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 ((&current_language=~/^en/) || (!$lh)) {      if ((&current_language=~/^en/) || (!$lh)) {
  return ''.localtime($thistime).&gettimezone();  
    return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
     } else {      } else {
  my $format=$lh->maketext('date_locale');   my $format=$lh->maketext('date_locale');
  if ($format eq '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)=   my $time_zone  = $dt->time_zone_short_name();
     localtime($thistime);   my $seconds    = $dt->second();
  my $month=(split(/\,/,$lh->maketext('date_months')))[$mon];   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];   my $weekday=(split(/\,/,$lh->maketext('date_days')))[$wday];
  if ($seconds<10) {   if ($seconds<10) {
     $seconds='0'.$seconds;      $seconds='0'.$seconds;
Line 281  sub locallocaltime { Line 449  sub locallocaltime {
  if ($minutes<10) {   if ($minutes<10) {
     $minutes='0'.$minutes;      $minutes='0'.$minutes;
  }   }
  $year+=1900;  
  my $twelve=$twentyfour;   my $twelve=$twentyfour;
  my $ampm;   my $ampm;
  if ($twelve>12) {   if ($twelve>12) {
Line 290  sub locallocaltime { Line 457  sub locallocaltime {
  } else {   } else {
     $ampm=$lh->maketext('date_am');      $ampm=$lh->maketext('date_am');
  }   }
  foreach    foreach ('seconds','minutes','twentyfour','twelve','day','year',
  ('seconds','minutes','twentyfour','twelve','day','year',   'month','weekday','ampm') {
  'month','weekday','ampm') {  
     $format=~s/\$$_/eval('$'.$_)/gse;      $format=~s/\$$_/eval('$'.$_)/gse;
  }   }
  return $format.&gettimezone();   return $format." ($time_zone)";
     }      }
 }  }
   
 # ==================== Normalize string (reduce fragility in the lexicon files)  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;
   }
   
   =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 {  sub normalize_string {
     my $s = shift;      my $s = shift;
     $s =~ s/\s+/ /g;      $s =~ s/\s+/ /g;
Line 315  sub normalize_string { Line 519  sub normalize_string {
     return $s;      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 {  sub ns {
     return normalize_string(@_);      return normalize_string(@_);
 }  }
   
 # mtn: call the mt function and the normalization function easily.  =pod
 # Returns original non-normalized string if there was no translation  
   =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 (@) {  sub mtn (@) {
     my @args = @_; # don't want to modify caller's string; if we      my @args = @_; # don't want to modify caller's string; if we
    # didn't care about that we could set $_[0]     # didn't care about that we could set $_[0]
Line 342  sub transstatic { Line 560  sub transstatic {
     $$strptr=~s/MT\{([^\}]*)\}/&mt($1)/gse;      $$strptr=~s/MT\{([^\}]*)\}/&mt($1)/gse;
 }  }
   
 # ----------------------------------------------- Handler Routine /adm/localize  =pod 
 sub handler {  
     my $r=shift;  =item * mt_escape
     &Apache::lonlocal::get_language_handle($r);  
     &Apache::loncommon::content_type($r,'text/html');  mt_escape takes a string reference and escape the [] in there so mt
     $r->send_http_header;  will leave them as is and not try to expand them
     return OK if $r->header_only;  
   =cut
     my $uri=$r->uri;  
     $uri=~s/^\/adm\/localize//;  sub mt_escape {
     my $fn=$Apache::lonnet::perlvar{'lonDocRoot'}.$uri;      my ($str_ref) = @_;
       $$str_ref =~s/~/~~/g;
     my $file=&Apache::lonnet::getfile($fn);      $$str_ref =~s/([\[\]])/~$1/g;
     &transstatic(\$file);  }
     $r->print($file);  
     return OK;  =pod
   
   =item * choose_language
   
   choose_language prompts a user to enter a two letter language code via
   keyboard when running a script from the command line. Default is en.
   
   =cut
   
   sub choose_language {
       my %languages = (
                         ar => 'Arabic',
                         de => 'German',
                         en => 'English',
                         es => 'Spanish',
                         fa => 'Persian',
                         fr => 'French',
                         he => 'Hebrew',
                         ja => 'Japanese',
                         pt => 'Portuguese',
                         ru => 'Russian',
                         tr => 'Turkish',
                         zh => 'Chinese (Simplified)'
                      );
       my @posslangs = sort(keys(%languages));
       my $langlist = join('|',@posslangs);
       my $lang = 'en';
       print 'Language: English (en). Change? ['.$langlist.']? ';
       my $langchoice = <STDIN>;
       chomp($langchoice);
       $langchoice =~ s/(^\s+|\s+$)//g;
       $langchoice = lc($langchoice);
       if (defined($languages{$langchoice})) {
           $lang = $langchoice;
       }
       return $lang;
 }  }
   
 1;  1;
Removed from v.1.36  
changed lines
  Added in v.1.64

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>