Perl CGI

最新推荐文章于 2025-06-13 16:29:45 发布

原创最新推荐文章于 2025-06-13 16:29:45 发布 · 2.3k 阅读

1 ·

CC 4.0 BY-SA版权

文章标签：

#Perl #CGI

技术探究专栏收录该内容

15 篇文章

订阅专栏

什么是CGI呢？基本上来说CGI是HTTP Server服务端与Client之间的接口，CGI脚本运行在Server上接受Client上HTML发出的请求，并进行交互。

用which perl 或 which perl5来查看Perl的安装目录：　/usr/bin/perl 或　　/usr/locaiAin/per15
Perl版本：perl -v, perl5 -v
Perl脚本第一句：perl程序的安装目录，比如#/usr/bin/perl, 同时#也是注释符号
写完脚本要赋予可执行权限
一段Perl脚本的应用

#!/usr/bin/perl

use CGI qw( :standard );

$id = param( "name" );
$release=param( "release" );
$errortype=param( "errortype" );
$domain=param( "domain" );
$applic = param( "applic" );
$context=param( "context" );
$meaning=param( "meaning" );
$actiontake=param( "actiontake" );

$context=~s/\r\n/;/g;
$meaning=~s/\r\n/;/g;
$actiontake=~s/\r\n/;/g;

$logFile="/ootframetool/frame.log";
$expLogFile="/ootframetool/exp.log";
open LOG,">>$logFile";
print LOG "----------------------------------------------------------\n";
print LOG `date "+%Y-%m-%d %H:%M:%S"`;
print LOG "$id $release $errortype $domain  $applic $context $meaning $actiontake\n";


@confList=`cat /ootframetool/conf.txt`;
$viewName="";
foreach my $line (@confList)
{
	chomp($line);
	my @tmpList=split /,/,$line;
	if($tmpList[0] eq $release)
	{
		$viewName=$tmpList[1];
	}
}
print LOG $viewName . "\n";

$tmpDicoDoc="/ootframetool/OOTDico_customerDoc.properties";
$tmpDico="/ootframetool/OOTDico.properties";
if(! -e $tmpDicoDoc)
{
	`cd /view/$viewName/vob/OOT_common_srv/src/dictionary/Out`;
	`cp /view/$viewName/vob/OOT_common_srv/src/dictionary/Out/OOTDico_customerDoc.properties /ootframetool`;
	`cp /view/$viewName/vob/OOT_common_srv/src/dictionary/Out/OOTDico.properties /ootframetool`;
	`chmod 777 /ootframetool/*.properties`;
	updateDico();
	updateDoc();
	updateSuccess();

	printHtml("Success, Update Done.");
}
else
{
	isBusy();
	printHtml("Error, Operation is busy, pls retry later.");
}


close(LOG);

