CGI-Simple
view release on metacpan or search on metacpan
without this fix.
Port CRLF injection prevention from CGI.pm
Optimize Vars(): Don't build %hash if we aren't going to use it.
Micro-optimization to Vars(): Don't call "tie" unless we need to.
- Numerous changes from K. Berov:
Added "+" to the mime character class.
Added tests for C<$mime = $q->upload_info( $filename, 'mime' );>
Fixed wrong match for mimetypes. Example: matched only
'application/vnd' instead of 'application/vnd.ms-excel'.
Added "\." to the mime character class
1.112 2009-05-31
- (thanks bingos) added missing IO::Scalar dependency.
1.111 2009-05-28
- Implemented Michael Nachbaur fixes for multipart form data handling.
is consistent with CGI.pm as well as RFC 2965, which states: "A
server SHOULD also accept comma (,) as the separator between cookie-
values for future compatibility." (Mark Stosberg)
- Support cookies which have an equals sign in the value. Ported
from CGI.pm (Mark Stosberg)
- Support cookies in which one of multiple values is empty. Ported
from CGI.pm (Mark Stosberg)
- Fixed bug when calling unescapeHTML on HTML that wasn't
properly escaped in the first place. Thanks to M-Uchino and Mark Stosberg.
- Removed bogus dependency on version.pm.
- Add heuristic to upload to handle the case where no boundary is
specified in CONTENT_TYPE. See #14838.
1.106 2008-09-14
- Added missing Apache2 modules. Refs #39146 and #38931. Thanks to RSAVAGE.
- Applied BEROV's patch for UTF-8 form data handling. Refs #12481. Thanks to BEROV.
1.105 2008-05-16
- Fixed skip count in t/040.request.t. Fixes #35945. Thanks to snaury.
1.104 2008-05-13
0.078 2007-01-09
- Maintenance release by Andy Armstrong <andy@hexten.net>
- Rewrote tests to use Test::More
- Implemented mod_perl 2 support
0.077 Tue 23 Nov 2004
- Bugfix patches.
- José Micó supplied patch that relates to character set allowed in headers.
TAB and high ascii chars are definitivelly allowed in headers, and not
accepting them prevents the upload of files with filenames like "España.txt".
- José Micó also notes that some versions of IE send extra boundaries in
POSTed data before real ones. New patch should be fix this IE issue.
- Lars Thegler supplied some patches.
- head2/head3 pod changed to head1/head2 for the benefit of some older
tools that exepect this.
- Resolved issue with manpages not being installed on FREEBSD via Makefile hack
- Steve Purkis supplied a patch for a serious POST_MAX bug. A small modification
to control flow was used instead but this was a serious bug. If you are reading
this you are probably upgrading which is good.
0.076
- Went missing in action.
0.075 Tue June 1 2004
- Meant to upload 0.73 and 0.074 but just never got around to it
- Fixed upload hang bug in certain circumstances
- Added upload_fieldnames() method by request
- Added support for $fh = upload('field_name') but this has the issue
of what to do if 'field_name' is duplicated. You can only ever get one
fh from this method unlike the favoured approach using param() to get
the filename(s) which will let you get to all the files.
- José Micó deserves plaudits as does PodMaster.
0.072 Tue Sept 9 2003
- Patched issue with large POSTs where data may not be on STDIN for single
read call. Bug exists in CGI.pm as well. Thanks to Jason Luther
- Added tests for slow post behaviour
0.071 Sat Aug 2 2003
- Oops, changed $VERSION to 0.007 not 0.07 so have to change to 0.071 to upload again. ;-)
- no significant changes since 0.07 (aka 0.007) ;-)
0.07 Sat Aug 2 2003
- i admit to abject slackness, but anyway finally allocated a few hours
to apply a number of bug fixes which are (in no particular order)
- mod_perl compliant, patched by Mathew Albright
- still need to comment out use Selfloader and __DATA__ token
- still thinking about other solutions to this
- Blessed globs now possible in the constructor thanks to chromatic
- Unicode error 0xfe | ($c >> 30) -> 0xfc | ($c >>30 ) fixed thanks to
0.06 Fri Nov 8 2002
- finally found someone with a solaris box to work out reason for
unexpected test failures. Thanks to John D. Robinson and Jeroen Latour
Details available at: http://www.perlmonks.org/index.pl?node_id=211401
- Removed another new bug relating to test scripts rather than core code
thanks to the combined effors of Perlmonks tommyw, grinder, Jaap, vek,
erasei, jlongino and strider_corinth
0.05 Wed Nov 6 2002
- nasty upload bug reported (with solution) by Brandon Black fixed. Perl would
hang if upload terminated by browser before completion
- also odity with IO::file fixed (Brandon Black once again)
0.04 Sat Apr 12 2002
- test bug on Solaris reported by robc@stamps.stortek.com and fixed
0.03 Fri Apr 12 2002
- modifed test so skipping fork() test is noted as such
- allow '0' as a valid param name
- renamed concur.t to concur.test so that it does not rub by default
- added speed tests comparing CGI.pm to CGI::Simple in the file
cgi-simple_vs_cgi-pm.html in the root dir
0.02 Fri Dec 21 2001
- added cgi_error() if upload called but CONTENT_TYPE not multipart/form-data
- changed inernal storage names of globals by droping $
- added mod_perl notes re Selfloader and __DATA__ token
- as per suggestions from Curtis Poe
0.01 Thu Nov 1 12:21:48 2001
- original version; created by h2xs 1.21 with options -X CGI::Simple
t/020.cookie.t
t/030.function.t
t/040.request.t
t/041.multipart.t
t/050.simple.t
t/060.slow_post.t
t/070.standard.t
t/080.util.t
t/090.14838.t
t/100.set-cookie.t
t/110.bad-upload.t
t/120.header-crlf.t
t/headers.t
t/test_file.txt
t/upload_info.t
t/version.t
xt/manifest.t
xt/pod-coverage.t
xt/pod.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
lib/CGI/Simple.pm view on Meta::CPAN
# set this to 1 to use CGI.pm default global settings
$USE_CGI_PM_DEFAULTS = 0
unless defined $USE_CGI_PM_DEFAULTS;
# see if user wants old CGI.pm defaults
if ( $USE_CGI_PM_DEFAULTS ) {
_use_cgi_pm_global_settings();
return;
}
# no file uploads by default, set to 0 to enable uploads
$DISABLE_UPLOADS = 1
unless defined $DISABLE_UPLOADS;
# use a post max of 100K, set to -1 for no limits
$POST_MAX = 102_400
unless defined $POST_MAX;
# set to 1 to not include undefined params parsed from query string
$NO_UNDEF_PARAMS = 0
unless defined $NO_UNDEF_PARAMS;
lib/CGI/Simple.pm view on Meta::CPAN
$self->{'.globals'}->{'PARAM_UTF8'} = $PARAM_UTF8;
}
# use the automatic calling of the import sub to set our pragmas. CGI.pm compat
sub import {
my ( $self, @args ) = @_;
# arguments supplied in the 'use CGI::Simple [ARGS];' will now be in @args
foreach ( @args ) {
$USE_CGI_PM_DEFAULTS = 1, next if m/^-default/i;
$DISABLE_UPLOADS = 1, next if m/^-no.?upload/i;
$DISABLE_UPLOADS = 0, next if m/^-upload/i;
$HEADERS_ONCE = 1, next if m/^-unique.?header/i;
$NPH = 1, next if m/^-nph/i;
$DEBUG = 0, next if m/^-no.?debug/i;
$DEBUG = defined $1 ? $1 : 2, next if m/^-debug(\d)?/i;
$USE_PARAM_SEMICOLONS = 1, next if m/^-newstyle.?url/i;
$USE_PARAM_SEMICOLONS = 0, next if m/^-oldstyle.?url/i;
$NO_UNDEF_PARAMS = 1, next if m/^-no.?undef.?param/i;
$FATAL = 0, next if m/^-carp/i;
$FATAL = 1, next if m/^-croak/i;
croak "Pragma '$_' is not defined in CGI::Simple\n";
lib/CGI/Simple.pm view on Meta::CPAN
'400 No boundary supplied for multipart/form-data' );
return 0;
}
$boundary = $self->_massage_boundary( $boundary );
}
BOUNDARY:
while ( $data =~ m/^$boundary$CRLF/ ) {
## TAB and high ascii chars are definitivelly allowed in headers.
## Not accepting them in the following regex prevents the upload of
## files with filenames like "España.txt".
# next READ unless $data =~ m/^([\040-\176$CRLF]+?$CRLF$CRLF)/o;
next READ
unless $data =~ m/^([\x20-\x7E\x80-\xFF\x09$CRLF]+?$CRLF$CRLF)/o;
my $header = $1;
( my $unfold = $1 ) =~ s/$CRLF\s+/ /og;
my ( $param ) = $unfold =~ m/form-data;\s+name="?([^\";]*)"?/;
my ( $filename )
= $unfold =~ m/name="?\Q$param\E"?;\s+filename="?([^\"]*)"?/;
if ( defined $filename ) {
my ( $mime ) = $unfold =~ m/Content-Type:\s+([-\w\+\.\/]+)/io;
$data =~ s/^\Q$header\E//;
( $got_data, $data, my $fh, my $size )
= $self->_save_tmpfile( $handle, $boundary, $filename,
$got_data, $data );
$self->_add_param( $param, $filename );
$self->{'.upload_fields'}->{$param} = $filename;
$self->{'.filehandles'}->{$filename} = $fh if $fh;
$self->{'.tmpfiles'}->{$filename}
= { 'size' => $size, 'mime' => $mime }
if $size;
next BOUNDARY;
}
next READ
unless $data =~ s/^\Q$header\E(.*?)$CRLF(?=$boundary)//s;
$self->_add_param( $param, $1 );
}
lib/CGI/Simple.pm view on Meta::CPAN
return $got_data;
}
sub _save_tmpfile {
my ( $self, $handle, $boundary, $filename, $got_data, $data ) = @_;
my $fh;
my $CRLF = $self->crlf;
my $length = $ENV{'CONTENT_LENGTH'} || 0;
my $file_size = 0;
if ( $self->{'.globals'}->{'DISABLE_UPLOADS'} ) {
$self->cgi_error( "405 Not Allowed - File uploads are disabled" );
}
elsif ( $filename ) {
eval { require IO::File };
$self->cgi_error( "500 IO::File is not available $@" ) if $@;
$fh = new_tmpfile IO::File;
$self->cgi_error( "500 IO::File can't create new temp_file" )
unless $fh;
}
# read in data until closing boundary found. buffer to catch split boundary
# we do this regardless of whether we save the file or not to read the file
# data from STDIN. if either uploads are disabled or no file has been sent
# $fh will be undef so only do file stuff if $fh is true using $fh && syntax
$fh && binmode $fh;
while ( $got_data < $length ) {
my $buffer = $data;
last unless _internal_read( $self, \*STDIN, $data );
# fixed hanging bug if browser terminates upload part way through
# thanks to Brandon Black
unless ( $data ) {
$self->cgi_error(
'400 Malformed multipart, no terminating boundary' );
undef $fh;
return $got_data;
}
$got_data += length $data;
if ( "$buffer$data" =~ m/$boundary/ ) {
lib/CGI/Simple.pm view on Meta::CPAN
sub Delete { CGI::Simple::delete( @_ ) } # for method style interface
sub delete_all {
my $self = shift;
undef %{$self};
$self->_store_globals;
}
sub Delete_all { $_[0]->delete_all } # as used by CGI.pm
sub upload {
my ( $self, $filename, $writefile ) = @_;
unless ( $filename ) {
$self->cgi_error( "No filename submitted for upload to $writefile" )
if $writefile;
return $self->{'.filehandles'}
? keys %{ $self->{'.filehandles'} }
: ();
}
unless ( $ENV{'CONTENT_TYPE'} =~ m|^multipart/form-data|i ) {
$self->cgi_error(
'Oops! File uploads only work if you specify ENCTYPE="multipart/form-data" in your <FORM> tag'
);
return undef;
}
my $fh = $self->{'.filehandles'}->{$filename};
# allow use of upload fieldname to get filehandle
# this has limitation that in the event of duplicate
# upload field names there can only be one filehandle
# which will point to the last upload file
# access by filename does not suffer from this issue.
$fh
= $self->{'.filehandles'}->{ $self->{'.upload_fields'}->{$filename} }
if !$fh and defined $self->{'.upload_fields'}->{$filename};
if ( $fh ) {
seek $fh, 0, 0; # get ready for reading
return $fh unless $writefile;
my $buffer;
my $out;
unless ( open $out, '>', $writefile ) {
$self->cgi_error( "500 Can't write to $writefile: $!\n" );
return undef;
}
binmode $out;
binmode $fh;
print $out $buffer while read( $fh, $buffer, 4096 );
close $out;
$self->{'.filehandles'}->{$filename} = undef;
undef $fh;
return 1;
}
else {
$self->cgi_error(
"No filehandle for '$filename'. Are uploads enabled (\$DISABLE_UPLOADS = 0)? Is \$POST_MAX big enough?"
);
return undef;
}
}
sub upload_fieldnames {
my ( $self ) = @_;
return wantarray
? ( keys %{ $self->{'.upload_fields'} } )
: [ keys %{ $self->{'.upload_fields'} } ];
}
# return the file size of an uploaded file
sub upload_info {
my ( $self, $filename, $info ) = @_;
unless ( $ENV{'CONTENT_TYPE'} =~ m|^multipart/form-data|i ) {
$self->cgi_error(
'Oops! File uploads only work if you specify ENCTYPE="multipart/form-data" in your <FORM> tag'
);
return undef;
}
return keys %{ $self->{'.tmpfiles'} } unless $filename;
return $self->{'.tmpfiles'}->{$filename}->{'mime'}
if $info =~ /mime/i;
return $self->{'.tmpfiles'}->{$filename}->{'size'};
}
sub uploadInfo { &upload_info } # alias for CGI.pm compatibility
# return all params/values in object as a query string suitable for 'GET'
sub query_string {
my $self = shift;
my @pairs;
for my $param ( $self->param ) {
for my $value ( $self->param( $param ) ) {
next unless defined $value;
push @pairs,
$self->url_encode( $param ) . '=' . $self->url_encode( $value );
lib/CGI/Simple.pm view on Meta::CPAN
CGI::Simple - A Simple totally OO CGI interface that is CGI.pm compliant
=head1 VERSION
This document describes CGI::Simple version 1.282.
=head1 SYNOPSIS
use CGI::Simple;
$CGI::Simple::POST_MAX = 1024; # max upload via post default 100kB
$CGI::Simple::DISABLE_UPLOADS = 0; # enable uploads
$q = CGI::Simple->new;
$q = CGI::Simple->new( { 'foo'=>'1', 'bar'=>[2,3,4] } );
$q = CGI::Simple->new( 'foo=1&bar=2&bar=3&bar=4' );
$q = CGI::Simple->new( \*FILEHANDLE );
$q->save( \*FILEHANDLE ); # save current object to a file as used by new
@params = $q->param; # return all param names as a list
$value = $q->param('foo'); # return the first value supplied for 'foo'
lib/CGI/Simple.pm view on Meta::CPAN
$q->param( -name=>'foo', -value=>'bar' );
$q->param( -name=>'foo', -value=>['bar','baz'] );
$q->param( 'foo', 'some', 'new', 'values' ); # append values to 'foo'
$q->append( -name=>'foo', -value=>'bar' );
$q->append( -name=>'foo', -value=>['some', 'new', 'values'] );
$q->delete('foo'); # delete param 'foo' and all its values
$q->delete_all; # delete everything
<INPUT TYPE="file" NAME="upload_file" SIZE="42">
$files = $q->upload() # number of files uploaded
@files = $q->upload(); # names of all uploaded files
$filename = $q->param('upload_file') # filename of uploaded file
$mime = $q->upload_info($filename,'mime'); # MIME type of uploaded file
$size = $q->upload_info($filename,'size'); # size of uploaded file
my $fh = $q->upload($filename); # get filehandle to read from
while ( read( $fh, $buffer, 1024 ) ) { ... }
# short and sweet upload
$ok = $q->upload( $q->param('upload_file'), '/path/to/write/file.name' );
print "Uploaded ".$q->param('upload_file')." and wrote it OK!" if $ok;
$decoded = $q->url_decode($encoded);
$encoded = $q->url_encode($unencoded);
$escaped = $q->escapeHTML('<>"&');
$unescaped = $q->unescapeHTML('<>"&');
$qs = $q->query_string; # get all data in $q as a query string OK for GET
$q->no_cache(1); # set Pragma: no-cache + expires
print $q->header(); # print a simple header
lib/CGI/Simple.pm view on Meta::CPAN
print $q->header( -cookie=>$cookie ); # set cookie
print $q->redirect('http://go.away.now'); # print a redirect header
dienice( $q->cgi_error ) if $q->cgi_error;
=head1 DESCRIPTION
CGI::Simple provides a relatively lightweight drop in replacement for CGI.pm.
It shares an identical OO interface to CGI.pm for parameter parsing, file
upload, cookie handling and header generation. This module is entirely object
oriented, however a complete functional interface is available by using the
CGI::Simple::Standard module.
Essentially everything in CGI.pm that relates to the CGI (not HTML) side of
things is available. There are even a few new methods and additions to old
ones! If you are interested in what has gone on under the hood see the
Compatibility with CGI.pm section at the end.
In practical testing this module loads and runs about twice as fast as CGI.pm
depending on the precise task.
lib/CGI/Simple.pm view on Meta::CPAN
the default CGI::Simple object from the indicated file handle.
restore_parameters($fh);
=cut
################ Uploading Files ###################
=head1 FILE UPLOADS
File uploads are easy with CGI::Simple. You use the B<upload()> method.
Assuming you have the following in your HTML:
<FORM
METHOD="POST"
ACTION="http://somewhere.com/cgi-bin/script.cgi"
ENCTYPE="multipart/form-data">
<INPUT TYPE="file" NAME="upload_file1" SIZE="42">
<INPUT TYPE="file" NAME="upload_file2" SIZE="42">
</FORM>
Note that the ENCTYPE is "multipart/form-data". You must specify this or the
browser will default to "application/x-www-form-urlencoded" which will result
in no files being uploaded although on the surface things will appear OK.
When the user submits this form any supplied files will be spooled onto disk
and saved in temporary files. These files will be deleted when your script.cgi
exits so if you want to keep them you will need to proceed as follows.
=head2 upload() The key file upload method
The B<upload()> method is quite versatile. If you call B<upload()> without
any arguments it will return a list of uploaded files in list context and
the number of uploaded files in scalar context.
$number_of_files = $q->upload;
@list_of_files = $q->upload;
Having established that you have uploaded files available you can get the
browser supplied filename using B<param()> like this:
$filename1 = $q->param('upload_file1');
You can then get a filehandle to read from by calling B<upload()> and
supplying this filename as an argument. Warning: do not modify the
value you get from B<param()> in any way - you don't need to untaint it.
$fh = $q->upload( $filename1 );
Now to save the file you would just do something like:
$save_path = '/path/to/write/file.name';
open my $out, '>', $save_path or die "Oops $!\n";
binmode $out;
print $out $buffer while read( $fh, $buffer, 4096 );
close $out;
By utilizing a new feature of the upload method this process can be
simplified to:
$ok = $q->upload( $q->param('upload_file1'), '/path/to/write/file.name' );
if ($ok) {
print "Uploaded and wrote file OK!";
} else {
print $q->cgi_error();
}
As you can see upload will accept an optional second argument and will write
the file to this file path. It will return 1 for success and undef if it
fails. If it fails you can get the error from B<cgi_error>
You can also use just the fieldname as an argument to upload ie:
$fh = $q->upload( 'upload_field_name' );
or
$ok = $q->upload( 'upload_field_name', '/path/to/write/file.name' );
BUT there is a catch. If you have multiple upload fields, all called
'upload_field_name' then you will only get the last uploaded file from
these fields.
=head2 upload_info() Get the details about uploaded files
The B<upload_info()> method is a new method. Called without arguments it
returns the number of uploaded files in scalar context and the names of
those files in list context.
$number_of_upload_files = $q->upload_info();
@filenames_of_all_uploads = $q->upload_info();
You can get the MIME type of an uploaded file like this:
$mime = $q->upload_info( $filename1, 'mime' );
If you want to know how big a file is before you copy it you can get that
information from B<uploadInfo> which will return the file size in bytes.
$file_size = $q->upload_info( $filename1, 'size' );
The size attribute is optional as this is the default value returned.
Note: The old CGI.pm B<uploadInfo()> method has been deleted.
=head2 $POST_MAX and $DISABLE_UPLOADS
CGI.pm has a default setting that allows infinite size file uploads by
default. In contrast file uploads are disabled by default in CGI::Simple
to discourage Denial of Service attacks. You must enable them before you
expect file uploads to work.
When file uploads are disabled the file name and file size details will
still be available from B<param()> and B<upload_info> respectively but
the upload filehandle returned by B<upload()> will be undefined - not
surprising as the underlying temp file will not exist either.
You can enable uploads using the '-upload' pragma. You do this by specifying
this in you use statement:
use CGI::Simple qw(-upload);
Alternatively you can enable uploads via the $DISABLE_UPLOADS global like this:
use CGI::Simple;
$CGI::Simple::DISABLE_UPLOADS = 0;
$q = CGI::Simple->new;
If you wish to set $DISABLE_UPLOADS you must do this *after* the
use statement and *before* the new constructor call as shown above.
The maximum acceptable data via post is capped at 102_400kB rather than
infinity which is the CGI.pm default. This should be ample for most tasks
but you can set this to whatever you want using the $POST_MAX global.
use CGI::Simple;
$CGI::Simple::DISABLE_UPLOADS = 0; # enable uploads
$CGI::Simple::POST_MAX = 1_048_576; # allow 1MB uploads
$q = CGI::Simple->new;
If you set to -1 infinite size uploads will be permitted, which is the CGI.pm
default.
$CGI::Simple::POST_MAX = -1; # infinite size upload
Alternatively you can specify all the CGI.pm default values which allow file
uploads of infinite size in one easy step by specifying the '-default' pragma
in your use statement.
use CGI::Simple qw( -default ..... );
=head2 binmode() and Win32
If you are using CGI::Simple be sure to call B<binmode()> on any handle that
you create to write the uploaded file to disk. Calling B<binmode()> will do
no harm on other systems anyway.
=cut
################ Miscellaneous Methods ################
=head1 MISCELANEOUS METHODS
=head2 escapeHTML() Escaping HTML special characters
lib/CGI/Simple.pm view on Meta::CPAN
=cut
=head1 PRAGMAS
There are a number of pragmas that you can specify in your use CGI::Simple
statement. Pragmas, which are always preceded by a hyphen, change the way
that CGI::Simple functions in various ways. You can generally achieve
exactly the same results by setting the underlying $GLOBAL_VARIABLES.
For example the '-upload' pargma will enable file uploads:
use CGI::Simple qw(-upload);
In CGI::Simple::Standard Pragmas, function sets , and individual functions
can all be imported in the same use() line. For example, the following
use statement imports the standard set of functions and enables debugging
mode (pragma -debug):
use CGI::Simple::Standard qw(:standard -debug);
The current list of pragmas is as follows:
lib/CGI/Simple.pm view on Meta::CPAN
This turns on debugging. At debug level 1 CGI::Simple will read arguments
from the command-line. At debug level 2 CGI.pm will produce the prompt
"(offline mode: enter name=value pairs on standard input)" and wait for
input on STDIN. If no number is specified then a debug level of 2 is used.
See the section on debugging for more details.
=item -default
This sets the default global values for CGI.pm which will enable infinite
size file uploads, and specify the '-newstyle_urls' and '-debug1' pragmas
=item -no_upload
Disable uploads - the default setting
=item - upload
Enable uploads - the CGI.pm default
=item -unique_header
Only allows headers to be generated once per script invocation
=item -carp
Carp when B<cgi_error()> called, default is to do nothing
=item -croak
lib/CGI/Simple.pm view on Meta::CPAN
'REDIRECT_QUERY_STRING' => '',
'AUTH_TYPE' => 'PGP MD5 DES rot13',
'COOKIE' => 'foo=a%20phrase; bar=yes%2C%20a%20phrase&;I%20say;',
'SERVER_PORT' => '8080'
};
=head2 cgi_error() Retrieving CGI::Simple error messages
Errors can occur while processing user input, particularly when
processing uploaded files. When these errors occur, CGI::Simple will stop
processing and return an empty parameter list. You can test for
the existence and nature of errors using the B<cgi_error()> function.
The error messages are formatted as HTTP status codes. You can either
incorporate the error text into an HTML page, or use it as the value
of the HTTP status:
my $error = $q->cgi_error;
if ($error) {
print $q->header(-status=>$error);
print "<H2>$error</H2>;
lib/CGI/Simple.pm view on Meta::CPAN
=head2 Globals Variables
The list of global variables has been pruned by 75%. Here is the complete
list of the global variables used:
$VERSION = "0.01";
# set this to 1 to use CGI.pm default global settings
$USE_CGI_PM_DEFAULTS = 0 unless defined $USE_CGI_PM_DEFAULTS;
# see if user wants old CGI.pm defaults
do{ _use_cgi_pm_global_settings(); return } if $USE_CGI_PM_DEFAULTS;
# no file uploads by default, set to 0 to enable uploads
$DISABLE_UPLOADS = 1 unless defined $DISABLE_UPLOADS;
# use a post max of 100K, set to -1 for no limits
$POST_MAX = 102_400 unless defined $POST_MAX;
# do not include undefined params parsed from query string
$NO_UNDEF_PARAMS = 0 unless defined $NO_UNDEF_PARAMS;
# separate the name=value pairs with ; rather than &
$USE_PARAM_SEMICOLONS = 0 unless defined $USE_PARAM_SEMICOLONS;
# only print headers once
$HEADERS_ONCE = 0 unless defined $HEADERS_ONCE;
# Set this to 1 to enable NPH scripts
$NPH = 0 unless defined $NPH;
# 0 => no debug, 1 => from @ARGV, 2 => from STDIN
$DEBUG = 0 unless defined $DEBUG;
# filter out null bytes in param - value pairs
$NO_NULL = 1 unless defined $NO_NULL;
# set behavior when cgi_err() called -1 => silent, 0 => carp, 1 => croak
$FATAL = -1 unless defined $FATAL;
Four of the default values of the old CGI.pm variables have been changed.
Unlike CGI.pm which by default allows unlimited POST data and file uploads
by default CGI::Simple limits POST data size to 100kB and denies file uploads
by default. $USE_PARAM_SEMICOLONS is set to 0 by default so we use (old style)
& rather than ; as the pair separator for query strings. Debugging is
disabled by default.
There are three new global variables. If $NO_NULL is true (the default) then
CGI::Simple will strip null bytes out of names, values and keywords. Null
bytes can do interesting things to C based code like Perl. Uploaded files
are not touched. $FATAL controls the behavior when B<cgi_error()> is called.
The default value of -1 makes errors silent. $USE_CGI_PM_DEFAULTS reverts the
defaults to the CGI.pm standard values ie unlimited file uploads via POST
for DNS attacks. You can also get the defaults back by using the '-default'
pragma in the use:
use CGI::Simple qw(-default);
use CGI::Simple::Standard qw(-default);
The values of the global variables are stored in the CGI::Simple object and
can be referenced and changed using the B<globals()> method like this:
my $value = $q->globals( 'VARNAME' ); # get
lib/CGI/Simple.pm view on Meta::CPAN
add_param
param_fetch
url_param
keywords
Vars
append
delete
Delete
delete_all
Delete_all
upload
upload_info
query_string
parse_query_string
parse_keywordlist
=head2 Save and Restore from File Methods
_init_from_file
save
save_parameters
lib/CGI/Simple.pm view on Meta::CPAN
state
=head1 NEW METHODS IN CGI::Simple
There are a few new methods in CGI::Simple as listed below. The highlights are
the B<parse_query_string()> method to add the QUERY_STRING data to your object if
the method was POST. The B<no_cache()> method adds an expires now directive and
the Pragma: no-cache directive to the header to encourage some browsers to
do the right thing. B<PrintEnv()> from the cgi-lib.pl routines will dump an
HTML friendly list of the %ENV and makes a handy addition to B<Dump()> for use
in debugging. The upload method now accepts a filepath as an optional second
argument as shown in the synopsis. If this is supplied the uploaded file will
be written to there automagically.
=head2 Internal Routines
_initialize_globals()
_use_cgi_pm_global_settings()
_store_globals()
_initialize()
_init_from_file()
_read_parse()
_parse_params()
_add_param()
_parse_keywordlist()
_parse_multipart()
_save_tmpfile()
_read_data()
=head2 New Public Methods
add_param() # adds a param/value(s) pair +/- overwrite
upload_info() # uploaded files MIME type and size
url_decode() # decode s url encoded string
url_encode() # url encode a string
parse_query_string() # add QUERY_STRING data to $q object if 'POST'
no_cache() # add both the Pragma: no-cache
# and Expires/Date => 'now' to header
=head2 cgi-lib.pl methods added for completeness
_shift_if_ref() # internal hack reminiscent of self_or_default :-)
MyBaseUrl()
lib/CGI/Simple.pm view on Meta::CPAN
radio_group()
popup_menu()
scrolling_list()
hidden()
image_button()
nosticky()
default_dtd()
=head2 Upload Related
CGI::Simple uses anonymous tempfiles supplied by IO::File to spool uploaded
files to.
private_tempfiles() # automatic in CGI::Simple
tmpFileName() # all upload files are anonymous
uploadInfo() # relied on FH access, replaced with upload_info()
=head2 Really Private Subs (marked as so)
previous_or_default()
register_parameter()
get_fields()
_set_values_and_labels()
_compile_all()
asString()
lib/CGI/Simple/Standard.pm view on Meta::CPAN
%EXPORT_TAGS = (
':html' => [qw(:misc)],
':standard' => [qw(:core :access)],
':cgi' => [qw(:core :access)],
':all' => [
qw(:core :misc :cookie :header :push :debug :cgi-lib
:access :internal)
],
':core' => [
qw(param add_param param_fetch url_param keywords
append Delete delete_all Delete_all upload
query_string parse_query_string parse_keywordlist
Vars save_parameters restore_parameters)
],
':misc' => [qw(url_decode url_encode escapeHTML unescapeHTML put)],
':cookie' => [qw(cookie raw_cookie)],
':header' => [qw(header cache no_cache redirect)],
':push' => [
qw(multipart_init multipart_start multipart_end
multipart_final)
],
lib/CGI/Simple/Standard.pm view on Meta::CPAN
=head1 NAME
CGI::Simple::Standard - a wrapper module for CGI::Simple that provides a
function style interface
=head1 SYNOPSIS
use CGI::Simple::Standard qw( -autoload );
use CGI::Simple::Standard qw( :core :cookie :header :misc );
use CGI::Simple::Standard qw( param upload );
$CGI::Simple::Standard::POST_MAX = 1024; # max upload via post 1kB
$CGI::Simple::Standard::DISABLE_UPLOADS = 0; # enable uploads
@params = param(); # return all param names as a list
$value = param('foo'); # return the first value supplied for 'foo'
@values = param('foo'); # return all values supplied for foo
%fields = Vars(); # returns untied key value pair hash
$hash_ref = Vars(); # or as a hash ref
%fields = Vars("|"); # packs multiple values with "|" rather than "\0";
@keywords = keywords(); # return all keywords as a list
lib/CGI/Simple/Standard.pm view on Meta::CPAN
param( 'foo', 'some', 'new', 'values' ); # set new 'foo' values
param( -name=>'foo', -value=>'bar' );
param( -name=>'foo', -value=>['bar','baz'] );
append( -name=>'foo', -value=>'bar' ); # append values to 'foo'
append( -name=>'foo', -value=>['some', 'new', 'values'] );
Delete('foo'); # delete param 'foo' and all its values
Delete_all(); # delete everything
<INPUT TYPE="file" NAME="upload_file" SIZE="42">
$files = upload() # number of files uploaded
@files = upload(); # names of all uploaded files
$filename = param('upload_file') # filename of 'upload_file' field
$mime = upload_info($filename,'mime'); # MIME type of uploaded file
$size = upload_info($filename,'size'); # size of uploaded file
my $fh = $q->upload($filename); # open filehandle to read from
while ( read( $fh, $buffer, 1024 ) ) { ... }
# short and sweet upload
$ok = upload( param('upload_file'), '/path/to/write/file.name' );
print "Uploaded ".param('upload_file')." and wrote it OK!" if $ok;
$decoded = url_decode($encoded);
$encoded = url_encode($unencoded);
$escaped = escapeHTML('<>"&');
$unescaped = unescapeHTML('<>"&');
$qs = query_string(); # get all data in $q as a query string OK for GET
no_cache(1); # set Pragma: no-cache + expires
print header(); # print a simple header
lib/CGI/Simple/Standard.pm view on Meta::CPAN
AUTOLOAD sub will be called. The first time this happens it
will initialize a CGI::Simple object and then apply the requested method
(if it exists) to it. A fatal exception will be thrown if you try to use an
undefined method (function).
=head2 Specified Export
Alternatively you can specify the functions you wish to import. You can do
this on a per function basis like this:
use CGI::Simple::Standard qw( param upload query_string Dump );
or utilize the %EXPORT_TAGS that group functions into related groups.
Here are the groupings:
%EXPORT_TAGS = (
':html' => [ qw(:misc) ],
':standard' => [ qw(:core :access) ],
':cgi' => [ qw(:core :access) ],
':all' => [ qw(:core :misc :cookie :header :push :debug :cgi-lib
:access :internal) ],
':core' => [ qw(param add_param param_fetch url_param keywords
append Delete delete_all Delete_all upload
query_string parse_query_string parse_keywordlist
Vars save_parameters restore_parameters) ],
':misc' => [ qw(url_decode url_encode escapeHTML unescapeHTML put) ],
':cookie' => [ qw(cookie raw_cookie) ],
':header' => [ qw(header cache no_cache redirect) ],
':push' => [ qw(multipart_init multipart_start multipart_end
multipart_final) ],
':debug' => [ qw(Dump as_string cgi_error _cgi_object) ],
':cgi-lib' => [ qw(ReadParse SplitParam MethGet MethPost MyBaseUrl MyURL
MyFullUrl PrintHeader HtmlTop HtmlBot PrintVariables
lib/CGI/Simple/Standard.pm view on Meta::CPAN
=head2 Mix and Match
You can use the '-autoload' pragma, specifically named function imports and
tag group imports together if you desire.
=head1 $POST_MAX and $DISABLE_UPLOADS
If you wish to set $POST_MAX or $DISABLE_UPLOADS you must do this *after* the
use statement and *before* the first function call as shown in the synopsis.
Unlike CGI.pm uploads are disabled by default and the maximum acceptable
data via post is capped at 102_400kB rather than infinity. This is specifically
to avoid denial of service attacks by default. To enable uploads and to
allow them to be of infinite size you simply:
$CGI::Simple::Standard::POST_MAX = -1; # infinite size upload
$CGI::Simple::Standard::$DISABLE_UPLOADS = 0; # enable uploads
Alternatively you can specify the CGI.pm default values as shown above by
specifying the '-default' pragma in your use statement.
use CGI::Simple::Standard qw( -default ..... );
=head1 EXPORT
Nothing by default.
t/050.simple.t view on Meta::CPAN
'_store_globals(), 15' );
ok( defined $q->{'.globals'}->{'NPH'}, '_store_globals(), 16' );
ok( defined $q->{'.globals'}->{'DEBUG'}, '_store_globals(), 17' );
ok( defined $q->{'.globals'}->{'NO_NULL'}, '_store_globals(), 18' );
ok( defined $q->{'.globals'}->{'FATAL'}, '_store_globals(), 19' );
ok( defined $q->{'.globals'}->{'USE_CGI_PM_DEFAULTS'},
'_store_globals(), 20' );
# import() - used to set paragmas
my @args
= qw( -default -no_upload -unique_header -nph -no_debug -newstyle_url -no_undef_param );
undef_globals();
$q->import( @args );
is( $CGI::Simple::USE_CGI_PM_DEFAULTS, 1, 'import(), 1' );
is( $CGI::Simple::DISABLE_UPLOADS, 1, 'import(), 2' );
is( $CGI::Simple::NO_UNDEF_PARAMS, 1, 'import(), 3' );
is( $CGI::Simple::USE_PARAM_SEMICOLONS, 1, 'import(), 4' );
is( $CGI::Simple::HEADERS_ONCE, 1, 'import(), 5' );
is( $CGI::Simple::NPH, 1, 'import(), 6' );
is( $CGI::Simple::DEBUG, 0, 'import(), 7' );
undef_globals();
$q->import( qw ( -upload -oldstyle_url -debug ) );
is( $CGI::Simple::DISABLE_UPLOADS, 0, 'import(), 8' );
is( $CGI::Simple::USE_PARAM_SEMICOLONS, 0, 'import(), 9' );
is( $CGI::Simple::DEBUG, 2, 'import(), 10' );
undef_globals();
# _reset_globals()
$q->_reset_globals();
is( $CGI::Simple::DISABLE_UPLOADS, 0, '_reset_globals(), 1' );
is( $CGI::Simple::POST_MAX, -1, '_reset_globals(), 2' );
t/050.simple.t view on Meta::CPAN
is( $q->globals, '11', 'delete_all(), 2' );
$ENV{'CONTENT_TYPE'} = 'NOT multipart/form-data';
$q = CGI::Simple->new;
# delete_all() - scalar and array context, void/invalid/valid argument
is( join( ' ', $q->param ), 'name color', 'Delete_all(), 1' );
$q->Delete_all();
is( join( '', $q->param ), '', 'Delete_all(), 2' );
$ENV{'CONTENT_TYPE'} = 'application/x-www-form-urlencoded';
# upload() - invalid CONTENT_TYPE
$sv = $q->upload( 'foo' );
is( $sv, undef, 'upload() - invalid CONTENT_TYPE, 1' );
is(
$q->cgi_error(),
'Oops! File uploads only work if you specify ENCTYPE="multipart/form-data" in your <FORM> tag',
'upload() - invalid CONTENT_TYPE, 2'
);
$ENV{'CONTENT_TYPE'} = 'multipart/form-data';
# upload() - scalar and array context, void/invalid/valid argument
$sv = $q->upload();
@av = $q->upload();
is( $sv, undef, 'upload() - no files available, 1' );
is( join( ' ', @av ), '', 'upload() - no files available, 2' );
# upload() - scalar and array context, files available, void arg
$q->{'.filehandles'}->{$_} = $_ for qw( File1 File2 File3 );
$sv = $q->upload();
@av = $q->upload();
is( $sv, 3, 'upload() - files available, 1' );
is(
join( ' ', sort @av ),
'File1 File2 File3',
'upload() - files available, 2'
);
$q->{'.filehandles'} = {};
# upload() - scalar context, valid argument
open FH, $tmpfile or carp "Can't read $tmpfile $!\n";
my $data = join '', <FH>;
is( $data && 1, 1, 'upload(\'/some/path/to/myfile\') - real files, 1' );
seek FH, 0, 0;
$q->{'.filehandles'}->{'/some/path/to/myfile'} = \*FH;
my $handle = $q->upload( '/some/path/to/myfile' );
my $upload = join '', <$handle>;
is( $upload, $data,
'upload(\'/some/path/to/myfile\') - real files, 2' );
# upload() - scalar context, invalid argument
$sv = $q->upload( 'invalid' );
is( $sv, undef, 'upload(\'invalid\'), 1' );
is(
$q->cgi_error,
"No filehandle for 'invalid'. Are uploads enabled (\$DISABLE_UPLOADS = 0)? Is \$POST_MAX big enough?",
'upload(\'invalid\'), 2'
);
my $ok = $q->upload( '/some/path/to/myfile', "$tmpfile.bak" );
is( $ok, 1, 'upload(\'invalid\'), 3' );
open $handle, "$tmpfile.bak" or carp "Can't read $tmpfile.bak $!\n";
$upload = join '', <$handle>;
is( $upload, $data, 'upload(\'invalid\'), 4' );
$sv = $q->upload( '/some/path/to/myfile', "$tmpfile.bak" );
is( $sv, undef, 'upload(\'invalid\'), 5' );
close($handle);
unlink $tmpfile, "$tmpfile.bak";
$ENV{'CONTENT_TYPE'} = 'application/x-www-form-urlencoded';
$q = CGI::Simple->new;
# query_string() - scalar and array context, void/invalid/valid argument
$sv = $q->query_string();
is(
$sv,
t/070.standard.t view on Meta::CPAN
ok( defined $q->{'.globals'}->{'NPH'}, '_store_globals(), 16' );
ok( defined $q->{'.globals'}->{'DEBUG'}, '_store_globals(), 17' );
ok( defined $q->{'.globals'}->{'NO_NULL'}, '_store_globals(), 18' );
ok( defined $q->{'.globals'}->{'FATAL'}, '_store_globals(), 19' );
ok( defined $q->{'.globals'}->{'USE_CGI_PM_DEFAULTS'},
'_store_globals(), 20' );
# import() - used to set paragmas
my @args
= qw( -default -no_upload -unique_header -nph -no_debug -newstyle_url -no_undef_param );
undef_globals();
$q->import( @args );
is( $CGI::Simple::USE_CGI_PM_DEFAULTS, 1, 'import(), 1' );
is( $CGI::Simple::DISABLE_UPLOADS, 1, 'import(), 2' );
is( $CGI::Simple::NO_UNDEF_PARAMS, 1, 'import(), 3' );
is( $CGI::Simple::USE_PARAM_SEMICOLONS, 1, 'import(), 4' );
is( $CGI::Simple::HEADERS_ONCE, 1, 'import(), 5' );
is( $CGI::Simple::NPH, 1, 'import(), 6' );
is( $CGI::Simple::DEBUG, 0, 'import(), 7' );
undef_globals();
$q->import(
qw ( -default -upload -no_undefparams -oldstyle_url -npheader -debug )
);
is( $CGI::Simple::USE_CGI_PM_DEFAULTS, 1, 'import(), 8' );
is( $CGI::Simple::DISABLE_UPLOADS, 0, 'import(), 9' );
is( $CGI::Simple::NO_UNDEF_PARAMS, 1, 'import(), 10' );
is( $CGI::Simple::USE_PARAM_SEMICOLONS, 0, 'import(), 11' );
is( $CGI::Simple::NPH, 1, 'import(), 12' );
is( $CGI::Simple::DEBUG, 2, 'import(), 13' );
undef_globals();
t/070.standard.t view on Meta::CPAN
restore_parameters();
# delete_all() - scalar and array context, void/invalid/valid argument
is( join( ' ', param() ), 'name color', 'Delete_all(), 1' );
Delete_all();
is( join( '', param() ), '', 'Delete_all(), 2' );
$ENV{'CONTENT_TYPE'} = 'multipart/form-data';
# upload() - scalar and array context, void/invalid/valid argument
$sv = upload();
@av = upload();
is( $sv, undef, 'upload() - no files available, 1' );
is( join( ' ', @av ), '', 'upload() - no files available, 2' );
# upload() - scalar and array context, files available, void arg
$q = _cgi_object();
$q->{'.filehandles'}->{$_} = $_ for qw( File1 File2 File3 );
$sv = upload();
@av = upload();
is( $sv, 3, 'upload() - files available, 1' );
is(
join( ' ', sort @av ),
'File1 File2 File3',
'upload() - files available, 2'
);
$q->{'.filehandles'} = {};
# upload() - scalar context, valid argument
open FH, $tmpfile or carp "Can't read $tmpfile $!\n";
my $data = join '', <FH>;
is( $data && 1, 1, 'upload(\'/some/path/to/myfile\') - real files, 1' )
; # make sure we have data
seek FH, 0, 0;
$q->{'.filehandles'}->{'/some/path/to/myfile'} = \*FH;
my $handle = upload( '/some/path/to/myfile' );
my $upload = join '', <$handle>;
is( $upload, $data,
'upload(\'/some/path/to/myfile\') - real files, 2' );
# upload() - scalar context, invalid argument
$sv = upload( 'invalid' );
is( $sv, undef, 'upload(\'invalid\'), 1' );
is( cgi_error,
"No filehandle for 'invalid'. Are uploads enabled (\$DISABLE_UPLOADS = 0)? Is \$POST_MAX big enough?",
'upload(\'invalid\'), 2'
);
my $ok = upload( '/some/path/to/myfile', "$tmpfile.bak" );
is( $ok, 1, 'upload( \'/some/path/to/myfile\', \, 1' );
open $handle, "$tmpfile.bak" or carp "Can't read $tmpfile.bak $!\n";
$upload = join '', <$handle>;
is( $upload, $data, 'upload( \'/some/path/to/myfile\', \, 2' );
$sv = upload( '/some/path/to/myfile', "$tmpfile.bak" );
is( $sv, undef, 'upload( \'/some/path/to/myfile\', \, 3' );
close($handle);
unlink $tmpfile, "$tmpfile.bak";
$ENV{'CONTENT_TYPE'} = 'application/x-www-form-urlencoded';
restore_parameters();
# query_string() - scalar and array context, void/invalid/valid argument
$sv = query_string();
t/090.14838.t view on Meta::CPAN
plan tests => 1;
}
my $req = HTTP::Request::Common::POST(
'/dummy_location',
Content_Type => 'form-data',
Content => [ test_file => ["t/090.14838.t"], ]
);
# Useful in simulating an upload.
$ENV{REQUEST_METHOD} = 'POST';
$ENV{CONTENT_TYPE} = $req->header( 'Content-type' );
$ENV{CONTENT_LENGTH} = $req->content_length;
if ( open( CHILD, "|-" ) ) {
print CHILD $req->content;
close CHILD;
exit 0;
}
$CGI::Simple::DISABLE_UPLOADS = 0;
t/110.bad-upload.t view on Meta::CPAN
my $req = HTTP::Request::Common::POST(
'/dummy_location',
Content_Type => 'form-data',
Content => [
test_file =>
[ File::Spec->catfile( split /\//, "t/test_file.txt" ) ],
]
);
# Useful in simulating an upload.
$ENV{REQUEST_METHOD} = 'POST';
$ENV{CONTENT_TYPE} = 'multipart/form-data';
$ENV{CONTENT_LENGTH} = $req->content_length;
if ( open( CHILD, "|-" ) ) {
print CHILD $req->content;
close CHILD;
exit 0;
}
t/upload_info.t view on Meta::CPAN
use CGI::Simple;
# Set up a CGI environment
$ENV{REQUEST_METHOD} = 'POST';
$ENV{QUERY_STRING} = '';
$ENV{PATH_INFO} = '/somewhere/else';
$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
$ENV{SCRIPT_NAME} = '/cgi-bin/foo.cgi';
$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
$ENV{SERVER_PORT} = 8080;
$ENV{SERVER_NAME} = 'upload.info.com';
$ENV{CONTENT_TYPE}
= q{multipart/form-data; boundary=---------------------------10263292819275730631136676268};
$ENV{REQUEST_URI}
= "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
$ENV{HTTP_LOVE} = 'true';
my $body = <<EOF;
-----------------------------10263292819275730631136676268\r
Content-Disposition: form-data; name="rm"\r
\r
t/upload_info.t view on Meta::CPAN
\r
fake\r
-----------------------------10263292819275730631136676268--\r
EOF
$ENV{CONTENT_LENGTH} = length $body;
my $h;
if ("$]" < 5.008) {
require File::Temp;
$h = File::Temp->new(TEMPLATE => 'CGI-Simple-upload_info-XXXXXX', TMPDIR => 1);
$h->print($body);
$h->seek(0, 0);
}
else {
open $h, '<', \$body;
}
my $q = CGI::Simple->new( $h );
ok( $q->upload_info( $q->param( 'file0' ), 'mime' ) eq 'image/png',
'Guess mime for image/png' );
ok( $q->upload_info( $q->param( 'file1' ), 'mime' ) eq 'image/svg+xml',
'Guess mime for image/svg+xml' );
ok(
$q->upload_info( $q->param( 'file2' ), 'mime' ) eq
'application/vnd.ms-excel',
'Guess mime for application/vnd.ms-excel'
);
#2010-03-19 by Krasimir Berov, based on 041.multipart.t
xt/pod-coverage.t view on Meta::CPAN
{
private => [
qr{^BUILD|DEMOLISH|AUTOMETHOD|START$},
qr{^_},
qr{^\(\"\"|as_string|CgiDie|CgiError|charset|CLEAR|\(cmp|compare|Delete|DELETE$},
qr{^Delete_all|DESTROY|ebcdic|escape|escapeHTML|EXISTS|expires|fetch|FETCH$},
qr{^FIRSTKEY|HtmlBot|HtmlTop|import|init|loader|make_attributes|MethGet$},
qr{^MethPost|MyBaseUrl|MyFullUrl|MyURL|new|NEXTKEY|os|parse|PrintHeader$},
qr{^PrintVariables|query_string|raw_fetch|read_from_cmdline|ReadParse$},
qr{^rearrange|save_parameters|SplitParam|STORE|TIEHASH|unescape|unescapeHTML$},
qr{^upload_fieldnames|uploadInfo|utf8_chr$}
]
}
);
( run in 3.721 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )