Initial commit.
This commit is contained in:
273
lib/perl5/Selima/UserName.pm
Normal file
273
lib/perl5/Selima/UserName.pm
Normal file
@@ -0,0 +1,273 @@
|
||||
# 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;
|
||||
Reference in New Issue
Block a user