#---------------------------------------------------------------------
# GetFormData
#---------------------------------------------------------------------
# Calls GetEncodedFormData or GetMultipartFormData, depending on
# the value of CONTENT_TYPE environment variable.
#---------------------------------------------------------------------
sub GetFormData {
if ( $ENV{"CONTENT_TYPE"} eq "" ) {
return GetEncodedFormData(@_);
} elsif ( $ENV{"CONTENT_TYPE"} eq "application/x-[URL unfurl="true"]www-form-urlencoded"[/URL] ) {
return GetEncodedFormData(@_);
} elsif ( $ENV{"CONTENT_TYPE"} =~ m[multipart/form-data] ) {
return GetMultipartFormData(@_);
} else {
return 0;
}
} # GetFormData
#---------------------------------------------------------------------
# GetEncodedFormData
#---------------------------------------------------------------------
# Reads in GET or POST data and stores it RAW in $FormData.
# Converts plus signs back to spaces.
# Stores each key=value in a member of the list "@FormData".
# Stores key and value in the associative array %FormData.
# Uses null ('\0') to separate multiple selections.
#
# Returns TRUE (the length of the data) if there WAS any data.
#
# If a variable-glob parameter (e.g. *cgi_input) is passed, that name
# is used for the form data variables instead of $FormData, @FormData,
# and %FormData.
#---------------------------------------------------------------------
sub GetEncodedFormData {
local (*FormData) = @_ if @_;
my ($x, $key, $val);
# Find out method and get the form data into $FormData
if ( $ENV{"REQUEST_METHOD"} eq "GET" ) {
$FormData = $ENV{"QUERY_STRING"};
} elsif ( $ENV{"REQUEST_METHOD"} eq "POST" ) {
read(STDIN, $FormData, $ENV{"CONTENT_LENGTH"});
} else {
CgiError("$ThisPgm Script Error<br>" .
"Invalid Form Method: " . $ENV{"REQUEST_METHOD"});
}
# Split data into list (array) of key=value entries
@FormData = split(/&/, $FormData);
# Process the FormData list
foreach $x (0 .. $#FormData) {
# Convert plus signs back to spaces
$FormData[$x] =~ s/\+/ /g;
# Split into key and value (on the first equal sign found).
($key, $val) = split(/=/, $FormData[$x], 2);
# Convert %XX sequences into characters
$key =~ s/%(..)/pack("c", hex($1))/ge;
$val =~ s/%(..)/pack("c", hex($1))/ge;
# Convert hyphens in field names into underscores
$key =~ s/-/_/g;
# Replace list element with converted values
$FormData[$x] = $key . "=" . $val;
# Create associative array member
# Null value ('\0') separates multiple values
$FormData{$key} .= "\0" if (defined($FormData{$key}));
$FormData{$key} .= $val;
}
return length($FormData);
} # GetEncodedFormData
#---------------------------------------------------------------------
# GetMultipartFormData
#---------------------------------------------------------------------
# Reads in POST data from enctype=\"multipart/form-data\".
# Converts plus signs back to spaces.
# Stores key and value in the associative array %FormData.
# Uses null ('\0') to separate multiple selections.
#
# Returns TRUE (the length of the data) if there WAS any data.
#
# If a variable-glob parameter (e.g. *cgi_input) is passed, that name
# is used for the form data variables instead of %FormData.
#---------------------------------------------------------------------
sub GetMultipartFormData {
local (*FormData) = @_ if @_;
# As far as I know, you can't have GET with Multipart form data
my($boundary) = ( $ENV{"CONTENT_TYPE"} =~ m/boundary\s*=\s*([-A-Za-z0-9]+)/i);
my($varname, $filename, $type, $value, $tempfile);
my $oldrs = $/;
$/ = "\x0D\x0A";
PART: while (<STDIN>) {
# Boundary string starts a new part
last PART if /\A--$boundary--\Z/;
next PART if /\A--$boundary\x0D\x0A\Z/;
if ( /\AContent-Disposition:\s*form-data/i ) {
($varname) = /name\s*=\s*"(.*?)"/i;
($filename) = /filename\s*=\s*"(.*?)"/i;
# Convert hyphens in field name into underscores
$varname =~ s/-/_/g;
next PART;
}
if ( /\AContent-type:\s*(\S+)/i ) {
$type = $1;
next PART;
}
next PART unless /\A\s+\Z/; # blank line ends headers, starts value
# if it's a file, now's the time to open the temp file
if ( $filename ) {
# Find out which temporary directory to use
my $tempdir = FindTempDir();
# Create and open a temporary file
$tempfile = "TDS0000";
while ( -e "$tempdir/$tempfile" ) {
$tempfile++;
}
open(CGIOUT, ">$tempdir/$tempfile") ||
CgiError(qq[GetMultipartFormData could not open temp file:<br><CODE>$tempdir/$tempfile</CODE>]);
binmode CGIOUT;
$tempfile = $tempdir."/".$tempfile;
}
while (<STDIN>) {
if ( /\A--$boundary/ ) { # boundary ends this part
if ( $filename ) {
chomp $value; # remove last CRLF
$fsize += length($value);
syswrite(CGIOUT, $value, $fsize); # write last part
close CGIOUT;
$FormData{$varname} = "FILE-UPLOAD";
$FormData{'FILE-UPLOAD'}{$varname}{'filename'} = $filename;
$FormData{'FILE-UPLOAD'}{$varname}{'type'} = $type;
$FormData{'FILE-UPLOAD'}{$varname}{'tempfile'} = $tempfile;
$FormData{'FILE-UPLOAD'}{$varname}{'size'} = $fsize;
$varname = "";
$value = "";
$filename = "";
$type = "";
$tempfile = "";
$fsize = 0;
next PART;
} else {
chomp $value; # remove last CRLF
$FormData{$varname} .= "\0" if (defined($FormData{$varname}));
$FormData{$varname} .= $value;
$varname = "";
$value = "";
next PART;
}
}
if ( $filename ) {
if ( $value ) { # if not first part
$len = length($value);
$fsize += length($value);
syswrite(CGIOUT, $value, $fsize); # write previous part
}
$len = length;
$value = $_;
} else {
$value .= $_;
next;
}
}
}
$/ = $oldrs;
return $ENV{'CONTENT_LENGTH'};
} # GetMultipartFormData
#---------------------------------------------------------------------
# FindTempDir
#---------------------------------------------------------------------
# Attempt to find a usable temporary directory
#---------------------------------------------------------------------
sub FindTempDir {
unless ($TMPDIRECTORY) {
@TEMPDIRS = (
"/tmp",
"/usr/tmp",
"/var/tmp",
"/temp",
);
unshift(@TEMPDIRS, $ENV{'TMPDIR'}) if $ENV{'TMPDIR'};
unshift(@TEMPDIRS, $ENV{'TEMP'}) if $ENV{'TEMP'};
foreach $TEMPDIR (@TEMPDIRS) {
if ( -d $TEMPDIR && -w $TEMPDIR ) {
return $TEMPDIR;
}
}
return "";
}
return $TMPDIRECTORY;
} # FindTempDir
)