selima-perl/lib/perl5/Selima/UserName.pm

# Selima Website Content Management System
# UserName.pm: The user information subroutines.

#  Copyright (c) 2004-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: 2004-09-26

package Selima::UserName;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw();
push @EXPORT, qw(username userid groupid groupdsc groupsn);
push @EXPORT, qw(user_opt_label group_opt_label su_group_sn);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub username($);
sub userid($);
sub groupid($);
sub groupdsc($);
sub groupsn($);
sub user_opt_label($;$);
sub group_opt_label($;$);
sub su_group_sn();
}

use Selima::Cache qw(:username);
use Selima::ChkFunc;
use Selima::CommText;
use Selima::DataVars qw($DBH :groups :l10n :lninfo);
use Selima::GetLang;
use Selima::LnInfo;
use Selima::ShortCut;

# username: Obtain a user name
sub username($) {
    local ($_, %_);
    my ($sn, $sql, $sth);
    $sn = $_[0];
    # Bounce if there is any problem with $sn
    return t_notset if !defined $sn;
    # Return the cache
    return $UserName_username{$sn} if exists $UserName_username{$sn};
    
    # Check the serial number first
    return ($UserName_username{$sn} = t_na)
        if !check_sn $sn;
    
    # Query
    $sql = "SELECT name FROM users WHERE sn=$sn;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($UserName_username{$sn} = t_na)
        unless $sth->rows == 1;
    
    # Found
    return ($UserName_username{$sn} = ${$sth->fetch}[0]);
}

# userid: Obtain a user ID.
sub userid($) {
    local ($_, %_);
    my ($sn, $sql, $sth);
    $sn = $_[0];
    # Bounce if there is any problem with $sn
    return t_notset if !defined $sn;
    # Return the cache
    return $UserName_userid{$sn} if exists $UserName_userid{$sn};
    
    # Check the serial number first
    return ($UserName_userid{$sn} = t_na)
        if !check_sn $sn;
    
    # Query
    $sql = "SELECT id FROM users WHERE sn=$sn;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($UserName_userid{$sn} = t_na)
        unless $sth->rows == 1;
    
    # Found
    return ($UserName_userid{$sn} = ${$sth->fetch}[0]);
}

# groupid: Obtain a group ID.
sub groupid($) {
    local ($_, %_);
    my ($sn, $sql, $sth);
    $sn = $_[0];
    # Bounce if there is any problem with $sn
    return t_notset if !defined $sn;
    # Return the cache
    return $UserName_groupid{$sn} if exists $UserName_groupid{$sn};
    
    # Check the serial number first
    return ($UserName_groupid{$sn} = t_na)
        if !check_sn $sn;
    
    # Query
    $sql = "SELECT id FROM groups WHERE sn=$sn;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($UserName_groupid{$sn} = t_na)
        unless $sth->rows == 1;
    
    # Found
    return ($UserName_groupid{$sn} = ${$sth->fetch}[0]);
}

# groupdsc: Obtain a group description
sub groupdsc($) {
    local ($_, %_);
    my ($sn, $sql, $sth, $col, $thiscol, $defcol);
    $sn = $_[0];
    # Bounce if there is any problem with $sn
    return t_notset if !defined $sn;
    # Return the cache
    return $UserName_groupdsc{$sn} if exists $UserName_groupdsc{$sn};
    
    # Check the serial number first
    return ($UserName_groupdsc{$sn} = t_na)
        if !check_sn $sn;
    
    # Query
    # Unilingual
    if (@ALL_LINGUAS == 1) {
        $col = "dsc AS dsc";
    # Multilingual
    } else {
        $thiscol = "dsc_" . getlang(LN_DATABASE);
        # Default language
        if (getlang eq $DEFAULT_LANG) {
            $col = "$thiscol AS dsc";
        # Fall back to the default language
        } else {
            $defcol = "title_" . ln($DEFAULT_LANG, LN_DATABASE);
            $col = "COALESCE($thiscol, $defcol) AS dsc";
        }
    }
    $sql = "SELECT $col FROM groups WHERE sn=$sn;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($UserName_groupdsc{$sn} = t_na)
        unless $sth->rows == 1;
    
    # Found
    return ($UserName_groupdsc{$sn} = ${$sth->fetch}[0]);
}

# groupsn: Obtain a group S/N
sub groupsn($) {
    local ($_, %_);
    my ($id, $sql, $sth);
    $id = $_[0];
    # Bounce if there is any problem with $id
    return if !defined $id;
    # Return the cache
    return $UserName_groupsn{$id} if exists $UserName_groupsn{$id};
    
    # Query
    $sql = "SELECT sn FROM groups"
        . " WHERE id=" . $DBH->quote($id) . ";\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($UserName_groupsn{$id} = undef) unless $sth->rows == 1;
    
    # Found
    return ($UserName_groupsn{$id} = ${$sth->fetch}[0]);
}

# user_opt_label: Obtain a user option label
sub user_opt_label($;$) {
    local ($_, %_);
    my ($sn, $for, $sql, $sth);
    ($sn, $for) = @_;
    # Check the validity of the serial number first
    return if !check_sn $sn;
    $sql = "SELECT id, name FROM users"
        . " WHERE sn=$sn;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    return if $sth->rows != 1;
    $_ = $sth->fetchrow_hashref;
    if (defined $for) {
        return sprintf("<label for=\"%s\">%s (%s)</label>",
            h($for), h($$_{"id"}), h($$_{"name"}));
    } else {
        return sprintf("%s (%s)",
            h($$_{"id"}), h($$_{"name"}));
    }
}

# group_opt_label: Obtain a group option label
sub group_opt_label($;$) {
    local ($_, %_);
    my ($sn, $for, $sql, $sth, $lndb, $lndbdef, $dsc);
    ($sn, $for) = @_;
    # Check the validity of the serial number first
    return t_na if !check_sn $sn;
    if (@ALL_LINGUAS > 1) {
        $lndb = getlang LN_DATABASE;
        if (getlang eq $DEFAULT_LANG) {
            $dsc = "dsc_$lndb AS dsc";
        } else {
            $lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
            $dsc = "COALESCE(dsc_$lndb, dsc_$lndbdef) AS dsc";
        }
    } else {
        $dsc = "dsc AS dsc";
    }
    $sql = "SELECT id, $dsc FROM groups"
        . " WHERE sn=$sn;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    return t_na if $sth->rows != 1;
    $_ = $sth->fetchrow_hashref;
    if (defined $for) {
        return sprintf("<label for=\"%s\">%s (%s)</label>",
            h($for), h($$_{"id"}), h($$_{"dsc"}));
    } else {
        return sprintf("%s (%s)",
            h($$_{"id"}), h($$_{"dsc"}));
    }
}

# su_group_sn: Return the S/N of the super user group
#   Return 0 on "no super user group"
sub su_group_sn() {
    local ($_, %_);
    my ($sth, $sql);
    # Return the cache
    return $UserName_su_group_sn if defined $UserName_su_group_sn;
    
    # Query
    $sql = "SELECT sn FROM groups"
        . " WHERE id=" . $DBH->quote(SU_GROUP) . ";\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($UserName_su_group_sn = 0) if $sth->rows != 1;
    
    # Found
    return ($UserName_su_group_sn = ${$sth->fetchrow_hashref}{"sn"});
}

return 1;