Initial commit.

2026-03-10 21:25:26 +08:00
commit 78739bf725
3089 changed files with 472990 additions and 0 deletions
--- a/lib/perl5/Selima/AltLang.pm
+++ b/lib/perl5/Selima/AltLang.pm
@@ -0,0 +1,145 @@
+# 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;