📄 cgi-lib.pl
字号:
}
$head .= substr($buf, 0, $lpos+2);
push (@in, $head);
@heads = split("\r\n", $head);
($cd) = grep (/^\s*Content-Disposition:/i, @heads);
($ct) = grep (/^\s*Content-Type:/i, @heads);
($name) = $cd =~ /\bname="([^"]+)"/i; #";
($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;
($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str
($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;
$incfn{$name} .= (defined $in{$name} ? "\0" : "") .
(defined $fname ? $fname : "");
($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #";
($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype;
$inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype;
if ($writefiles && defined $fname) {
$ser++;
$fn = $writefiles . ".$$.$ser";
open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");
binmode (FILE); # write files accurately
}
substr($buf, 0, $lpos+4) = '';
undef $fname;
undef $ctype;
}
1;
END_MULTIPART
if ($errflag) {
local ($errmsg, $value);
$errmsg = $@ || $errflag;
foreach $value (values %insfn) {
unlink(split("\0",$value));
}
&CgiDie($errmsg);
} else {
# everything's ok.
}
} else {
&CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n");
}
# no-ops to avoid warnings
$insfn = $insfn;
$incfn = $incfn;
$inct = $inct;
$^W = $perlwarn;
return ($errflag ? undef : scalar(@in));
}
# PrintHeader
# Returns the magic line which tells WWW that we're an HTML document
sub PrintHeader {
return "Content-type: text/html\n\n";
}
# HtmlTop
# Returns the <head> of a document and the beginning of the body
# with the title and a body <h1> header as specified by the parameter
sub HtmlTop
{
local ($title) = @_;
return <<END_OF_TEXT;
<html>
<head>
<title>$title</title>
</head>
<body>
<h1>$title</h1>
END_OF_TEXT
}
# HtmlBot
# Returns the </body>, </html> codes for the bottom of every HTML page
sub HtmlBot
{
return "</body>\n</html>\n";
}
# SplitParam
# Splits a multi-valued parameter into a list of the constituent parameters
sub SplitParam
{
local ($param) = @_;
local (@params) = split ("\0", $param);
return (wantarray ? @params : $params[0]);
}
# MethGet
# Return true if this cgi call was using the GET request, false otherwise
sub MethGet {
return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "GET");
}
# MethPost
# Return true if this cgi call was using the POST request, false otherwise
sub MethPost {
return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "POST");
}
# MyBaseUrl
# Returns the base URL to the script (i.e., no extra path or query string)
sub MyBaseUrl {
local ($ret, $perlwarn);
$perlwarn = $^W; $^W = 0;
$ret = 'http://' . $ENV{'SERVER_NAME'} .
($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
$ENV{'SCRIPT_NAME'};
$^W = $perlwarn;
return $ret;
}
# MyFullUrl
# Returns the full URL to the script (i.e., with extra path or query string)
sub MyFullUrl {
local ($ret, $perlwarn);
$perlwarn = $^W; $^W = 0;
$ret = 'http://' . $ENV{'SERVER_NAME'} .
($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
$ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} .
(length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '');
$^W = $perlwarn;
return $ret;
}
# MyURL
# Returns the base URL to the script (i.e., no extra path or query string)
# This is obsolete and will be removed in later versions
sub MyURL {
return &MyBaseUrl;
}
# CgiError
# Prints out an error message which which containes appropriate headers,
# markup, etcetera.
# Parameters:
# If no parameters, gives a generic error message
# Otherwise, the first parameter will be the title and the rest will
# be given as different paragraphs of the body
sub CgiError {
local (@msg) = @_;
local ($i,$name);
if (!@msg) {
$name = &MyFullUrl;
@msg = ("Error: script $name encountered fatal error\n");
};
if (!$cgi_lib'headerout) { #')
print &PrintHeader;
print "<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n";
}
print "<h1>$msg[0]</h1>\n";
foreach $i (1 .. $#msg) {
print "<p>$msg[$i]</p>\n";
}
$cgi_lib'headerout++;
}
# CgiDie
# Identical to CgiError, but also quits with the passed error message.
sub CgiDie {
local (@msg) = @_;
&CgiError (@msg);
die @msg;
}
# PrintVariables
# Nicely formats variables. Three calling options:
# A non-null associative array - prints the items in that array
# A type-glob - prints the items in the associated assoc array
# nothing - defaults to use %in
# Typical use: &PrintVariables()
sub PrintVariables {
local (*in) = @_ if @_ == 1;
local (%in) = @_ if @_ > 1;
local ($out, $key, $output);
$output = "\n<dl compact>\n";
foreach $key (sort keys(%in)) {
foreach (split("\0", $in{$key})) {
($out = $_) =~ s/\n/<br>\n/g;
$output .= "<dt><b>$key</b>\n <dd>:<i>$out</i>:<br>\n";
}
}
$output .= "</dl>\n";
return $output;
}
# PrintEnv
# Nicely formats all environment variables and returns HTML string
sub PrintEnv {
&PrintVariables(*ENV);
}
# The following lines exist only to avoid warning messages
$cgi_lib'writefiles = $cgi_lib'writefiles;
$cgi_lib'bufsize = $cgi_lib'bufsize ;
$cgi_lib'maxbound = $cgi_lib'maxbound;
$cgi_lib'version = $cgi_lib'version;
$cgi_lib'filepre = $cgi_lib'filepre;
1; #return true
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -