sub ReadParse {
local (*in) = @_ if @_;
local ($i, $key, $val);
# Read in text
if (&MethGet) {
$in = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
}
open(TRACE, "trace.txt");
@in = split(/&/,$in);
print TRACE, $in, "\n";
foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;
print TRACE, $in[$i], "\n";
# Split into key and value.
($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
print TRACE, $key, $val, "\n";
# Convert %XX from hex numbers to alphanumeric
$key =~ s/%(..)/pack("c",hex($1))/ge;
$val =~ s/%(..)/pack("c",hex($1))/ge;
print TRACE, $key, $val, "\n";
close(TRACE);
# Associate key and value
$in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
$in{$key} .= $val;
}
return length($in);
}
# PrintHeader
# Returns the magic line which tells WWW that we're an HTML document
sub PrintHeader {
return "Content-type: text/html\n\n";
}
# MethGet
# Return true if this cgi call was using the GET request, false otherwise
sub MethGet {
return ($ENV{'REQUEST_METHOD'} eq "GET");
}
# MyURL
# Returns a URL to the script
sub MyURL {
return 'http://' . $ENV{'SERVER_NAME'} . $ENV{'SCRIPT_NAME'};
}
# 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 = &MyURL;
@msg = ("Error: script $name encountered fatal error");
};
print &PrintHeader;
print "$msg[0]\n";
print "$msg[0]
\n";
foreach $i (1 .. $#msg) {
print "$msg[$i]
\n";
}
print "\n";
}
# PrintVariables
# Nicely formats variables in an associative array passed as a parameter
# And returns the HTML string.
sub PrintVariables {
local (%in) = @_;
local ($old, $out, $output);
$old = $*; $* =1;
$output .= "";
foreach $key (sort keys(%in)) {
foreach (split("\0", $in{$key})) {
($out = $_) =~ s/\n/
/g;
$output .= "- $key
- $out
";
}
}
$output .= "
";
$* = $old;
return $output;
}
# PrintVariablesShort
# Nicely formats variables in an associative array passed as a parameter
# Using one line per pair (unless value is multiline)
# And returns the HTML string.
sub PrintVariablesShort {
local (%in) = @_;
local ($old, $out, $output);
$old = $*; $* =1;
foreach $key (sort keys(%in)) {
foreach (split("\0", $in{$key})) {
($out = $_) =~ s/\n/
/g;
$output .= "$key is $out
";
}
}
$* = $old;
return $output;
}
1; #return true
# ======================================================
# This subroutine take a single input parameter and uses
# it as the and the first level header.
# ======================================================
sub html_header {
$document_title = $_[0];
print "Content-type: text/html\n\n";
print "<HTML>\n";
print "<HEAD>\n";
print "<TITLE>$document_title\n";
print "\n";
print "\n";
print "$document_title
\n";
print "\n";
}
# ======================================================
# This subroutine finishes off the HTML stream.
# ======================================================
sub html_trailer{
print "\n";
print "