用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};
}