ilcatlib.pm

支持全流程的Perl+MySQL电子商务系统。完全公开代码。

package iLcatlib;
#####################################################################
#
#
#
#					iLcat CGI Process Library
#
#
#
#	!!!此版本仅可用在NkSHOP程序当中,请不要与使用其他版本的互换!!!
#
#####################################################################
#						iLcatlib方法列表
#-------------------------------------------------------内部方法----
#	new:构造函数				exit:退出与关闭		
#	version:模块版本			crypt:采用md5的加密(需要MD5.pm)
#-------------------------------------------------------提交方法----
#	ReadParse:获得提交			ReadTime:获得时间
#	ReadCookie:获得COOKIE		CookieClear:清楚Cookie
#-------------------------------------------------------KEY方法-----
#	RandKey:一串Key编码			key_proc:对Key进行处理
#-------------------------------------------------------MySQL代理---
#	此类方法需要DBI或Apache::DBI支持	
#
#	MySQL_Connect:MySQL的连接	MySQL_Disconnect:MySQL关闭连接
#	MySQL_Query:索取记录		MySQL_Do:执行命令
#	MySQL_Quote:格式化记录
#-------------------------------------------------------字符处理----
#	Str_dual:双字节字符串		Shopping:购物车读取程序
#	Str_spec:类型字节			RandNumber:从一个数字范围取出一定的内容
#-------------------------------------------------------页面处理----
#	此类方法需要专用iLcat Template支持
#
#	Mailer:邮件发送
#	Lost:非用户错误反馈			Done:完成页面
#	Error:用户错误页			Location:定位其他页面
#####################################################################
use FindBin qw($Bin);
use lib "$Bin/library";
use IniFiles;
use iltemp;
use CGI qw/:standard/;
use MD5;
if( $ENV{MOD_PERL} ) { 
    eval 'use Apache::DBI'; 
} else { 
    eval 'use DBI'; 
} 

@ISA = qw(IniFiles);
@EXPORT = qw(
new exit version crypt
RandKey key_proc
ReadParse ReadTime ReadCookie CookieClear
Str_dual Shopping Str_spec
MySQL_Connect MySQL_Disconnect MySQL_Query MySQL_Do MySQL_Quote
Lost Done Error Location
);
@EXPORT_OK = qw(exit);

use strict;
use vars qw($dbh $sth $version);

$version="1.265";

####################################
#Recive ttmlpath
sub new
{
my $class=shift;
my %hash=@_;
my $self={};

$self->{ttmlpath}	=	$hash{ttmlpath} || 0;

bless $self,$class;

return $self;
}

##################################
#Version
sub version
{
my @version=('iLcatForums',$version);

return(@version);
}

##################################
#exit run
sub exit{

  if(exists $ENV{MOD_PERL}) {
    Apache::exit(0);
  }
  else {
    CORE::exit(0);
  }

}

