146 lines
4.4 KiB
Perl
146 lines
4.4 KiB
Perl
# 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;
|