while (($lpos = index($buf, "\r\n\r\n")) == -1) { $head .= substr($buf, 0, $bufsize); $buf = substr($buf, $bufsize); $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf); $errflag = (read(STDIN, $buf, $amt, $maxbound) != $amt); $left -= $amt; } $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" : "") . $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"); } substr($buf, 0, $lpos+4) = ''; undef $fname; undef $ctype; } 1; END_MULTIPART &CgiDie($@) if $errflag; } else { &CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n"); } $^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 of a document and the beginning of the body # with the title and a body

header as specified by the parameter sub HtmlTop { local ($title) = @_; return < $title
$title
END_OF_TEXT } # HtmlBot # Returns the , codes for the bottom of every HTML page sub HtmlBot { return "\n\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