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/DBILogin.pm
+++ b/lib/perl5/Selima/DBILogin.pm
@@ -0,0 +1,93 @@
+# Selima Website Content Management System
+# DBILogin.pm: The subroutine to extract the database log in information.
+
+#  Copyright (c) 2006-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: 2006-02-02
+
+package Selima::DBILogin;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw(get_dbi_login_info);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub get_dbi_login_info($;$$);
+}
+
+use MIME::Base64 qw(decode_base64);
+
+use Selima::DataVars qw(:db :siteconf);
+
+# get_dbi_login_info: Obtain the DBI log-in information
+sub get_dbi_login_info($;$$) {
+    local ($_, %_);
+    my ($type, $host, $user, @names, %login);
+    ($type, $host, $user) = @_;
+    
+    # DBMS naming convensions
+    if ($type eq DBI_POSTGRESQL) {
+        @names = qw(PGHOST PGUSER PGPASSWORD PGDATABASE);
+    } elsif ($type eq DBI_MYSQL) {
+        @names = qw(MYSQL_HOST MYSQL_USER MYSQL_PW MYSQL_DB);
+    }
+    # Initialize the return values
+    %login = (
+        $names[0]   => undef,
+        $names[1]   => undef,
+        $names[2]   => undef,
+        $names[3]   => "test",
+    );
+    
+    # Obtain the DBI log-in information from the environment
+    if (exists $ENV{"SQLLOGIN"}) {
+        # Parse the DBI log-in information
+        # The first matched line is used, so put the default first
+        foreach my $line (split /\n/, decode_base64($ENV{"SQLLOGIN"})) {
+            @_ = split /\t/, $line;
+            # Skip malformed lines
+            next unless @_  == 4;
+            # Not this type
+            next if $_[0] ne $type;
+            # Not this host
+            next if defined $host && $_[1] ne $host;
+            # Not this user
+            next if defined $user && $_[2] ne $user;
+            # Found
+            # Deal with null values
+            foreach (@_) {
+                undef $_ if $_ eq "null";
+            }
+            $login{$names[0]} = $_[1];
+            $login{$names[1]} = $_[2];
+            $login{$names[2]} = $_[3];
+            $login{$names[3]} = $PACKAGE if defined $PACKAGE;
+            last;
+        }
+    }
+    
+    # Alternative information set in %DBILOGIN
+    foreach (keys %DBILOGIN) {
+        $login{$_} = $DBILOGIN{$_} if exists $login{$_};
+    }
+    
+    return %login;
+}
+
+return 1;