package CGI;
-require 5.004;
+require 5.008001;
use Carp 'croak';
# See the bottom of this file for the POD documentation. Search for the
# listing the modifications you have made.
# The most recent version and complete docs are available at:
-# http://stein.cshl.org/WWW/software/CGI/
+# http://search.cpan.org/dist/CGI.pm
# The revision is no longer being updated since moving to git.
$CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $';
-$CGI::VERSION='3.50';
+$CGI::VERSION='3.62';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
# ------------------ START OF THE LIBRARY ------------
-#### Method: endform
-# This method is DEPRECATED
-*endform = \&end_form;
-
# make mod_perlhappy
initialize_globals();
# user is still holding any reference to them as well.
sub DESTROY {
my $self = shift;
- if ($OS eq 'WINDOWS') {
+ if ($OS eq 'WINDOWS' || $OS eq 'VMS') {
for my $href (values %{$self->{'.tmpfiles'}}) {
$href->{hndl}->DESTROY if defined $href->{hndl};
$href->{name}->DESTROY if defined $href->{name};
# if we get called more than once, we want to initialize
# ourselves from the original query (which may be gone
# if it was read from STDIN originally.)
- if (defined(@QUERY_PARAM) && !defined($initializer)) {
+ if (@QUERY_PARAM && !defined($initializer)) {
for my $name (@QUERY_PARAM) {
my $val = $QUERY_PARAM{$name}; # always an arrayref;
$self->param('-name'=>$name,'-value'=> $val);
if (defined $val and ref $val eq 'ARRAY') {
- for my $fh (grep {defined(fileno($_))} @$val) {
+ for my $fh (grep {defined($_) && ref($_) && defined(fileno($_))} @$val) {
seek($fh,0,0); # reset the filehandle.
}
last METHOD;
}
- # If method is GET or HEAD, fetch the query from
+ # If method is GET, HEAD or DELETE, fetch the query from
# the environment.
- if ($is_xforms || $meth=~/^(GET|HEAD)$/) {
+ if ($is_xforms || $meth=~/^(GET|HEAD|DELETE)$/) {
if ($MOD_PERL) {
$query_string = $self->r->args;
} else {
if ( $content_length > 0 ) {
$self->read_from_client(\$query_string,$content_length,0);
}
- elsif (not defined $ENV{CONTENT_LENGTH}) {
- $self->read_from_stdin(\$query_string);
- # should this be PUTDATA in case of PUT ?
- my($param) = $meth . 'DATA' ;
- $self->add_parameter($param) ;
- push (@{$self->{param}{$param}},$query_string);
- undef $query_string ;
- }
# Some people want to have their cake and eat it too!
# Uncomment this line to have the contents of the query string
# APPENDED to the POST data.
# put a filehandle into binary mode (DOS)
sub binmode {
- return unless defined($_[1]) && defined fileno($_[1]);
+ return unless defined($_[1]) && ref ($_[1]) && defined fileno($_[1]);
CORE::binmode($_[1]);
}
}
END_OF_FUNC
-'read_from_stdin' => <<'END_OF_FUNC',
-# Read data from stdin until all is read
-sub read_from_stdin {
- my($self, $buff) = @_;
- local $^W=0; # prevent a warning
-
- #
- # TODO: loop over STDIN until all is read
- #
-
- my($eoffound) = 0;
- my($localbuf) = '';
- my($tempbuf) = '';
- my($bufsiz) = 1024;
- my($res);
- while ($eoffound == 0) {
- if ( $MOD_PERL ) {
- $res = $self->r->read($tempbuf, $bufsiz, 0)
- }
- else {
- $res = read(\*STDIN, $tempbuf, $bufsiz);
- }
-
- if ( !defined($res) ) {
- # TODO: how to do error reporting ?
- $eoffound = 1;
- last;
- }
- if ( $res == 0 ) {
- $eoffound = 1;
- last;
- }
- $localbuf .= $tempbuf;
- }
-
- $$buff = $localbuf;
-
- return $res;
-}
-END_OF_FUNC
-
'delete' => <<'END_OF_FUNC',
#### Method: delete
# Deletes the named parameter entirely.
$header =~ s/$CRLF(\s)/$1/g;
# All other uses of newlines are invalid input.
- if ($header =~ m/$CRLF/) {
+ if ($header =~ m/$CRLF|\015|\012/) {
# shorten very long values in the diagnostic
$header = substr($header,0,72).'...' if (length $header > 72);
die "Invalid header value contains a newline not followed by whitespace: $header";
$type ||= 'text/html' unless defined($type);
- if (defined $charset) {
- $self->charset($charset);
- } else {
- $charset = $self->charset if $type =~ /^text\//;
- }
- $charset ||= '';
+ # sets if $charset is given, gets if not
+ $charset = $self->charset( $charset );
# rearrange() was designed for the HTML portion, so we
# need to fix it up a little.
my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script);
for $script (@scripts) {
- my($src,$code,$language);
- if (ref($script)) { # script is a hash
- ($src,$code,$type) =
- rearrange(['SRC','CODE',['LANGUAGE','TYPE']],
- '-foo'=>'bar', # a trick to allow the '-' to be omitted
- ref($script) eq 'ARRAY' ? @$script : %$script);
+ my($src,$code,$language,$charset);
+ if (ref($script)) { # script is a hash
+ ($src,$code,$type,$charset) =
+ rearrange(['SRC','CODE',['LANGUAGE','TYPE'],'CHARSET'],
+ '-foo'=>'bar', # a trick to allow the '-' to be omitted
+ ref($script) eq 'ARRAY' ? @$script : %$script);
$type ||= 'text/javascript';
unless ($type =~ m!\w+/\w+!) {
$type =~ s/[\d.]+$//;
$type = "text/$type";
}
- } else {
- ($src,$code,$type) = ('',$script, 'text/javascript');
- }
+ } else {
+ ($src,$code,$type,$charset) = ('',$script, 'text/javascript', '');
+ }
my $comment = '//'; # javascript by default
$comment = '#' if $type=~/perl|tcl/i;
my(@satts);
push(@satts,'src'=>$src) if $src;
push(@satts,'type'=>$type);
+ push(@satts,'charset'=>$charset) if ($src && $charset);
$code = $cdata_start . $code . $cdata_end if defined $code;
push(@result,$self->script({@satts},$code || ''));
}
$action = qq(action="$action");
my($other) = @other ? " @other" : '';
$self->{'.parametersToAdd'}={};
- return qq/<form method="$method" $action enctype="$enctype"$other>\n/;
+ return qq/<form method="$method" $action enctype="$enctype"$other>/;
}
END_OF_FUNC
$action = qq(action="$action");
my($other) = @other ? " @other" : '';
$self->{'.parametersToAdd'}={};
- return qq/<form method="$method" $action enctype="$enctype"$other>\n/;
+ return qq/<form method="$method" $action enctype="$enctype"$other>/;
}
END_OF_FUNC
#### Method: end_form
# End a form
+# Note: This repeated below under the older name.
'end_form' => <<'END_OF_FUNC',
sub end_form {
my($self,@p) = self_or_default(@_);
}
END_OF_FUNC
+'endform' => <<'END_OF_FUNC',
+sub endform {
+ my($self,@p) = self_or_default(@_);
+ if ( $NOSTICKY ) {
+ return wantarray ? ("</form>") : "\n</form>";
+ } else {
+ if (my @fields = $self->get_fields) {
+ return wantarray ? ("<div>",@fields,"</div>","</form>")
+ : "<div>".(join '',@fields)."</div>\n</form>";
+ } else {
+ return "</form>";
+ }
+ }
+}
+END_OF_FUNC
+
#### Method: end_multipart_form
# end a multipart form
'end_multipart_form' => <<'END_OF_FUNC',
my $latin = defined $self->{'.charset'} ? $self->{'.charset'} =~ /^(ISO-8859-1|WINDOWS-1252)$/i
: 1;
# thanks to Randal Schwartz for the correct solution to this one
- $string=~ s[&(\S*?);]{
+ $string=~ s[&([^\s&]*?);]{
local $_ = $1;
/^amp$/i ? "&" :
/^quot$/i ? '"' :
/^lt$/i ? "<" :
/^#(\d+)$/ && $latin ? chr($1) :
/^#x([0-9a-f]+)$/i && $latin ? chr(hex($1)) :
- $_
+ "&$_;"
}gex;
return $string;
}
my $query_str = $self->query_string;
my $rewrite_in_use = $request_uri && $request_uri !~ /^\Q$script_name/;
- undef $path if $rewrite_in_use && $rewrite; # path not valid when rewriting active
my $uri = $rewrite && $request_uri ? $request_uri : $script_name;
$uri =~ s/\?.*$//s; # remove query string
sub param_fetch {
my($self,@p) = self_or_default(@_);
my($name) = rearrange([NAME],@p);
+ return [] unless defined $name;
+
unless (exists($self->{param}{$name})) {
$self->add_parameter($name);
$self->{param}{$name} = [];
if ($DEBUG && @ARGV) {
@words = @ARGV;
} elsif ($DEBUG > 1) {
- require "shellwords.pl";
+ require Text::ParseWords;
print STDERR "(offline mode: enter name=value pairs on standard input; press ^D or ^Z when done)\n";
chomp(@lines = <STDIN>); # remove newlines
$input = join(" ",@lines);
- @words = &shellwords($input);
+ @words = &Text::ParseWords::old_shellwords($input);
}
for (@words) {
s/\\=/%3D/g;
last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES));
$seqno += int rand(100);
}
- die "CGI open of tmpfile: $!\n" unless defined $filehandle;
+ die "CGI.pm open of tmpfile $tmp/$filename failed: $!\n" unless defined $filehandle;
$CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode
&& defined fileno($filehandle);
sub new {
my($package,$sequence) = @_;
my $filename;
- find_tempdir() unless -w $TMPDIRECTORY;
+ unless (-w $TMPDIRECTORY) {
+ $TMPDIRECTORY = undef;
+ find_tempdir();
+ }
for (my $i = 0; $i < $MAXTRIES; $i++) {
last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d", $TMPDIRECTORY, $sequence++));
}
$query = CGI->new;
-This will parse the input (from both POST and GET methods) and store
+This will parse the input (from POST, GET and DELETE methods) and store
it into a perl5 object called $query.
Any filehandles from file uploads will have their position reset to
The temporary directory is selected using the following algorithm:
- 1. if the current user (e.g. "nobody") has a directory named
- "tmp" in its home directory, use that (Unix systems only).
+ 1. if $CGITempFile::TMPDIRECTORY is already set, use that
2. if the environment variable TMPDIR exists, use the location
indicated.
MIME type if you choose, otherwise it defaults to text/html. An
optional second parameter specifies the status code and a human-readable
message. For example, you can specify 204, "No response" to create a
-script that tells the browser to do nothing at all.
+script that tells the browser to do nothing at all. Note that RFC 2616 expects
+the human-readable phase to be there as well as the numeric status code.
The last example shows the named argument style for passing arguments
to the CGI methods using named parameters. Recognized parameters are
P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
-Note that if a header value contains a carriage return, a leading space will be
-added to each new line that doesn't already have one as specified by RFC2616
-section 4.2. For example:
-
- print header( -ingredients => "ham\neggs\nbacon" );
+CGI.pm will accept valid multi-line headers when each line is separated with a
+CRLF value ("\r\n" on most platforms) followed by at least one space. For example:
-will generate
+ print header( -ingredients => "ham\r\n\seggs\r\n\sbacon" );
- Ingredients: ham
- eggs
- bacon
+Invalid multi-line header input will trigger in an exception. When multi-line headers
+are received, CGI.pm will always output them back as a single line, according to the
+folding rules of RFC 2616: the newlines will be removed, while the white space remains.
=head2 GENERATING A REDIRECTION HEADER
print $q->redirect(
-uri=>'http://somewhere.else/in/movie/land',
-nph=>1,
- -status=>301);
+ -status=>'301 Moved Permanently');
All names arguments recognized by header() are also recognized by
redirect(). However, most HTTP headers, including those generated by
advised that changing the status to anything other than 301, 302 or
303 will probably break redirection.
+Note that the human-readable phrase is also expected to be present to conform
+with RFC 2616, section 6.1.
+
=head2 CREATING THE HTML DOCUMENT HEADER
print start_html(-title=>'Secrets of the Pyramids',
-style=>{'src'=>'/styles/style1.css'},
-BGCOLOR=>'blue');
-After creating the HTTP header, most CGI scripts will start writing
-out an HTML document. The start_html() routine creates the top of the
+The start_html() routine creates the top of the
page, along with a lot of optional information that controls the
page's appearance and behavior.
The B<-encoding> argument can be used to specify the character set for
XHTML. It defaults to iso-8859-1 if not specified.
+The B<-dtd> argument can be used to specify a public DTD identifier string. For example:
+
+ -dtd => '-//W3C//DTD HTML 4.01 Transitional//EN')
+
+Alternatively, it can take public and system DTD identifiers as an array:
+
+ dtd => [ '-//W3C//DTD HTML 4.01 Transitional//EN', 'http://www.w3.org/TR/html4/loose.dtd' ]
+
+For the public DTD identifier to be considered, it must be valid. Otherwise it
+will be replaced by the default DTD. If the public DTD contains 'XHTML', CGI.pm
+will emit XML.
+
The B<-declare_xml> argument, when used in conjunction with XHTML,
will put a <?xml> declaration at the top of the HTML header. The sole
purpose of this declaration is to declare the character set
most validators. The default for -declare_xml is false.
You can place other arbitrary HTML elements to the <head> section with the
-B<-head> tag. For example, to place the rarely-used <link> element in the
+B<-head> tag. For example, to place a <link> element in the
head section, use this:
- print start_html(-head=>Link({-rel=>'next',
- -href=>'http://www.capricorn.com/s2.html'}));
+ print start_html(-head=>Link({-rel=>'shortcut icon',
+ -href=>'favicon.ico'}));
To incorporate multiple HTML elements into the <head> section, just pass an
array reference:
browsers that do not have JavaScript (or browsers where JavaScript is turned
off).
-The <script> tag, has several attributes including "type" and src.
-The latter is particularly interesting, as it allows you to keep the
-JavaScript code in a file or CGI script rather than cluttering up each
-page with the source. To use these attributes pass a HASH reference
-in the B<-script> parameter containing one or more of -type, -src, or
--code:
+The <script> tag, has several attributes including "type", "charset" and "src".
+"src" allows you to keep JavaScript code in an external file. To use these
+attributes pass a HASH reference in the B<-script> parameter containing one or
+more of -type, -src, or -code:
print $q->start_html(-title=>'The Riddle of the Sphinx',
-script=>{-type=>'JAVASCRIPT',
);
The option "-language" is a synonym for -type, and is supported for
-backwad compatibility.
+backwards compatibility.
The old-style positional parameters are as follows:
=head2 ENDING THE HTML DOCUMENT:
- print end_html
+ print $q->end_html;
This ends an HTML document by printing the </body></html> tags.
=head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
- $myself = self_url;
+ $myself = $q->self_url;
print q(<a href="$myself">I'm talking to myself.</a>);
self_url() will return a URL, that, when selected, will reinvoke
internal anchors but you don't want to disrupt the current contents
of the form(s). Something like this will do the trick.
- $myself = self_url;
+ $myself = $q->self_url;
print "<a href=\"$myself#table1\">See table 1</a>";
print "<a href=\"$myself#table2\">See table 2</a>";
print "<a href=\"$myself#yourself\">See for yourself</a>";
You can also retrieve the unprocessed query string with query_string():
- $the_string = query_string;
+ $the_string = $q->query_string();
+
+The behavior of calling query_string is currently undefined when the HTTP method is
+something other than GET.
=head2 OBTAINING THE SCRIPT'S URL
info probably won't match the request that the user sent. Set
-rewrite=>1 (default) to return URLs that match what the user sent
(the original request URI). Set -rewrite=>0 to return URLs that match
-the URL after mod_rewrite's rules have run. Because the additional
-path information only makes sense in the context of the rewritten URL,
--rewrite is set to false when you request path info in the URL.
+the URL after mod_rewrite's rules have run.
=back
=head1 CREATING STANDARD HTML ELEMENTS:
-CGI.pm defines general HTML shortcut methods for most, if not all of
-the HTML 3 and HTML 4 tags. HTML shortcuts are named after a single
-HTML element and return a fragment of HTML text that you can then
-print or manipulate as you like. Each shortcut returns a fragment of
-HTML code that you can append to a string, save to a file, or, most
-commonly, print out so that it displays in the browser window.
-
-This example shows how to use the HTML methods:
+CGI.pm defines general HTML shortcut methods for many HTML tags. HTML shortcuts are named after a single
+HTML element and return a fragment of HTML text. Example:
print $q->blockquote(
"Many years ago on the island of",
$query->autoEscape(0);
Note that autoEscape() is exclusively used to effect the behavior of how some
-CGI.pm HTML generation fuctions handle escaping. Calling escapeHTML()
+CGI.pm HTML generation functions handle escaping. Calling escapeHTML()
explicitly will always escape the HTML.
I<A Lurking Trap!> Some of the form-element generating methods return
method: POST
action: this script
enctype: application/x-www-form-urlencoded for non-XHTML
- multipart/form-data for XHTML, see mulitpart/form-data below.
+ multipart/form-data for XHTML, see multipart/form-data below.
end_form() returns the closing </form> tag.
=head3 Basics
-When the form is processed, you can retrieve an L<IO::Handle> compatibile
+When the form is processed, you can retrieve an L<IO::Handle> compatible
handle for a file upload field like this:
$lightweight_fh = $q->upload('field_name');
CGI.pm gives you low-level access to file upload management through
a file upload hook. You can use this feature to completely turn off
the temp file storage of file uploads, or potentially write your own
-file upload progess meter.
+file upload progress meter.
This is much like the UPLOAD_HOOK facility available in L<Apache::Request>, with
the exception that the first argument to the callback is an L<Apache::Upload>
To solve this problem the upload() method was added, which always returns a
lightweight filehandle. This generally works well, but will have trouble
interoperating with some other modules because the file handle is not derived
-from L<IO::Handle>. So that brings us to current recommedation given above,
+from L<IO::Handle>. So that brings us to current recommendation given above,
which is to call the handle() method on the file handle returned by upload().
That upgrades the handle to an IO::Handle. It's a big win for compatibility for
a small penalty of loading IO::Handle the first time you call it.
127.0.0.1 if the address is unavailable.
=item B<script_name()>
-Return the script name as a partial URL, for self-refering
+Return the script name as a partial URL, for self-referring
scripts.
=item B<referer()>
=item In the B<use> statement
-Simply add the "-nph" pragmato the list of symbols to be imported into
+Simply add the "-nph" pragma to the list of symbols to be imported into
your script:
use CGI qw(:standard -nph)
compatibility routine "ReadParse" is provided. Porting is simple:
OLD VERSION
+
require "cgi-lib.pl";
&ReadParse;
print "The value of the antique is $in{antique}.\n";
NEW VERSION
+
use CGI;
CGI::ReadParse();
print "The value of the antique is $in{antique}.\n";
CGI.pm's ReadParse() routine creates a tied variable named %in,
which can be accessed to obtain the query variables. Like
ReadParse, you can also provide your own variable. Infrequently
-used features of ReadParse, such as the creation of @in and $in
+used features of ReadParse, such as the creation of @in and $in
variables, are not supported.
Once you use ReadParse, you can retrieve the query object itself
this way:
$q = $in{CGI};
- print textfield(-name=>'wow',
- -value=>'does this really work?');
+ print $q->textfield(-name=>'wow',
+ -value=>'does this really work?');
This allows you to start using the more interesting features
of CGI.pm without rewriting your old scripts from scratch.
+An even simpler way to mix cgi-lib calls with CGI.pm calls is to import both the
+C<:cgi-lib> and C<:standard> method:
+
+ use CGI qw(:cgi-lib :standard);
+ &ReadParse;
+ print "The price of your purchase is $in{price}.\n";
+ print textfield(-name=>'price', -default=>'$1.99');
+
+=head2 Cgi-lib functions that are available in CGI.pm
+
+In compatibility mode, the following cgi-lib.pl functions are
+available for your use:
+
+ ReadParse()
+ PrintHeader()
+ HtmlTop()
+ HtmlBot()
+ SplitParam()
+ MethGet()
+ MethPost()
+
+=head2 Cgi-lib functions that are not available in CGI.pm
+
+ * Extended form of ReadParse()
+ The extended form of ReadParse() that provides for file upload
+ spooling, is not available.
+
+ * MyBaseURL()
+ This function is not available. Use CGI.pm's url() method instead.
+
+ * MyFullURL()
+ This function is not available. Use CGI.pm's self_url() method
+ instead.
+
+ * CgiError(), CgiDie()
+ These functions are not supported. Look at CGI::Carp for the way I
+ prefer to handle error messages.
+
+ * PrintVariables()
+ This function is not available. To achieve the same effect,
+ just print out the CGI object:
+
+ use CGI qw(:standard);
+ $q = CGI->new;
+ print h1("The Variables Are"),$q;
+
+ * PrintEnv()
+ This function is not available. You'll have to roll your own if you really need it.
+
=head1 AUTHOR INFORMATION
-The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein. It is
-distributed under GPL and the Artistic License 2.0.
+The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein. It is
+distributed under GPL and the Artistic License 2.0. It is currently
+maintained by Mark Stosberg with help from many contributors.
-Address bug reports and comments to: lstein@cshl.org. When sending
-bug reports, please provide the version of CGI.pm, the version of
-Perl, the name and version of your Web server, and the name and
-version of the operating system you are using. If the problem is even
-remotely browser dependent, please provide information about the
-affected browers as well.
+Address bug reports and comments to: https://rt.cpan.org/Public/Dist/Display.html?Queue=CGI.pm
+When sending bug reports, please provide the version of CGI.pm, the version of
+Perl, the name and version of your Web server, and the name and version of the
+operating system you are using. If the problem is even remotely browser
+dependent, please provide information about the affected browsers as well.
=head1 CREDITS
https://perl5.git.perl.org / perl5.git / blobdiff