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

Diff for /loncom/localize/lonlocal.pm between versions 1.4 and 1.50.4.1

version 1.4, 2003/09/17 01:45:14 version 1.50.4.1, 2009/09/14 22:32:09
Line 28 Line 28
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
   
   =pod
   
   =head1 NAME
   
   Apache::lonlocal - provides localization services
   
   =head1 SYNOPSIS
   
   lonlocal provides localization services for LON-CAPA programmers based
   on Locale::Maketext. See
   C<http://search.cpan.org/dist/Locale-Maketext/lib/Locale/Maketext.pod>
   for more information on Maketext.
   
   =head1 OVERVIEWX<internationalization>
   
   As of LON-CAPA 1.1, we've started to localize LON-CAPA using the
   Locale::Maketext module. Internationalization is the bulk of the work
   right now (pre-1.1); localizing can be done anytime, and involves 
   little or no programming.
   
   The internationalization process involves putting a wrapper around
   on-screen user messages and menus and turning them into keys,
   which the MaketextX<Maketext> library translates into the desired
   language output using a look-up table ("lexicon").X<lexicon>
   
   As keys we are currently using the plain English messages, and
   Maketext is configured to replace the message by its own key if no
   translation is found. This makes it easy to phase in the
   internationalization without disturbing the screen output.
   
   Internationalization is somewhat tedious and effectively impossible
   for a non-fluent speaker to perform, but is fairly easy to create
   translations, requiring no programming skill. As a result, this is one
   area where you can really help LON-CAPA out, even if you aren't a
   programmer, and we'd really appreciate it.
   
   =head1 How To Localize Handlers For Programmers
   
   Into the "use" section of a module, we need to insert
   
    use Apache::lonlocal;
   
   Note that there are B<no parentheses>, we B<want> to pollute our
   namespace. 
   
   Inside might be something like this
   
    sub message {
        my $status=shift;
        my $message='Status unknown';
        if ($status eq 'WON') {
           $message='You have won.';
        } elsif ($status eq 'LOST') {
           $message='You are a total looser.';
        }
        return $message;
    }
    ...
    $r->print('<h3>Gamble your Homework Points</h3>');
    ...
    $r->print(<<ENDMSG);
    <font size="1">Rules:</font>
    <font size="0">No purchase necessary. Illegal where not allowed.</font>
    ENDMSG
   
   We have to now wrap the subroutine &mt()X<mt> ("maketext") around our 
   messages, but not around markup, etc. We also want minimal disturbance. 
   The first two examples are easy:
   
    sub message {
        my $status=shift;
        my $message='Status unknown';
        if ($status eq 'WON') {
           $message='You have won.';
        } elsif ($status eq 'LOST') {
           $message='You are a total looser.';
        }
        return &mt($message);
    }
    ...
    $r->print('<h3>'.&mt('Gamble your Homework Points').'</h3>');
   
   The last one is a bummer, since you cannot call subroutines inside of 
   (<<MARKER). I have written a little subroutine to generate a translated 
   hash for that purpose:
   
    my %lt=&Apache::lonlocal::texthash('header' => 'Rules', 'disclaimer' => 
    'No purchase necessary. Illegal where not allowed.');
    $r->print(<<ENDMSG);
    <font size="1">$lt{'header'}:</font>
    <font size="0">$lt{'disclaimer'}</font>
    ENDMSG
   
   As a programmer, your job is done here. If everything worked, you 
   should see no changes on the screen.
   
   =head1 How To Localize LON-CAPA for Translators
   
   As a translator, you need to provide the lexicon for the keys, which in 
   this case is the plain text message. The lexicons sit in 
   loncom/localize/localize, with the language code as filename, for 
   example de.pm for the German translation. The file then simply looks 
   like this:
   
       'You have won.'
    => 'Sie haben gewonnen.',
   
       'You are a total looser.'
    => 'Sie sind der totale Verlierer.',
   
       'Rules'
    => 'Regeln',
   
       'No purchase necessary. Illegal where not allowed.'
    => 'Es ist erlaubt, einfach zu verlieren, und das ist Ihre Schuld.'
   
   
   Comments may be added with the # symbol, which outside of a string
   (the things with the apostrophe surrounding them, which are the 
   keys and translations) will cause the translation routines to
   ignore the rest of the line.
   
   This is a relatively easy task, and any help is appreciated.
   
   Maketext can do a whole lot more, see
   C<http://search.cpan.org/dist/Locale-Maketext/lib/Locale/Maketext.pod>
   but for most purposes, we do not have to mess with that.
   
   =cut
   
 package Apache::lonlocal;  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);
   
 my $reroute;  
   
 # ========================================================= The language handle  # ========================================================= The language handle
   
Line 48  use vars qw($lh); Line 180  use vars qw($lh);
 # ===================================================== 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 {
               return $lh->maketext(@_);
           }
     } 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?
   
   sub current_language {
       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 $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  # ============================================================== Translate hash
   
 sub texthash {  sub texthash {
Line 77  sub texthash { Line 321  sub texthash {
     return %hash;      return %hash;
 }  }
   
 # ======================================================== Re-route translation  # ========= Get a handle (do not invoke in vain, leave this to access handlers)
   
 sub reroutetrans {  sub get_language_handle {
     $ENV{'transreroute'}=1;      my $r=shift;
     $reroute='';      if ($r) {
 }   my $headers=$r->headers_in;
 # ==================================================== End re-route translation   $ENV{'HTTP_ACCEPT_LANGUAGE'}=$headers->{'Accept-language'};
 sub endreroutetrans {      }
     $ENV{'transreroute'}=0;      my @languages=&preferred_languages();
     if ($ENV{'environment.translator'}) {      $ENV{'HTTP_ACCEPT_LANGUAGE'}='';
  return $reroute;      $lh=Apache::localize->get_handle(@languages);
       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 ($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,$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 ((&current_language=~/^en/) || (!$lh)) {
   
    return $dt->strftime("%a %b %e %I:%M:%S %P %Y (%Z)");
     } else {      } 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 {  
     $lh=Apache::localize->get_handle(&Apache::loncommon::preferred_languages);  # ==================== 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
   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;
   }
   
   # alias for normalize_string; recommend using it only in the lexicon
   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
   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;  1;
Removed from v.1.4  
changed lines
  Added in v.1.50.4.1

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