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

Diff for /loncom/localize/lonlocal.pm between versions 1.10 and 1.69

version 1.10, 2003/09/22 18:16:43 version 1.69, 2022/09/08 01:41:14
Line 38  Apache::lonlocal - provides localization Line 38  Apache::lonlocal - provides localization
   
 lonlocal provides localization services for LON-CAPA programmers based  lonlocal provides localization services for LON-CAPA programmers based
 on Locale::Maketext. See  on Locale::Maketext. See
 C<http://search.cpan.org/dist/Locale-Maketext/lib/Locale/Maketext.pod>  C<https://metacpan.org/pod/Locale::Maketext>
 for more information on Maketext.  for more information on Maketext.
   
 =head1 OVERVIEWX<internationalization>  =head1 OVERVIEWX<internationalization>
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 144  like this: Line 144  like this:
     'No purchase necessary. Illegal where not allowed.'      'No purchase necessary. Illegal where not allowed.'
  => 'Es ist erlaubt, einfach zu verlieren, und das ist Ihre Schuld.'   => '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  Comments may be added with the # symbol, which outside of a string
 (the things with the apostrophe surrounding them, which are the   (the things with the apostrophe surrounding them, which are the 
Line 158  ignore the rest of the line. Line 153  ignore the rest of the line.
 This is a relatively easy task, and any help is appreciated.  This is a relatively easy task, and any help is appreciated.
   
 Maketext can do a whole lot more, see  Maketext can do a whole lot more, see
 C<http://search.cpan.org/dist/Locale-Maketext/lib/Locale/Maketext.pod>  C<https://metacpan.org/pod/Locale::Maketext>
 but for most purposes, we do not have to mess with that.  but for most purposes, we do not have to mess with that.
   
 =cut  =cut
Line 167  package Apache::lonlocal; Line 162  package Apache::lonlocal;
   
 use strict;  use strict;
 use Apache::localize;  use Apache::localize;
 use Apache::File;  use locale;
   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);  our @EXPORT = qw(mt mtn ns mt_user js_escape html_escape);
   
 my $reroute;  my %mtcache=();
   
 # ========================================================= The language handle  # ========================================================= The language handle
   
 use vars qw($lh);  use vars qw($lh $current_language);
   
 # ===================================================== The "MakeText" function  # ===================================================== The "MakeText" function
   
 sub mt (@) {  sub mt (@) {
     unless ($ENV{'environment.translator'}) {  #    open(LOG,'>>/home/www/loncapa/loncom/localize/localize/newphrases.txt');
  return $lh->maketext(@_);  #    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 {      } else {
  my $trans=$lh->maketext(@_);   if (wantarray) {
  my $link='<a target="trans" href="/cgi-bin/translator.pl?arg1='.      return @_;
     &Apache::lonnet::escape($_[0]).'&arg2='.  
     &Apache::lonnet::escape($_[1]).'&arg3='.  
     &Apache::lonnet::escape($_[2]).'&lang='.  
     $ENV{'environment.translator'}.  
     '">[['.$trans.']]</a>';  
  if ($ENV{'transreroute'}) {  
     $reroute.=$link;  
     return $trans;  
  } else {   } 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?  # ============================================================== What language?
   
 sub current_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);
       }
   
       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 $enc=$lh->maketext('char_encoding');      my $default='UTF-8';
     return ($enc eq 'char_encoding'?'':$enc);      unless ($Apache::lonnet::env{'browser.unicode'}) {
           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  # ============================================================== Translate hash
   
 sub texthash {  sub texthash {
     my %hash=@_;      my %hash=@_;
     foreach (keys %hash) {      foreach (keys(%hash)) {
  $hash{$_}=&mt($hash{$_});   $hash{$_}=&mt($hash{$_});
     }      }
     return %hash;      return %hash;
 }  }
 # ======================================================== Re-route translation  
   
 sub clearreroutetrans {  # ========= Get a handle (do not invoke in vain, leave this to access handlers)
     &reroutetrans();  
     $reroute='';  sub get_language_handle {
       my ($r,$chosen) = @_;
       if ($r) {
    my $headers=$r->headers_in;
    $ENV{'HTTP_ACCEPT_LANGUAGE'}=$headers->{'Accept-language'};
       }
       my @languages;
       if ($chosen ne '') {
           @languages=($chosen);
       } else {
           @languages=&preferred_languages();
       }
       $ENV{'HTTP_ACCEPT_LANGUAGE'}='';
       $lh=Apache::localize->get_handle(@languages);
       $current_language=&current_language();
       if ($r) {
    $r->content_languages([&current_language()]);
       }
   ###    setlocale(LC_ALL,&current_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 (&Apache::lonnet::usertools_access($Apache::lonnet::env{'user.name'},
                                             $Apache::lonnet::env{'user.domain'},
                                             'timezone')) {
           if ($Apache::lonnet::env{'environment.timezone'} ne '') {
               $timezone = $Apache::lonnet::env{'environment.timezone'};
               if ($cid ne '') {
                   if (($Apache::lonnet::env{'course.'.$cid.'.tzover'}) &&
                       ($Apache::lonnet::env{'course.'.$cid.'.timezone'} ne '')) {
                       $timezone = $Apache::lonnet::env{'course.'.$cid.'.timezone'};
                   }
               }
               if ($timezone ne '') {
                   if (DateTime::TimeZone->is_valid_name($timezone)) {
                       return $timezone;
                   }
               }
           }
       }
       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';
 }  }
   
 # ======================================================== Re-route translation  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));
   
 sub reroutetrans {      # TimeZone tries to determine the 'local' timezone from $ENV{TZ} if this
     $ENV{'transreroute'}=1;      # 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)) {
   
    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 $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)";
       }
   }
   
   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;
 }  }
   
 # ==================================================== End re-route translation  =pod
 sub endreroutetrans {  
     $ENV{'transreroute'}=0;  =over 
     if ($ENV{'environment.translator'}) {  
  return $reroute;  =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 {      } else {
  return '';   return $_[0];
     }      }
 }  }
   
 # ========= Get a handle (do not invoke in vain, leave this to access handlers)  # ---------------------------------------------------- Replace MT{...} in files
   
 sub get_language_handle {  sub transstatic {
     my $r=shift;      my $strptr=shift;
     $lh=Apache::localize->get_handle(&Apache::loncommon::preferred_languages);      $$strptr=~s/MT\{([^\}]*)\}/&mt($1)/gse;
     $r->content_languages(["&current_language()"]);  }
     my $enc=&current_encoding();  
     if ($enc) {  =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;
   }
   
   =pod 
   
   =item * js_escape()
   
   js_escape takes a string, string reference or hash reference,
   and escapes the values so that they can be used within a <script> element.
   It replaces all instances of \ by \\, ' by \', " by \" and \n by \\n.
   It is typically used with localized strings, which might contain quotes.
   
   =cut
   
   sub js_escape {
       my ($v) = @_;
       my $ref = ref($v);
       if ($ref eq 'SCALAR') {
           $$v =~ s/\\/\\\\/g;
           $$v =~ s/'/\\'/g;
           $$v =~ s/"/\\"/g;
           $$v =~ s/\n/\\n/g;
       } elsif ($ref eq 'HASH') {
           foreach my $key (keys %$v) {
               $v->{$key} =~ s/\\/\\\\/g;
               $v->{$key} =~ s/'/\\'/g;
               $v->{$key} =~ s/"/\\"/g;
               $v->{$key} =~ s/\n/\\n/g;
           }
       } else {
           $v =~ s/\\/\\\\/g;
           $v =~ s/'/\\'/g;
           $v =~ s/"/\\"/g;
           $v =~ s/\n/\\n/g;
           return $v;
       }
   }
   
   =pod 
   
   =item * html_escape()
   
   html_escape takes a string, string reference or hash reference,
   and escapes the values so that they can be used as HTML.
   It encodes <, >, &, ' and ".
   
   =cut
   
   sub html_escape {
       my ($v) = @_;
       my $ref = ref($v);
       if ($ref eq 'SCALAR') {
           $$v =~ s/&/&amp;/g;
           $$v =~ s/</&lt;/g;
           $$v =~ s/>/&gt;/g;
           $$v =~ s/'/&apos;/g;
           $$v =~ s/"/&quot;/g;
       } elsif ($ref eq 'HASH') {
           foreach my $key (keys %$v) {
               $v->{$key} =~ s/&/&amp;/g;
               $v->{$key} =~ s/</&lt;/g;
               $v->{$key} =~ s/>/&gt;/g;
               $v->{$key} =~ s/'/&apos;/g;
               $v->{$key} =~ s/"/&quot;/g;
           }
       } else {
           $v =~ s/&/&amp;/g;
           $v =~ s/</&lt;/g;
           $v =~ s/>/&gt;/g;
           $v =~ s/'/&apos;/g;
           $v =~ s/"/&quot;/g;
           return $v;
       }
       # NOTE: we could also turn \n into <br> if needed
   }
   
   =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.
   
   =back
   
   =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.10  
changed lines
  Added in v.1.69

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