# Selima Website Content Management System
# AltLang.pm: The subroutines to obtain the URLs of the alternative language versions.

#  Copyright (c) 2003-2018 imacat.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

# Author: imacat <imacat@mail.imacat.idv.tw>
# First written: 2003-04-03

package Selima::AltLang;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw(altlang set_altlang_urls);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub altlang($$);
sub set_altlang_urls($);
}

use Data::Dumper qw();
use URI::Escape qw(uri_escape);

use Selima::AddGet;
use Selima::DataVars qw(:input :lninfo :requri);
use Selima::EchoForm;
use Selima::LnInfo;
use Selima::Session;
use Selima::Unicode;

use vars qw(%ALT_LANG %IS_SCRIPT);

# altlang: Obtain the URL of an alternative language version
sub altlang($$) {
    local ($_, %_);
    my ($lang, $args);
    ($lang, $args) = @_;
    set_altlang_urls $args;
    # Return it
    return ${$$args{"altlang"}}{$lang};
}

# set_altlang_urls: Set the URLs of the language variants
sub set_altlang_urls($) {
    local ($_, %_);
    my ($args, $path, $langfile, %urls);
    my ($args0, @argkeys0, $need_charset);
    $args = $_[0];
    # Return if already obtained
    return if exists $$args{"altlang"};
    
    # Set the page path
    $path = $$args{"path"};
    $path .= "index.html" if $path =~ /\/$/;
    
    # Set the URL parameter
    if ($$args{"static"}) {
        $langfile = ln $$args{"lang"}, LN_FILENAME;
        $path =~ s/\.$langfile$//;
        $path .= ".%s";
    
    } else {
        #$args0 = $USER_INPUT{"GET_UTF8"};
        eval Data::Dumper->Dump([$USER_INPUT{"GET_UTF8"}], [qw($args0)]);
        @argkeys0 = @{$USER_INPUT{"GET_KEYS"}};
        %_ = map { $_ => 1 } @argkeys0;
        # Whether we need to specify the character set
        $need_charset = !is_usascii_printable($args0->Vars);
        # Remove the session ID
        if (exists $_{$Selima::Session::NAME}) {
            $args0->delete($Selima::Session::NAME);
            @argkeys0 = grep $_ ne $Selima::Session::NAME, @argkeys0;
        }
        # Non-ASCII -- specify the character set
        if ($need_charset) {
            if (!exists $_{"charset"}) {
                $args0->param("charset", "");
                push @argkeys0, "charset";
            }
        # US-ASCII -- we do not need to specify the character set
        } else {
            if (exists $_{"charset"}) {
                $args0->delete("charset");
                @argkeys0 = grep $_ ne "charset", @argkeys0;
            }
        }
        # Append the referer
        if (auto_keep_referer) {
            $args0->param("referer", $ENV{"HTTP_REFERER"});
            push @argkeys0, "referer";
        }
        # Append the language
        if (!exists $_{"lang"}) {
            $args0->param("lang", "");
            push @argkeys0, "lang";
        }
    }
    
    # Deal with each language
    %urls = qw();
    foreach my $lang (@{$$args{"all_linguas"}}) {
        if ($$args{"static"}) {
            $urls{$lang} = sprintf $path, ln($lang, LN_FILENAME);
        } else {
            my ($args1, @argkeys1, $charset1);
            # Make a copy of the variables
            eval Data::Dumper->Dump([$args0], [qw($args1)]);
            @argkeys1 = @argkeys0;
            $charset1 = ln $lang, LN_CHARSET;
            $args1->param("lang", $lang);
            @_ = qw();
            # We need to specify the character set
            $args1->param("charset", $charset1)
                if $need_charset;
            foreach (@argkeys1) {
                foreach my $val ($args1->param($_)) {
                    push @_, uri_escape(h_encode($_, $charset1))
                        . "=" . uri_escape(h_encode($val, $charset1))
                }
            }
            $urls{$lang} = $REQUEST_FILE . "?" . join "&", @_;
        }
        $urls{$lang} = $urls{$lang};
    }
    
    # Record it
    $$args{"altlang"} = \%urls;
    return;
}

return 1;