第四步：编写代码
为了节省时间，我们可以使用基本的Perl 脚本模板 ，把迷你邮件程序这篇教程里使用一些例程剪贴、粘贴到新程序里。
Perl脚本模板
#!/usr/local/bin/perl
# ----------------------------------------------------------------------------
# Program Name v1.0
# Copyright (C) 1998 Dave Edis, All Rights Reserved
# http://www.edisdigital.com/
# ----------------------------------------------------------------------------
$SIG = $SIG = &HTML_Error; # 显示错误信息
# 查找当前cgidir目录的路径
if (=~m#^(.*)#){ $cgidir = ""; } # 在win/dos平台下，目录是C:dir
elsif (=~m#^(.*)/# ){ $cgidir = ""; } # 在Unix平台下，目录是 /usr/bin/
else {`pwd` =~ /(.*)/; $cgidir = ""; } # 或者使用 `pwd` 作为 cgidir目录
$cgiurl = $ENV; # 脚本的web 路径
$filelock = "$cgidir/filelock"; # 文件锁定目录
$|++; # 不缓冲输出
### 数据文件
$datafile = "$cgidir/file.dat";
### 变量
$var = "value";
require "$cgidir/edis-lib.cgi"; # 装入 Edis 库例程
# ----------------------------------------------------------------------------
# 主程序 : 测试条件，给出命令
# ----------------------------------------------------------------------------
print "Content-type: text/html
"; # 输出内容头信息
%in = &ReadForm; # 读取 CGI 表单输入
if ($in) { ⋐ } #
elsif ($in) { ⋐ } #
else { ⋐ } # 缺省动作
exit;
# ----------------------------------------------------------------------------
# 子程序 : 子例程说明
# ----------------------------------------------------------------------------
sub Sub {
}
# ----------------------------------------------------------------------------
# HTML_Error : 显示HTML出错信息并退出
# ----------------------------------------------------------------------------
sub HTML_Error {
print "Content-type: text/html
";
&FileUnlock($filelock); # 文件解除锁定
print "@_";
exit;
}
# ----------------------------------------------------------------------------
# Programming by Dave Edis
新的子例程
要加入的新的子例程是：
这两个例程由cookie例程调用，确保在cookie里的特殊字符－比如等号，逗号等－不会被错误地解释成cookie数据的分隔符。
最后，我们要建立一个“登录”例程，用来检查口令；还要建立一个“退出登录”例程，在用户退出应用程序时调用退出例程来清除cookie口令。这样，用户要想再次打开应用程序，就需要再次输入口令。
这里是完整的库文件。
#!/usr/local/bin/perl
# ----------------------------------------------------------------------------
# pass-lib.cgi v1.0 - Password Protection Perl Library
# Copyright (C) 1998 Dave Edis, All Rights Reserved
# http://www.edisdigital.com/
# ----------------------------------------------------------------------------
package Passlib;
# 查找当前目录路路径
if (=~m#^(.*)#){ $cgidir = ""; } # 在win/dos平台下，cgidir目录在C:dir
elsif (=~m#^(.*)/# ){ $cgidir = ""; } # 在unix平台下，cgidir目录在 /usr/bin/
else {`pwd` =~ /(.*)/; $cgidir = ""; } # 或者使用unix 的`pwd` 作为 cgidir目录
$cgiurl = $ENV; # 脚本的web路径
### 用途
# require "$cgidir/pass-lib.cgi"; # 装入口令库例程
# &Passlib::Login("magic"); # 检查登录口令
# &Passlib::Logoff; # 清空口令cookie
# ----------------------------------------------------------------------------
# 主程序：测试条件，给出命令
# ----------------------------------------------------------------------------
my(%in) = &ReadForm; # 读取表单数据
my(%ck) = &ReadCookie; # 读取Cookie数据
# ----------------------------------------------------------------------------
# Login : 检测用户是否拥有正确的登录口令
# 用法 : &Login("password");
# ----------------------------------------------------------------------------
sub Login {
my($pw) = $_[0]; # 设置口令值
unless ($pw) { return; } # 如果没有口令，返回
### 登录表单子例和
### 这些例程检测用户在登录页输入的口令是否正确
if ($in && $in eq $pw) { # 输入的口令正确
&SetCookie("passlib_pw","$in"); # 设置口令cookie
return; # 继续执行程序
}
elsif ($in && $in ne $pw) { # 输入的口令不正确
print "Content-type: text/html
"; # 输出内容头信息
print &Template("$cgidir/_passlib_invalid.html"); # 输出无效登录页
exit; # 退出
}
### COOKIE 子例程
### 这些例程检测在用户口令cookie里保存的口令是否正确
elsif ($ck && $ck eq $pw) { # cookie口令正确
return; # 继续执行程序
}
else { # cookie 口令正确或者不存在
print "Content-type: text/html
"; # 输出内容头信息
print &Template("$cgidir/_passlib_login.html"); # 输出登录页
exit; # 退出
}
}
# ----------------------------------------------------------------------------
# Logoff : 清除保存在用户计算机上的口令cookie
# 用法: &Logoff;
# ----------------------------------------------------------------------------
sub Logoff {
&SetCookie("passlib_pw",""); # 清空口令cookie
}
# ------------------------------------------------------------------------
# ReadForm : 解析由表单GET 或POST来的输入数据，返回表单字段名、字段值的混合对
#
# 用法 : %in = &ReadForm;
# ------------------------------------------------------------------------
sub ReadForm {
my($name,$value,$pair,@pairs,$buffer,%hash); # 把变量本地化
# 把 GET 或 POST 表单读入缓冲变量 $buffer
if ($ENV eq 'POST') { read(STDIN, $buffer, $ENV); }
elsif ($ENV eq 'GET') { $buffer = $ENV; }
@pairs = split(/&/, $buffer); # 分解字段名/字段值组合
foreach $pair (@pairs) { # foreach 循环把组合
($name, $value) = split(/=/, $pair); # 分触到到字段名变量 $name 和字段值变量 $value
$value =~ tr/+/ /; # 用 " "替换"+"
$value =~ s/%([A-F0-9])/pack("C", hex())/egi; # 用字符代码%hex 16进制值
$hash = $value;
}
### 把图片形式的提交按钮表单名称($var.x & $var.y) 转回正常形式($var)
foreach (keys %hash) { if (/^(.*)(.x|.y)$/) { $in{} = "true"; }}
return %hash;
}
# ------------------------------------------------------------------------
# Template : 打开模板文件，翻译变量，返回实际内容
#
# 用法 : print &Template("$cgidir/filename.html");
# ------------------------------------------------------------------------
sub Template {
local(*FILE); # 文件句柄
local($file); # 文件路径
local($HTML); # HTML 数据
$file = $_[0] || die "Template : No template file specified
";
open(FILE, ") { $HTML .= $_; }
close(FILE);
$HTML =~ s/$(w+)/${}/g;
return $HTML;
}
# ----------------------------------------------------------------------------
# Cookie : 设置/读取浏览器cookies的Perl例程。
# : Cookies 的尺寸最大为4K，每个主机最多只能发送20个cookie。
#
# 用法 : &SetCookie("name","value");
# : %cookie = &ReadCookie;
# ----------------------------------------------------------------------------
sub SetCookie {
my($cookie_info);
my($name,$value,$exp,$path,$domain,$secure) = @_;
# $name - cookie名称 (比如: username)
# $value - cookie 值 (比如: "joe user")
# $exp –到期日期，在指定日期cookie将被删除。格式为：Wdy, DD-Mon-YYYY HH:MM:SS GMT
# $path – 只有访问这个路径时，才发送Cookie (比如: /);
# $domain – 只有访问这个域 时，才发送Cookie (比如: .edis.org)
# $secure – 只有使用安全的https连接时，才发送Cookie
unless (defined $name) { die("SetCookie : Cookie name must be specified
"); }
if ($exp && $exp !~ /^[A-Z], dd-[A-Z]-d dd:dd:dd GMT$/i) { die("SetCookie : Exp Dat format isn't: Wdy, DD-Mon-YYYY HH:MM:SS GMT
"); }
if ($name) { $name = &URL_Encode($name); }
if ($value) { $value = &URL_Encode($value); }
if ($exp) { $cookie_info .= "expires=$exp; "; }
if ($path) { $cookie_info .= "path=$path; "; }
if ($domain) { $cookie_info .= "domain=$domain; "; }
if ($secure) { $cookie_info .= "secure; "; }
print "Set-Cookie: $name=$value; $cookie_info
";
}
sub ReadCookie {
my($cookie,$name,$value,%jar);
foreach $cookie (split(/; /,$ENV)) { # 对于每个发送的cookie ($name,$value) = split(/=/,$cookie); # 都分解到字段名/字段值组合里
foreach($name,$value) { $_ = &URL_Decode($_); } # URL 解码字符串
$jar=$value; # 并放在%jar 组合里
}
return %jar; # 返回 %jar 组合
}
# ----------------------------------------------------------------------------
# URL : URL 编码/解码的Perl例程。 URL 编码是一个通用的编码方案
# 凡是A-Za-z0-9+*.@_- 以外的字符都用三个字符代替，格式是
# 一个"%" 号，后面跟着两个16进制数。
#
# 用法 : $URL_encoded = &URL_Encode("$plaintext");
# : $plaintext = &URL_Decode("$URL_encoded");
# ----------------------------------------------------------------------------
sub URL_Encode {
my($text) = $_[0]; # 要进行URL编码的文本
$text =~ tr/ /+/; # 用"+"代替 " "
$text =~ s/[^A-Za-z0-9+*.@_-]/ # 用%号接16进制的形式
uc sprintf("%%%02x",ord($&))/egx; # 替换不常用字符
return $text; # 返回进行了URL编码处理的文本
}
sub URL_Decode {
my($text) = $_[0]; # 要进行URL解的URL编码文本
$text =~ tr/+/ /; # 用"" 代替 "+ "
$text =~ s/%([A-F0-9])/pack("C", hex())/egi; # 用解码后的普通文本代替%号接16进制的字符
return $text; # 返回解码后的普通文本
}
1; # 必须返回正数值
# ----------------------------------------------------------------------------
# Programming by Dave Edis
把所有部件装配起来
完成以上步骤之后，全部剩下要做的是：把口令保护功能加到程序里。下面是一个简单的脚本“Hello World.”，可以演示需要做的工作：
<xmp> #!/usr/local/bin/perl print "Content-type: text/html "; print "Hello World"; </xmp>
要把口令保护加到这个程序里，只要增加两行代码。这两行代码需要插到所有打印内容头信息的语句之前，否则它们会被打印两次之后才结束。
<xmp>
#!/usr/local/bin/perl
require "pass-lib.pl";
&Passlib::Login("magic");
print "Content-type: text/html
";
print "Hello World";
</xmp>
这个程序的口令是“magic.”
我们提供了所有相关文件的ZIP压缩包，请单击这里下载。
