用perl写的一些常用功能函数

###########################################################
# 功能：取当前时间
# 参数：无
# 返回值： 按照YYYYMMDDHHMMSS的格式返回时间
###########################################################
sub get_time
{
 my( $sec, $min, $hour, $day, $month, $year ) = localtime( time() );
 $year += 1900;
 $month++;
 $today = sprintf( "%04d%02d%02d%02d%02d%02d", $year, $month, $day, $hour, $min, $sec );
 return $today;
}

###########################################################
# 功能：取当天日期
# 参数：无
# 返回值： 按照YYYYMMDD的格式返回当前日期
###########################################################
sub get_date
{
 my( $sec, $min, $hour, $day, $month, $year ) = localtime( time() );
 $year += 1900;
 $month++;
 $today = sprintf( "%04d%02d%02d", $year, $month, $day );
 return $today;
}

##########################################################

# 载入某个页面模板
sub template{
 my ($file)=@_;
 $file=$TPL_DIR.$file;
 return "" if (! -f $file);
 open(DATAFILE,$file) or perror( "无法读取模板文件 $file 请联系系统管理员");
 my $txt="";
    while (<DATAFILE>) {
  $txt.=$_;
 }
 close(DATAFILE);

  return $txt;
}

# 将页面模板中的变量替换成指定值
sub set_var{
 my ($page,$param,$value)=@_;
 $page =~s//${$param}/$value/g;
 return $page;
}

#去掉字符串首尾空格
sub trim
{
    my $string = shift;
    $string =~ s/^/s+//;
    $string =~ s//s+$//;
    return $string;
}

########文件加锁############

open CGIFILE ,">$fileConfig" or perror("对不起,无法发布$fileConfig配置文件,请稍后再试");
 flock(CGIFILE,2); ##文件加锁
 print CGIFILE $page;
 flock(CGIFILE,8); ##释放文件锁
 close CGIFILE;

##################################################

sub set_cookie_by_key
{
 my ($key,$val)=@_;
 print "Set-Cookie:$key=$val;domain=$domain;path=$path;/n";
}
sub get_cookie_by_key
{
 my ($cookie_key)=@_;
 my($chip, $val, %cookie);
 foreach (split(/; /, $ENV{'HTTP_COOKIE'})) {
  s//+/ /g;
  ($chip, $val) = split(/=/,$_,2); # splits on the first =.
  $chip =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
  $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
  $cookie{$chip} .= "/1" if (defined($cookie{$chip})); # /1 is the multiple separator
  $cookie{$chip} .= $val;
 }
 my $temp;
 while (my ($k,$v)=each %ENV)
 {
  $temp .="$k=>$v<br>"; 
 }
 return $cookie{$cookie_key};
}