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