# The LearningOnline Network with CAPA
# Localization routines
#
# $Id: lonlocal.pm,v 1.69 2022/09/08 01:41:14 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
######################################################################
######################################################################

=pod

=head1 NAME

Apache::lonlocal - provides localization services

=head1 SYNOPSIS

lonlocal provides localization services for LON-CAPA programmers based
on Locale::Maketext. See
C<https://metacpan.org/pod/Locale::Maketext>
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 loser.';
     }
     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 loser.';
     }
     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 loser.'
 => '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<https://metacpan.org/pod/Locale::Maketext>
but for most purposes, we do not have to mess with that.

=cut

package Apache::lonlocal;

use strict;
use Apache::localize;
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 mtn ns mt_user js_escape html_escape);

my %mtcache=();

# ========================================================= The language handle

use vars qw($lh $current_language);

# ===================================================== The "MakeText" function

sub mt (@) {
#    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 (wantarray) {
	    return @_;
	} else {
	    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);
    }

    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?

sub current_encoding {
    my $default='UTF-8';
    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

sub texthash {
    my %hash=@_;
    foreach (keys(%hash)) {
	$hash{$_}=&mt($hash{$_});
    }
    return %hash;
}

# ========= Get a handle (do not invoke in vain, leave this to access handlers)

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';
}

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));

    # 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)) {

	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;
}

=pod

=over 

=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;
}

=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;

__END__