###################
#sub
###################
sub updateSuccess
{
	`echo "-------------------------------------------------------">>$expLogFile`;
	`date "+%Y-%m-%d %H:%M:%S">>$expLogFile`;
	`/ootframetool/frame.exp $viewName >>$expLogFile 2>&1`;
	
	`rm -f $tmpDico`;
	`rm -f $tmpDicoDoc`;
}
sub isBusy
{
	`echo "-------------------------------------------------------">>$expLogFile`;
	`date "+%Y-%m-%d %H:%M:%S">>$expLogFile`;
	`echo "Error, Operation is busy, pls retry later.">>$expLogFile`;
}
sub printHtml
{
	my $msg=shift;
	print header(), start_html( "OOT Frame Tool" ),h1("Add New ID Release=" . $release . " : " . $id);
	print br();
	print br();
	print h1($msg);

	print hr(), end_html();
}
sub updateDico
{
	my @lines=`cat $tmpDico`;
	my $target="IDL\\:ccc.com/tt/FrameId\\:1.0#" . $id . " = " . $context;
	my $search=":1.0#" . $id . " ";
	if($errortype eq "ErrorId")
	{
		$target="OOTException#" . $id . " = " . $context;
		$search="OOTException#" . $id . " ";
	}
	open OUT,">$tmpDico" || die "can not write tmpDico";
	my $tmpDomain="";
	my $find=0;
	for(my $i=0;$i<=$#lines;$i++)
	{
		chomp($lines[$i]);
		if($lines[$i]=~/^#---/ && $lines[$i]=~/Domain:/)
		{
			my @tmpList=split / /,$lines[$i];
			$tmp=$tmpList[2];
			if(!$find && ($tmpDomain eq $domain) && ($tmp ne $domain))
			{
				print OUT $target . "\n";
			}
			$tmpDomain=$tmp;
		}
		elsif($lines[$i]=~/$search/)
		{
			$lines[$i]=$target;
			$find=1;
		}
		
		print OUT $lines[$i] . "\n";
	}
	close(OUT);
}

sub updateDoc
{
	my @lines=`cat $tmpDicoDoc`;
	my $target=join(" [=] ","IDL\\:ccc.com/tt/FrameId\\:1.0#" . $id,$context,$meaning,$actiontake,$applic,"NOLOCK");
	my $search=":1.0#" . $id . " ";
	if($errortype eq "ErrorId")
	{
		$target=join(" [=] ","OOTException#" . $id,$context,$meaning,$actiontake,$applic,"NOLOCK");
		$search="OOTException#" . $id . " ";
	}
	open OUT,">$tmpDicoDoc" || die "can not write tmpDico";
	my $tmpDomain="";
	my $find=0;
	for(my $i=0;$i<=$#lines;$i++)
	{
		chomp($lines[$i]);
		if($lines[$i]=~/^#---/ && $lines[$i]=~/Domain:/)
		{
			my @tmpList=split / /,$lines[$i];
			$tmp=$tmpList[2];
			if(!$find && ($tmpDomain eq $domain) && ($tmp ne $domain))
			{
				print OUT $target . "\n";
			}
			$tmpDomain=$tmp;
		}
		elsif($lines[$i]=~/$search/)
		{
			$lines[$i]=$target;
			$find=1;
		}
		
		print OUT $lines[$i] . "\n";
	}
	close(OUT);
}

Perl的变量基本上有三种即纯量变量(ScaiarVariable)、数组(Array)、关联数组(Associative array),而以下是这些变量的使用方法:

　　一、纯量变量(Scalar Variables)的用法
　　在Perl语言中变量的使用不像在C语言中还要事先宣告,在使用纯量变量的时候要先加上$这个符号,要注意的是如果指定的纯量变量是一个字符串的话,就要加上""这个双引号符号了。如果是一个数值的话,就不用加上""这个符号了。以下是一些范例：
$Strl=www"；	#将www这个字符串指定给$Strl这个纯量变量;
$str2="cgi";	#将cgi这个字符串指定给$str2这个纯量变量;
$str3=$strl.$str2;	#.就是把两个字符串连起来,所以 $str3="wwwc20";
$int=5;	#将5这个数字指定给$int这个纯量变量;
$int=3+2;	#此时$int=5;
$int=3*2;	#此时$int=6;
$int=l0;$int++;	#此时$int=10+l=11;
$int=l0,$int+=5;	#此时$int=10+5=15;
　　二、数组(Arrays)的用法
　　在使用数组的时候要先加上@这个符号,以下是一些范例:
@namel=("tom","mary");	#将"tom","mary"这两个字符串指定给数组 @name1
@name2=@name1;	#此时的@name2=("tom","mary")
@pame3=("john",@name1);	#此时的 (name3=("john","tom","mary")
($one,@name4)=@name3;	#此时的$one="john",而 @name4=("tom"'"mary")
@namel=0;	#此时@name1为一个空数组
@int=(1,3,5,7,9);
$x=@int;	#将一个数组指定给一纯量变量,就会返回数组元
#素的个数,所以此时的$x=5
$x=$#int;	#$#这个变量会返回数组最后一个元素的index 
#所以此时$x=4
($x)=@int;	#$x等于数组@int的第一个元素的值, 
#所以此时$x=1
$b=$int[0];	#$b等于数组@int的第一个元素,所以$b=1
$C=@int[0];	#$c也是会等于数组@int的第一个元素,所以 
#$c=1,因此要呼叫数组中的值有以上两种方法
$int[0]=2;	#将2这个数值指定给数组@int的第一个元素 
#此时@int=(2,3,5,7,9);
$int[0,1]=[1,3];	#将1指定给数组@int的第一个元素,且将3指 
#定给数组@int的第二个元素的,所以 
#此时@int=(1,3,5,7,9);
@int[0,1]=@int[1,0];	#将数组@int的前两个元素交换 
#此时@int=(3,1,5,7,9)
($int[0],$int[1])	#也是将数组@int的前两个元素交换
=($int[l],$int[0]);	#此时@int=(1,3,5,7,9);
@data=@int[0,l];	#此时@date=(1,3);
$int[5]=11;	#将11这个数值指定给数组@int中第六个元素 
#此时@int=(1,3,5,7,9,11)
　　三、关联数组(Associative arrays)的用法
　　关联数组也是数组的一种,是由不同的纯量变量所组成。不过和数组不同的地方是在关联数组中的元素是由成对的key-value所组成的,也就是每一个 key都有一个相对应的值(value),这是在Perl语言中特有的语法,所以初学者对于关联数组可能会比较陌生一点,笔者会在这里作比较详细的说明。如果能够将关联数组的语法应用在CGI程序设计中,就会发现关联数组是一个很好用的语法。 
　　在使用关联数组的时候要先加上%这个符号,而关联数组的格式如下: 
　　%ARRAY=(keyl,value1,key2,value2,key3,value3...); 
　　每一个key都有一个相对应的值(value)。 
　　l.在关联数组中增加、更改一对数据: 
　　$ARRAY{key}=value; 
　　在关联数组ARRAY中加上一对key-value,要先在关联数组名称前加上$这个符号,而且key的名称要在{}符号之间,最后再指定key所对应的value值。如果在这个关联数组中已经有这个key了,就会更改这个key所对应的value。 
　　2.取出关联数组中key所对应的value: 
　　$get=$ARRAY{key}; 
　　取出在关联数组ARRAY中key所相对应的value,要先在关联数组名称前加上$这个 符号,而且key的名称要在{}符号之间,就会将key所对应的value取出来并指定给$get这个变量。 
　　3.删除一对在关联数组中的数据: 
　　delete $ARRAY{key}; 
　　 delete是Perl所提供的函数,作用是删除关联数组中的一个key以及这个key所对应的value。使用方法是在delete函数之后,再指定关联数组中要删除key的名称。以下是有关关联数组用法的一些范例:
%NAMES=〈I'"one",2'"two");
$one=$NAMES{1};	#此时$one等于"one"
$two=$NAMES{2};	#此时$two等于"two"
$NAMES{3}="third";	#增加一对key-value到关联数组NAMES中 
#此时%NAMES=(1'"one",2'"two",3'"third");
$NAMES{3}="three";	#因为在关联数组中已经有3这个key了,所以就 
#会把key为3所对应的value更改成"three" 
#此时%NAMES=(1'"one仰,2'"two",3'"three");
delete$NAMES{3};	#将关联数组中key值为3的一对key-value删除掉, 
#此时%NAMES=(1'"one",2'"two"),
@X=%NAMES;	#将关联数组NAMES指派给数组X 
#此时@X=(1'"one",2'"two");
%Y=@x;	#将数组X指派给关联数组Y 
#此时%Y=(1'"one","two");
%NAMES=();	#此时%NAMES为一个空的关联数组

Perl CGI(2) Perl CGI(3)

一个不错的应用使用Perl+CGI来做简单的用户登录验证功能