################################
#RandKey
sub RandKey
{
my (@code,$keyword,$time,$i,$session,$self)=undef;

$time=time();
srand;
@code=split(/ */, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789");

for ($i=0;$i<5 ;$i++) {
	$keyword .="$code[int(rand(62))]$code[int(rand(62))]";
}

$session=&crypt($self,"$keyword$time");

return("$session");
}

#################################
#CRYPT PASSWORD
sub crypt
{
my ($self,$password,$mode,$crypt,$char);
($self,$password,$mode)=@_;

$crypt = MD5->new;
$crypt->add($password);

if ($mode eq "bin") {		#Bindary Code
	$char = $crypt->digest;
}
elsif ($mode eq "b64") {	#Mime Base64 Code
	$char = $crypt->b64digest;
}
else {						#Hex 32Bit Code
	$char = $crypt->hexdigest;
}

return($char);
}

#################################
#ReadParse
sub ReadParse
{
my ($myCGI,@param_name,%FORM)=undef;

$myCGI = new CGI;

@param_name = $myCGI->param;

foreach  (@param_name) {
	$FORM{"$_"}=$myCGI->param("$_");
}


return(%FORM);
}


##################################
#ReadCookie
sub ReadCookie
{
my (%COOKIE,@cookies,$name,$value)=undef;

	if($ENV{'HTTP_COOKIE'}) {
		@cookies = split(/; /,$ENV{'HTTP_COOKIE'}); 
		foreach(@cookies) { 
		($name,$value) = split(/=/,$_); 
		$COOKIE{$name} = $value; 
		} 
	} 

return(%COOKIE);
}

##################################
#ReadTime
#type 0 localtime
#type 1 Chinese mod
sub ReadTime
{
my ($self,$type)=@_;
my (@localtime);

@localtime = localtime(time);
$localtime[5]=$localtime[5]+1900;
$localtime[4]++;

if ($type eq "0") {return(@localtime);}
else {return("$localtime[5]年$localtime[4]月$localtime[3]日  $localtime[2]:$localtime[1]:$localtime[0]");}

&exit();
}



################################
#MySQL_Connect
#database datahost datauser datapwd
sub MySQL_Connect
{
my $class=shift;
my %hash=@_;

$dbh=DBI->connect("DBI:mysql:$hash{'database'}:$hash{'dbhost'}",$hash{'dbuser'},$hash{'dbpwd'}) || die &Lost('',"$DBI::errstr","iLcatlib MySQL_Connect");

return();
}

###########################################################################
# Disconnect
sub MySQL_Disconnect{

$dbh->disconnect or die &Lost("Can't disconnect from database. Reason: $DBI::errstr","iLcatlib MySQL_Disconnect") and undef $dbh;

}

#################################
#MySQL_Query
#command
sub MySQL_Query
{
my ($class,$command)=@_;

$sth=$dbh->prepare("$command") || die &Lost($class,$dbh->errstr);
$sth->execute() || die &Lost($class,$dbh->errstr);

return($sth);
}

#################################
#MySQL_Do
#command
sub MySQL_Do
{
my ($class,$command,$do)=@_;

$sth=$dbh->do("$command") || die &Lost($class,$dbh->errstr);

return($sth);
}


#################################
sub MySQL_Quote
{
my ($class,$command)=@_;

	$command=$dbh->quote("$command");

return($command);
}

#################################
sub Str_dual
{
my ($class,$string,$length)=@_;

 if (ord(substr($string,$length-1,1)) =~ /[200-377]/) {
 	if (ord(substr($string,$length,1)) =~ /[200-377]/) {
	 $length=$length+2;
	}
	else{
	}
 }

 $string=substr($string,0,$length);

return($string);
}

#################################
sub Str_spec
{
my ($class,$str,@string);

($class,$str)=@_;

@string=split(",",$str);

return(@string);
}

#################################
sub Shopping
{
my ($class,$source_data,@values);
($class,$source_data)=@_;

@values=split('║',$source_data);

return(@values);
}

################################
sub RandNumber
{
my ($class,$length,$how,$int,$nosave,@arrange);
($class,$length,$how)=@_;

$how = $length if ($how > $length);

srand;

while (($#arrange+1) <= $how) {
	$nosave=0;

	$int=int(rand($length+1));

	foreach  (@arrange) {
		if ($int eq $_) {$nosave=1;last;}
	}

	push(@arrange,$int) if ($nosave ne 1);
}


return(@arrange);
}

################################
#Lost
sub Lost
{
my ($self,$event,$errorcode)=@_;

my $query = new CGI;

print	$query->header('text/html; charset=gb2312'),
		$query->start_html(-title=>'LostError',
							-author=>'[e-mail]',
							-target=>'_blank',
							-meta=>{'Copyright'=>'Copyright By iLcatForums Troop @2001'}),
		$query->start_table({-width=>'100%',-border=>'0',-style=>'font-size: 9pt'}),
        $query->Tr([
			td(["			  [程序内部错误]
			<p>程序中产生了内部错误：<font color=red>$event</font></p>
			<P>错误机制: $errorcode</p>
			<p>请首先查阅相关帮助，如果无解决办法请尝试与iLcatForums Develop Troop相关人员联系。
			<p align=center>iLcatForums</p>"])
				]),
		$query->end_table(),
		$query->end_html;


&exit();
}

################################
#Error
sub Error
{
my ($self,$act,$head,$imgurl)=@_;

my $text = {
		act=>$act,
		meta=>$head,
		imgurl=>$imgurl
};

my @view=iltemp::Parse($self,"error.htm",$text);

print "@view";

&exit();
}

################################
#Done
sub Done
{
my ($self,$report,$hitbot)=@_;

my $text={
#	meta=>$meta,
	report=>$report,
	hitbot=>$hitbot
};

my @view=&ilcatemp::cop($self->{ttmlpath},"done.htm",$text);

print "@view";

&exit();
}

###############################
#Location
sub Location
{
my ($self,$urls)=@_;

print "Location: $urls \n\n";

&exit();
}

###############################
#key_proc
sub key_proc
{
my (%CON,$row,$self,$key,$timeout);

($self,$key,$timeout)=@_;

my ($lgt,$dlgt);

#######格式化时间
$lgt = time();	#当前时间
$timeout = "5000" if ($timeout eq "");	#超时时间
$dlgt = $lgt - $timeout;	#范围时间

############################删除已经过时的Key数据
$sth=$dbh->do("UPDATE userdata set lgt='',ukey='' where lgt<='$dlgt'") or die &Lost($self,"$DBI::errstr","010416174428");

######################
#当前用户的KEY
if ($key ne "") {
	############################读出用户的数据
	$sth=$dbh->prepare("select id,level from userdata where ukey='$key'") or die &Lost($self,"$DBI::errstr","010415230114");
	$sth->execute() or die &Lost('',"$DBI::errstr","010415232905");
	$row = $sth->fetchrow_arrayref;

	if ($row->[0] ne "") {

	############################记录当前时间
	$sth=$dbh->do("UPDATE userdata set lgt='$lgt' where ukey='$key'") or die &Lost($self,"$DBI::errstr","010415233216");

	my $session_key = &iLcatlib::cookie(-name=>'key',
			 -value=>"$key",
			 -expires=>"+$timeout\s");

		print "Set-Cookie: $session_key\n";


		#返回用户的id名称与等级
		return($row->[0],$row->[1]);
	}
	else {
		&CookieClear($self,'key');
		&Error($self,"用户超时,请重新登陆");
	}
}
else {
	#返回匿名用户
	&CookieClear($self,'key');
	return('游客','3');
}

return();
}


sub CookieClear
{
my ($cookie,$self,$name);

($self,$name)=@_;

$cookie = &cookie(-name=>"$name",
				 -value=>'',
				 -expires=>'+10s');

print "Set-Cookie: $cookie\n";
#print &header(-cookie=>[$cookie]);

return();
}
1;