here's the CGI library that supports the previous script.
one thing i forgot to mention.. you have to name the file 'CGI.pm' for the
perl interpreter to know how to find it.
---- CGI.pm ----
#### SUPPORT PACKAGE: CGI ROUTINES ####
package CGI;
###
#
# this function allocates storage for the global data used in the
# other functions. the main reason for abstracting a bunch of
# assignments into a separate function is to make the functions
# which use the values more readable.
#
sub _init_globals {
$HEADER = "Content-type: text/html\n\n";
@ERR_METHOD = (
"Method",
"The input method",
qq("$main::ENV{'REQUEST_METHOD'}"),
"is not supported by this script."
);
}
###
#
# this function sets up a lookup table which maps x-encoded
# character codes to the corresponding ASCII characters. at the
# moment, it only maps the standard printing characters to the
# correct values.. anything else is mapped to a space.
#
sub _init_LUT {
for $i (0..255) {
$s = sprintf ("%02x", $i);
$LUT{"\L$s"} = " ";
}
$sp = unpack 'c', ' ';
$z = unpack 'c', 'z';
for $i ($sp..$z) {
$s = sprintf ("%02x", $i);
$LUT{"\L$s"} = pack "C", $i;
}
$LUT_READY = 1;
}
###
#
# this function takes a string of x-encoded data as input and uses
# the lookup table (configured above) to turn it into straight
# ASCII.
#
sub clean {
my $data = shift;
if ( ! $LUT_READY ) {
&_init_LUT;
}
$data =~ s/\+/ /g;
my @parts = $data =~ /%(..)/g;
my %uniq = map (($_,1), @parts);
for $item (keys %uniq) {
$data =~ s/%$item/$LUT{"\L$item"}/ig;
}
return ($data);
}
###
#
# this function checks the request method to make sure it matches
# the script's preference. this isn't as flexible as reading any
# input whatsoever, but it's more disciplined.
#
sub ck_method {
my $method = shift;
if ($main::ENV{'REQUEST_METHOD'} ne $method) {
&error (@ERR_METHOD);
}
}
###
#
# this function takes a string of x-encoded data as its input, and
# returns a reference to a hash of decoded name/value pairs.
#
# for a given key, the hash actually contains a reference to an
# anonymous list, which in turn contains the data. it's a bit
# memory-intensive, but i don't expect to see large numbers of
# variables, and it's a more effective way to store things.
#
sub parse_input {
my $data = shift;
%HASH = ();
if ( ! $LUT_READY ) {
&_init_LUT;
}
my @pairs = split (/&/, $data);
for $item (@pairs) {
my ($name, $val) = split (/=/, $item);
$name = &clean ($name);
$val = &clean ($val);
my $key = $HASH{ $name };
if (ref $key) {
push @{ $key }, $val;
} else {
my $ref = [];
$ref->[0] = $val;
$HASH{ $name } = $ref;
}
}
}
###
#
# this is the main input routine. it reads standard input and
# parses what it finds into the appropriate data structures.
#
sub read_stdin {
&ck_method ('POST');
$RAW_INPUT = "";
read (STDIN, $RAW_INPUT, $main::ENV{'CONTENT_LENGTH'});
&parse_input ($RAW_INPUT);
}
###
#
# this is the main input routine. it reads standard input and
# parses what it finds into the appropriate data structures.
#
sub read_query {
&ck_method ('GET');
$RAW_INPUT = $ENV{'QUERY_STRING'};
&parse_input ($RAW_INPUT);
}
###
#
# this is an accessor function. it's used in those cases where
# the main code needs the data direct from the httpd.
#
sub get_raw_input {
return $RAW_INPUT;
}
###
#
# this is an accessor function. it returns a list of all the
# variables passed from the form.
#
sub get_names {
return (sort keys %HASH);
}
###
#
# this is an accessor function. it takes a variable name as
# input and returns a list containing the associated value(s). it
# makes the way &parse_input() stores data in the hash transparent.
#
sub get_values {
my $name = shift;
my $val = $HASH{ $name };
if (ref $val) {
return (wantarray) ? @{ $val } : join (', ', @{ $val });
} else {
return 0;
}
}
###
#
# this is a debugging function which dumps the incoming data as a
# webpage, then quits.
#
sub echo {
print $HEADER;
for $item (&get_names) {
print "<br> $item = ", get_val ($item);
}
exit (1);
}
###
#
# this is an accessor function. it takes the name of a variable
# as input and returns (efffectively) a boolean which indicates
# whether the hash contains an entry by that name. it's intended
# for use with switching variables (i.e.: checkboxes), where the
# item's actual value is irrelevant.
#
sub is_def {
my $name = shift;
return ($HASH{ $name }) ? 1 : 0;
}
###
#
# this is a utility routine which prints an error page and
# terminates the program.
#
sub error {
my $type = shift;
my $message = join ("\n", @_);
print <<__done;
Content-type: text/html
<head><title>$type Error</title></head>
<body>
<h1>510 $type Error</h1>
$message
</body>
__done
exit (1);
}
###
#
# this is a utility function which redirects the browser to
# another file.
#
sub redirect_to {
my $url = shift;
print <<__done;
Location: $url
<head><title>redirection</title></head>
<body>
The page you requested has been moved <a href="$url">here.</a>
</body>
__done
}
1;
---- EOF ----
mike stone <[EMAIL PROTECTED]> 'net geek..
been there, done that, have network, will travel.
