<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=Content-Type content="text/html; charset=iso-8859-1">
<META content="MSHTML 6.00.6000.16705" name=GENERATOR>
<STYLE></STYLE>
</HEAD>
<BODY>
<DIV><FONT face=Arial size=2>> how can I write perl raw code to get all the
HTTP post params as </FONT></DIV>
<DIV><FONT face=Arial size=2>> a whole string on Apache (mod_perl 1.29)? Any
%ENV?<BR></DIV>
<DIV><FONT face=Arial size=2>See example script below. It makes use
of cgi-lib which is in the listing below.</FONT></DIV>
<DIV> </DIV>
<DIV>Sorry for the long post.</DIV>
<DIV></FONT><FONT face=Arial size=2></FONT><BR><FONT face=Arial size=2>Indy
Singh<BR>IndigoSTAR Software -- </FONT><A href="http://www.indigostar.com"><FONT
face=Arial size=2>www.indigostar.com</FONT></A></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>#!/usr/bin/perl</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># Test cgi script, using cgi-lib<BR># prints out
the date, and environment variables</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>$| = 1;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>print PrintHeader();<BR>print HtmlTop("Test CGI
output");<BR>print "<HR>\n";<BR>$date = localtime(time());<BR>print
"Testcgi.pl 1.1 at $date<BR>\n";<BR>print "ARGS = ", join(" ", @ARGV),
"<BR>\n";<BR>$cwd = $^O eq "MSWin32" ? Win32::GetCwd() . "\n" :
`pwd`;<BR>chop $cwd;<BR>print "Current directory: $cwd<BR>\n";<BR>print
"<HR>\n";</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2>print "<H2>Environment
variables</H2>\n";<BR>#print PrintEnv();<BR>print
"<pre>";<BR>foreach (sort keys %ENV) { # conver form vars to
$variables<BR> print "set $_=$ENV{$_}\n";<BR>}<BR>print
"</pre>";<BR>print "<HR>\n";</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># cgi-lib hangs on multipart/form-data<BR>if
($ENV{'CONTENT_TYPE'} =~ m|^multipart/form-data|) {<BR> print
"<H2>Multipart/form-data not supported<br>Raw
Data:</H2>\n";<BR> if ($ENV{CONTENT_LENGTH})
{<BR> $length =
$ENV{CONTENT_LENGTH};<BR> read(STDIN,
$data, $length);<BR> #$data .= $_
while (<STDIN>);<BR> print
"<pre>data=\n$data\n</pre>";<BR>
}<BR> print "<HR>\n";<BR>}<BR>else
{<BR> ReadParse();<BR> print "<H2>Form
Fields</H2>\n";<BR> print
PrintVariables();<BR> print "<HR>\n";<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>print HtmlBot();<BR>exit;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># Perl Routines to Manipulate CGI input<BR>#
</FONT><A href="mailto:S.E.Brenner@bioc.cam.ac.uk"><FONT face=Arial
size=2>S.E.Brenner@bioc.cam.ac.uk</FONT></A><BR><FONT face=Arial size=2># $Id:
cgi-lib.pl,v 2.8 1996/03/30 01:36:33 brenner Rel $<BR>#<BR># Copyright (c) 1996
Steven E. Brenner <BR># Unpublished work.<BR># Permission granted to use
and modify this library so long as the<BR># copyright above is maintained,
modifications are documented, and<BR># credit is given for any use of the
library.<BR>#<BR># Thanks are due to many people for reporting bugs and
suggestions<BR># especially Meng Weng Wong, Maki Watanabe, Bo Frese
Rasmussen,<BR># Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason
Mathews</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># For more information,
see:<BR># </FONT><A
href="http://www.bio.cam.ac.uk/cgi-lib/"><FONT face=Arial
size=2>http://www.bio.cam.ac.uk/cgi-lib/</FONT></A></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>BEGIN {<BR>($cgi_lib'version = '$Revision: 2.8 $')
=~ s/[^.\d]//g;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># Parameters affecting cgi-lib behavior<BR>#
User-configurable parameters affecting file
upload.<BR>$cgi_lib'maxdata = 1500000; #
maximum bytes to accept via POST - 2^17<BR>$cgi_lib'writefiles
= 0; # directory to which
to write files,
or<BR>
# 0 if files should not be written<BR>$cgi_lib'filepre =
"cgi-lib"; # Prefix of file names, in directory above</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># Do not change the following parameters unless you
have special reasons<BR>$cgi_lib'bufsize = 8192; #
default buffer size when reading multipart<BR>$cgi_lib'maxbound =
100; # maximum boundary length to be
encounterd<BR>$cgi_lib'headerout = 0; #
indicates whether the header has been printed<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># ReadParse<BR># Reads in GET or POST data,
converts it to unescaped text, and puts<BR># key/value pairs in %in, using "\0"
to separate multiple selections</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># Returns >0 if there was input, 0 if there was
no input <BR># undef indicates some failure.</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># Now that cgi scripts can be put in the normal
file space, it is useful<BR># to combine both the form and the script in one
place. If no parameters<BR># are given (i.e., ReadParse returns FALSE),
then a form could be output.</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># If a reference to a hash is given, then the data
will be stored in that<BR># hash, but the data from $in and @in will become
inaccessable.<BR># If a variable-glob (e.g., *cgi_input) is the first parameter
to ReadParse,<BR># information is stored there, rather than in $in, @in, and
%in.<BR># Second, third, and fourth parameters fill associative arrays analagous
to<BR># %in with data relevant to file uploads. </FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># If no method is given, the script will process
both command-line arguments<BR># of the form: name=value and any text that is in
$ENV{'QUERY_STRING'}<BR># This is intended to aid debugging and may be changed
in future releases</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub ReadParse {<BR> local (*in) = shift if
@_; # CGI input<BR> local
(*incfn,
# Client's filename (may not be provided)<BR>
*inct,
# Client's content-type (may not be provided)<BR> *insfn) =
@_; # Server's filename
(for spooled files)<BR> local ($len, $type, $meth, $errflag, $cmdflag,
$perlwarn);<BR> <BR> # Disable warnings as this code deliberately
uses local and environment<BR> # variables which are preset to undef
(i.e., not explicitly initialized)<BR> $perlwarn = $^W;<BR> $^W =
0;<BR> <BR> # Get several useful env variables<BR> $type =
$ENV{'CONTENT_TYPE'};<BR> $len = $ENV{'CONTENT_LENGTH'};<BR>
$meth = $ENV{'REQUEST_METHOD'};<BR> <BR> if ($len >
$cgi_lib'maxdata) { #'<BR>
&CgiDie("cgi-lib.pl: Request to receive too much data: $len
bytes\n");<BR> }<BR> <BR> if (!defined $meth || $meth eq '' ||
$meth eq 'GET' || <BR> $type eq
'application/x-www-form-urlencoded') {<BR> local ($key, $val,
$i);<BR> <BR> # Read in text<BR> if
(!defined $meth || $meth eq '') {<BR> $in =
$ENV{'QUERY_STRING'};<BR> $cmdflag = 1; #
also use command-line options<BR> } elsif($meth eq 'GET' ||
$meth eq 'HEAD') {<BR> $in =
$ENV{'QUERY_STRING'};<BR> } elsif ($meth eq 'POST')
{<BR> $errflag = (read(STDIN, $in,
$len) != $len);<BR> } else {<BR>
&CgiDie("cgi-lib.pl: Unknown request method:
$meth\n");<BR> }</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> @in = split(/[&;]/,$in);
<BR> push(@in, @ARGV) if $cmdflag; # add command-line
parameters</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> foreach $i (0 .. $#in)
{<BR> # Convert plus to
space<BR> $in[$i] =~ s/\+/ /g;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> # Split into key and
value. <BR> ($key, $val) =
split(/=/,$in[$i],2); # splits on the first =.</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> # Convert %XX from
hex numbers to alphanumeric<BR> $key =~
s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;<BR> $val
=~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> # Associate key and
value<BR> $in{$key} .= "\0" if
(defined($in{$key})); # \0 is the multiple
separator<BR> $in{$key} .=
$val;<BR> }</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> } elsif ($ENV{'CONTENT_TYPE'} =~
m#^multipart/form-data#) {<BR> # for efficiency, compile
multipart code only if needed<BR>########################$errflag = !(eval
<<'END_MULTIPART');</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> local ($buf, $boundary, $head,
@heads, $cd, $ct, $fname, $ctype, $blen);<BR> local ($bpos,
$lpos, $left, $amt, $fn, $ser);<BR> local ($bufsize,
$maxbound, $writefiles) = <BR> ($cgi_lib'bufsize,
$cgi_lib'maxbound, $cgi_lib'writefiles);</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2> # The following lines exist
solely to eliminate spurious warning messages<BR> $buf = '';
</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> ($boundary) = $type =~
/boundary="([^"]+)"/; #"; # find boundary<BR>
($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;<BR>
&CgiDie ("Boundary not provided") unless $boundary;<BR>
$boundary = "--" . $boundary;<BR> $blen = length
($boundary);</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> if ($ENV{'REQUEST_METHOD'} ne
'POST') {<BR> &CgiDie("Invalid request method
for multipart/form-data: $meth\n");<BR> }</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> if ($writefiles)
{<BR>
local($me);<BR> stat
($writefiles);<BR> $writefiles = "/tmp"
unless -d _ && -r _ && -w
_;<BR> # ($me) = $0 =~
m#([^/]*)$#;<BR> $writefiles .=
"/$cgi_lib'filepre"; <BR> }</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> # read in the data and split
into parts:<BR> # put headers in @in and data in
%in<BR> # General algorithm:<BR>
# There are two dividers: the border and the '\r\n\r\n'
between<BR> # header and body. Iterate between searching
for these<BR> # Retain a buffer of
size(bufsize+maxbound); the latter part is<BR> # to ensure
that dividers don't get lost by wrapping between two bufs<BR>
# Look for a divider in the current batch. If not found,
then<BR> # save all of bufsize, move the maxbound extra buffer
to the front of<BR> # the buffer, and read in a new bufsize
bytes. If a divider is found,<BR> # save everything up
to the divider. Then empty the buffer of everything<BR>
# up to the end of the divider. Refill buffer to
bufsize+maxbound<BR> # Note slightly odd
organization. Code before BODY: really goes with<BR> #
code following HEAD:, but is put first to 'pre-fill' buffers.
BODY:<BR> # is placed before HEAD: because we first need to
discard any 'preface,'<BR> # which would be analagous to a
body without a preceeding head.</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> $left = $len;<BR>
PART: # find each part of the multi-part while reading
data<BR> while (1) {<BR> last
PART if $errflag;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> $amt = ($left >
$bufsize+$maxbound-length($buf) <BR> ?
$bufsize+$maxbound-length($buf): $left);<BR>
$errflag = (read(STDIN, $buf, $amt, length($buf)) !=
$amt);<BR> $left -= $amt;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> $in{$name} .= "\0"
if defined $in{$name}; <BR> $in{$name} .= $fn if
$fn;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>
$name=~/([-\w]+)/; # This allows $insfn{$name} to be
untainted<BR> if (defined $1)
{<BR> $insfn{$1} .= "\0" if defined
$insfn{$1}; <BR> $insfn{$1} .= $fn if
$fn;<BR> }<BR> <BR>
BODY: <BR> while (($bpos = index($buf, $boundary))
== -1) {<BR> if ($name) { # if
no $name, then it's the prologue --
discard<BR> if ($fn) {
print FILE substr($buf, 0, $bufsize);
}<BR>
else { $in{$name} .= substr($buf, 0, $bufsize);
}<BR>
}<BR> $buf = substr($buf,
$bufsize);<BR> $amt = ($left >
$bufsize ? $bufsize : $left);
#$maxbound==length($buf);<BR> $errflag
= (read(STDIN, $buf, $amt, $maxbound) != $amt);
<BR> $left -=
$amt;<BR> }<BR> if
(defined $name) { # if no $name, then it's the prologue --
discard<BR> if ($fn) { print FILE
substr($buf, 0, $bpos-2); }<BR>
else { $in {$name} .= substr($buf, 0, $bpos-2); } # kill
last \r\n<BR> }<BR>
close (FILE);<BR> last PART if substr($buf, $bpos
+ $blen, 4) eq "--\r\n";<BR> substr($buf, 0,
$bpos+$blen+2) = '';<BR> $amt = ($left >
$bufsize+$maxbound-length($buf) <BR> ?
$bufsize+$maxbound-length($buf) : $left);<BR>
$errflag = (read(STDIN, $buf, $amt, length($buf)) !=
$amt);<BR> $left -= $amt;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2> undef
$head; undef $fn;<BR>
HEAD:<BR> while (($lpos = index($buf, "\r\n\r\n"))
== -1) { <BR> $head .= substr($buf, 0,
$bufsize);<BR> $buf = substr($buf,
$bufsize);<BR> $amt = ($left >
$bufsize ? $bufsize : $left);
#$maxbound==length($buf);<BR> $errflag
= (read(STDIN, $buf, $amt, $maxbound) != $amt);
<BR> $left -=
$amt;<BR> }<BR>
$head .= substr($buf, 0, $lpos+2);<BR> push (@in,
$head);<BR> @heads = split("\r\n",
$head);<BR> ($cd) = grep
(/^\s*Content-Disposition:/i, @heads);<BR> ($ct) =
grep (/^\s*Content-Type:/i, @heads);</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> ($name) = $cd =~
/\bname="([^"]+)"/i; #"; <BR> ($name) = $cd =~
/\bname=([^\s:;]+)/i unless defined $name; </FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> ($fname) = $cd =~
/\bfilename="([^"]*)"/i; #"; # filename can be
null-str<BR> ($fname) = $cd =~
/\bfilename=([^\s:;]+)/i unless defined
$fname;<BR> $incfn{$name} .= (defined $in{$name} ?
"\0" : "") . $fname;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> ($ctype) = $ct =~
/^\s*Content-type:\s*"([^"]+)"/i; #";<BR>
($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined
$ctype;<BR> $inct{$name} .= (defined $in{$name} ?
"\0" : "") . $ctype;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> if ($writefiles
&& defined $fname) {<BR>
$ser++;<BR> $fn = $writefiles . ".$$.$ser";<BR> open (FILE, ">$fn")
|| &CgiDie("Couldn't open $fn\n");<BR>
}<BR> substr($buf, 0, $lpos+4) =
'';<BR> undef
$fname;<BR> undef $ctype;<BR>
}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial
size=2>#################1;<BR>#################END_MULTIPART<BR>
&CgiDie($@) if $errflag;<BR> } else {<BR>
&CgiDie("cgi-lib.pl: Unknown Content-type:
$ENV{'CONTENT_TYPE'}\n");<BR> }</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2> $^W = $perlwarn;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> return ($errflag ? undef :
scalar(@in)); <BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># PrintHeader<BR># Returns the magic line which
tells WWW that we're an HTML document</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub PrintHeader {<BR> return "Content-type:
text/html\n\n";<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># HtmlTop<BR># Returns the <head> of a
document and the beginning of the body<BR># with the title and a body <h1>
header as specified by the parameter</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub HtmlTop<BR>{<BR> local ($title) =
@_;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> return
<<END_OF_TEXT;<BR><html><BR><head><BR><title>$title</title><BR></head><BR><body><BR><h1>$title</h1><BR>END_OF_TEXT<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># HtmlBot<BR># Returns the </body>,
</html> codes for the bottom of every HTML page</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub HtmlBot<BR>{<BR> return
"</body>\n</html>\n";<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># SplitParam<BR># Splits a multi-valued
parameter into a list of the constituent parameters</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub SplitParam<BR>{<BR> local ($param) =
@_;<BR> local (@params) = split ("\0", $param);<BR> return
(wantarray ? @params : $params[0]);<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># MethGet<BR># Return true if this cgi call was
using the GET request, false otherwise</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub MethGet {<BR> return (defined
$ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq
"GET");<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># MethPost<BR># Return true if this cgi call
was using the POST request, false otherwise</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub MethPost {<BR> return (defined
$ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq
"POST");<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># MyBaseUrl<BR># Returns the base URL to the
script (i.e., no extra path or query string)<BR>sub MyBaseUrl {<BR> local
($ret, $perlwarn);<BR> $perlwarn = $^W; $^W = 0;<BR> $ret =
'http://' . $ENV{'SERVER_NAME'} .
<BR> ($ENV{'SERVER_PORT'} != 80
? ":$ENV{'SERVER_PORT'}" : '')
.<BR>
$ENV{'SCRIPT_NAME'};<BR> $^W = $perlwarn;<BR> return
$ret;<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># MyFullUrl<BR># Returns the full URL to the
script (i.e., with extra path or query string)<BR>sub MyFullUrl {<BR>
local ($ret, $perlwarn);<BR> $perlwarn = $^W; $^W = 0;<BR> $ret =
'http://' . $ENV{'SERVER_NAME'} .
<BR> ($ENV{'SERVER_PORT'} != 80
? ":$ENV{'SERVER_PORT'}" : '')
.<BR> $ENV{'SCRIPT_NAME'} .
$ENV{'PATH_INFO'} .<BR> (length
($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '');<BR> $^W =
$perlwarn;<BR> return $ret;<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># MyURL<BR># Returns the base URL to the script
(i.e., no extra path or query string)<BR># This is obsolete and will be removed
in later versions<BR>sub MyURL {<BR> return
&MyBaseUrl;<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># CgiError<BR># Prints out an error message
which which containes appropriate headers,<BR># markup, etcetera.<BR>#
Parameters:<BR># If no parameters, gives a generic error
message<BR># Otherwise, the first parameter will be the title and the rest
will <BR># be given as different paragraphs of the body</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub CgiError {<BR> local (@msg) =
@_;<BR> local ($i,$name);</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> if (</FONT><A href="mailto:!@msg"><FONT
face=Arial size=2>!@msg</FONT></A><FONT face=Arial size=2>)
{<BR> $name = &MyFullUrl;<BR> @msg =
("Error: script $name encountered fatal error\n");<BR> };</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> if (!$cgi_lib'headerout) {
#')<BR> print &PrintHeader; <BR>
print
"<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n";<BR>
}<BR> print "<h1>$msg[0]</h1>\n";<BR> foreach $i (1 ..
$#msg) {<BR> print "<p>$msg[$i]</p>\n";<BR>
}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> $cgi_lib'headerout++;<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># CgiDie<BR># Identical to CgiError, but also
quits with the passed error message.</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub CgiDie {<BR> local (@msg) = @_;<BR>
&CgiError (@msg);<BR> die @msg;<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># PrintVariables<BR># Nicely formats
variables. Three calling options:<BR># A non-null associative array -
prints the items in that array<BR># A type-glob - prints the items in the
associated assoc array<BR># nothing - defaults to use %in<BR># Typical use:
&PrintVariables()</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>sub PrintVariables {<BR> local (*in) = @_ if
@_ == 1;<BR> local (%in) = @_ if @_ > 1;<BR> local ($out, $key,
$output);</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> $output = "\n<dl
compact>\n";<BR> foreach $key (sort keys(%in)) {<BR>
foreach (split("\0", $in{$key})) {<BR> ($out = $_)
=~ s/\n/<br>\n/g;<BR> $output .=
"<dt><b>$key</b>\n
<dd>:<i>$out</i>:<br>\n";<BR>
}<BR> }<BR> $output .= "</dl>\n";</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2> return $output;<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2># PrintEnv<BR># Nicely formats all environment
variables and returns HTML string<BR>sub PrintEnv {<BR>
&PrintVariables(*ENV);<BR>}</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><BR><FONT face=Arial size=2># The following lines exist only to avoid
warning messages<BR>$cgi_lib'writefiles =
$cgi_lib'writefiles;<BR>$cgi_lib'bufsize =
$cgi_lib'bufsize ;<BR>$cgi_lib'maxbound =
$cgi_lib'maxbound;<BR>$cgi_lib'version =
$cgi_lib'version;</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial><BR><FONT size=2></FONT></FONT> </DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>----- Original Message ----- </FONT>
<DIV><FONT face=Arial size=2>From: "YueSong Xu" <</FONT><A
href="mailto:desert_camelry@yahoo.com"><FONT face=Arial
size=2>desert_camelry@yahoo.com</FONT></A><FONT face=Arial
size=2>></FONT></DIV>
<DIV><FONT face=Arial size=2>To: <</FONT><A
href="mailto:toronto-pm@pm.org"><FONT face=Arial
size=2>toronto-pm@pm.org</FONT></A><FONT face=Arial size=2>></FONT></DIV>
<DIV><FONT face=Arial size=2>Sent: Wednesday, August 27, 2008 7:41
PM</FONT></DIV>
<DIV><FONT face=Arial size=2>Subject: [tpm] How to retrieve
post</FONT></DIV></DIV>
<DIV><FONT face=Arial><BR><FONT size=2></FONT></FONT></DIV><FONT face=Arial
size=2>> Hello everyone,<BR>> <BR>> Instead of using CGI.pm, how can I
write perl raw code to get all the HTTP post params as a whole string on Apache
(mod_perl 1.29)? Any %ENV?<BR>> Thanks a lot.<BR>> <BR>> <BR>>
<BR>> <BR>>
_______________________________________________<BR>> toronto-pm mailing
list<BR>> </FONT><A href="mailto:toronto-pm@pm.org"><FONT face=Arial
size=2>toronto-pm@pm.org</FONT></A><BR><FONT face=Arial size=2>> </FONT><A
href="http://mail.pm.org/mailman/listinfo/toronto-pm"><FONT face=Arial
size=2>http://mail.pm.org/mailman/listinfo/toronto-pm</FONT></A></BODY></HTML>