#!/usr/bin/perl
# perl_form - a simple illustration of forms and Perl CGI
# Adapted from perl_form by Stephen Bloch, 12/96
print "Content-type: text/html\n\n";
print "Testing Environment Variables\n";
&ReadParse;
# print "The ResponseThe Response
";
# print "Here is the form data:";
#
# foreach $key (keys %in) {
# print "- $key: $in{$key}";
# }
# print "
\n";
print "Here are all the environment variables:";
foreach $key (keys %ENV) {
print "- $key: $ENV{$key}";
}
print "
\n";
# $filename = $ENV{"SCRIPT_NAME"};
# if ($filename) {
# print "In particular, file $filename has the following status information:";
# print "
\n";
# ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
# $blksize,$blocks) = stat($filename);
# foreach $key (dev,ino,mode,nlink,uid,gid,rdev,size,atime,mtime,ctime,
# blksize,blocks) {
# print "- $key: $$key";
# }
# print "
\n";
#
# print "In other words,
";
# $atime_string = localtime($atime);
# print "atime = $atime_string
";
# $mtime_string = localtime($mtime);
# print "mtime = $mtime_string
";
# $ctime_string = localtime($ctime);
# print "ctime = $ctime_string
";
# }
# else {
# print "No SCRIPT_NAME.\n";
# }
print "\n";
# Adapted from cgi-lib.pl by S.E.Brenner@bioc.cam.ac.uk
# Copyright 1994 Steven E. Brenner
sub ReadParse {
local (*in) = @_ if @_;
local ($i, $key, $val);
if ( $ENV{'REQUEST_METHOD'} eq "GET" ) {
$in = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
} else {
# Added for command line debugging
# Supply name/value form data as a command line argument
# Format: name1=value1\&name2=value2\&...
# (need to escape & for shell)
# Find the first argument that's not a switch (-)
$in = ( grep( !/^-/, @ARGV )) [0];
$in =~ s/\\&/&/g;
}
@in = split(/&/,$in);
foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;
# Split into key and value.
($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
# Convert %XX from hex numbers to alphanumeric
$key =~ s/%(..)/pack("c",hex($1))/ge;
$val =~ s/%(..)/pack("c",hex($1))/ge;
# Associate key and value. \0 is the multiple separator
$in{$key} .= "\0" if (defined($in{$key}));
$in{$key} .= $val;
}
return length($in);
}