CGI-Lite
view release on metacpan or search on metacpan
* v3.01_02 - 8th May 2018
BUG FIX: Uploads on MSWin32 were not correctly converted if the first
character of a buffer was LF. Changed regex to negative lookarounds.
* v3.01_01 - 4th May 2018
BUG FIX: Uploads could fail if n * buffer_size fell inside the boundary
marker. Thanks pru-mike (PR 1). (possibly fixes issue 116670)
BUG FIX: Changing the boundary marker for second and subsequent uploads
causes errors. Thanks pru-mike (PR 1). (issue 125130)
Test suite enhanced: now with Test::Vars (0.12) and fix of tmp filename
race condition.
* v3.01 - 10th December 2015
No changes from v3.00_02
* v3.00_02 - 27th November 2015
Improved test suite: better coverage, skipped failling tests for
Microsoft systems which don't use/honour normal permissions, silenced
noisy tests on older perls.
* v2.99_01 (pre-release for 3.0) - 31st March 2015
Source amended to pass perlcritic. String evals removed or replaced.
Strictures added to module and examples. All filehandles are now
lexicals. Consistent source formatting applied to module (perltidy).
deny_uploads and set_size_limit added.
All active public subroutines are now methods.
print_cookie_data and print_form_data have been removed. They had been
deprecated for well over a decade.
escape_dangerous_chars has been removed. It has been considered a
security risk since version 2.0.
* v2.04_05 - 11th October 2014
* v2.04_02 - 7th October 2014
Upload tests fixed to solve two problems for MSWin32 users:
permissions-based tests skipped and coversion algorithms for text MIME
types improved.
* v2.04_01 - 6th October 2014
Full test coverage of non-deprecated features.
BUG FIX: Multi-file uploads could break if the buffer end occured in the
headers of one of the files. (issue 99294)
BUG FIX: $cgi->set_platform ('macintosh') erroneously set platform to
'PC' because the regex was not anchored to the start. 'macintosh'
now results in platform 'Mac' as it should.
Version control moved to git.
Makefile.PL extended to include resources (where available).
* v2.04 - 4th July 2014
Minor documentation fixes and explanation of the proposed split into
legacy/trunk branches. No code changes from 2.03_02.
* v2.03_02 - 17th June 2014
The uploads have had a minor change which may solve the windows size
difference failures. More diagnostics were added to the failures if it
does not.
* v2.03_01 - 13th June 2014
The test multi-part upload data in the test suite has been fixed to have
the correct (CRLF) line terminators. These tests should now pass for
Microsoft users.
The documentation has been amended to reflect the change of maintainer.
* v2.03 - 25th May 2014
Maintainer change: Pete Houston has taken over maintenance from Smylers.
A test suite has been created.
BUG FIX: Cleared up some uninitialised value warnings emitted when query
strings are missing an entire key-value pair eg: "&foo=bar" (issue
38448).
BUG FIX: If the user calls parse_form_data as a class method without a
query string, the method now gives up early and silently
(issue 6180).
BUG FIX: In form-data uploads, the boundary string was not properly
escaped and therefore would not match when it contained
metacharacters (issue 29053).
BUG FIX: The content type for url-encoded forms now matches on the MIME
type only, so additional charset fields are allowed (issues 16236,
34827 and 41666).
BUG FIX: Leading/trailling whitespace is now stripped from cookie names
and values.
has multiple values which caused more than one array to be allocated.
Just a note: if you call get_multiple_values method with a scalar
value, the method no longer returns an undef, but the value itself.
As of this version, you can pass a request method (optional) to the
parse_form_data method. This gives you a bit more flexibility when
dealing with forms.
The set_file_type method now works as it should. In earlier versions,
CGI_Lite created "handles" in all cases. Added the close_all_files
method to close uploaded files that are opened as a result of passing
"handle" to set_file_type.
The print_form_data and print_cookie_data are deprecated as of this
version, but have not been removed (for compatibility reasons). It's
better to use the print_data method, which prints the key/value pairs
in the order they were parsed. As a side effect of this change,
if you want to parse form data and cookies in an application,
you have to create two instances of the CGI_Lite object, which
only makes sense.
Added the get_ordered_keys method which will return the list
of _keys_ in the order in which they were parsed. Modified the
wrap_textarea method; it now works properly.
Also, added the add_mime_type, remove_mime_type and get_mime_types
methods to deal with EOL translation based on MIME types. Added
the filter_filename method to alter the way in which uploaded
files are named. Added the add_timestamp method which allows you
to turn off timestamps on uploaded files. NOTE: CGI_Lite no longer
returns the full path of the uploaded file, but simply, the file name.
Added a set of miscellaneous functions: browser_escape, url_encode,
url_decode, is_dangerous, escape_dangerous_chars. CGI_Lite now handles
errors better; you can use the newly implemented is_error, and
get_error_message methods. I've bought back the return_error
method, which you can use to return errors to the browser and
exit. However, this method no longer outputs the HTTP header,
as it did in versions prior to v1.7.
In addition, this version allows you to debug your CGI scripts
"offline" by letting you pass query information through standard
input. I got this idea from CGI.pm, though it's handled a bit
differently. Thanks Lincoln!
* v1.7 - December 28, 1996
Maybe, I should release this version as 2.0 :-) There were a lot of
changes made:
- *Totally* re-wrote the multipart form parsing algorithm. It's
_much_ more efficient with large uploads. It still needs tweaking
to remove the $` and $' -- maybe in the next release.
- Multiple values per field are no longer returned as a null-character
delimited string. Instead, a reference to an array is returned.
You need to de-reference, or call the get_multiple_values method
to get at the array. There was no way I could make this backward
compatible. Please check your scripts, because a few might break.
I apologize.
- Fields containing more than one value in multipart forms are now
handled correctly.
- Added the wrap_textarea method that allows you to neatly "wrap"
long strings.
- You can now parse/decode cookies in much the same manner as forms.
- When saving uploaded files, the module adds a timestamp. As of this
version, the timestamp is added to the front of the file,
as opposed to the end, so that file extensions are preserved.
Note: this module makes no effort to URL decode the filename for
security reasons.
- Added the following new methods: set_buffer_size, parse_cookies,
print_cookie_data, wrap_textarea, get_multiple_values and
create_variables.
- Removed the return_error subroutine and, instead, added _error,
which dumps a message to STDERR and dies.
- You can now install this module in a convenient manner. Also,
* v1.61 - January 1, 1996
Fixed a minor bug that resulted in end of line characters being removed
from certain binary files.
* v1.6 - December 30, 1995
Added code to handle other header information that the browser might
send after the "Content-Disposition" header.
Added set_platform function so that uploaded text files display
properly.
The function set_file_type no longer returns a status.
Fixed spacing within code.
* v1.5 - November 13, 1995
Corrected two major bugs that caused several fields to be lost (when
the fields before them were either too small or too large).
Added code to make sure that there are no "\r\n" characters in the
regular form fields. Textarea elements and fields that contain uploaded
information from different platforms (i.e Macintosh and PC) will
contain "\r" characters.
* v1.4 - October 15, 1995
Added pod style documentation. Now you can see this manual page by doing
the following:
pod2man CGI_Lite.pm | nroff -man | more
CHANGES Revision History
examples/cookies Example 1
examples/file Example 2
examples/get_post Example 3
examples/post Example 4
examples/print Example 5
examples/reference Example 6
examples/upload Example 7
lib/CGI/Lite.pm CGI::Lite Module
LICENSE Licence details
Makefile.PL Makefile Generator
MANIFEST This File
README Readme File
t/basic.t
t/cookie.t
t/forms.t
t/good_upload.txt
t/large_file_upload.txt
t/mime_upload.txt
t/other_boundary.txt
t/post_stdin.txt
t/post_text.txt
t/upload_no_files.txt
t/upload_no_headers.txt
t/upload_no_trailing_files.txt
t/uploads.t
TODO Future work?
xt/release/kwalitee.t
xt/release/vars.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
This is a new release of the 3.x branch. Please be aware of the API
changes from 2.x with particular reference to the deprecated and obsolete
subroutines and methods.
DESCRIPTION
-----------
This module can be used to decode CGI form data, query strings, file
uploads and cookies in a very simple manner.
It has only one dependency and is therefore relatively fast to instantiate.
This makes it well suited to a non-persistent CGI scenario.
NEW IN THIS VERSION
-------------------
These are the changes since the last general release (3.02).
examples/file view on Meta::CPAN
#!/usr/bin/perl
# Simply displays the key/value pairs. Here is how the output
# would look for multipart/form-data forms:
#
# full_name = Foo Bar
# picture = 812186386__bar.gif
# readme = 812186386__bar.txt
#
# As of v1.8, CGI::Lite no longer returns the entire path name for
# uploaded files.
use strict;
use warnings;
use CGI::Lite;
my $cgi = CGI::Lite->new;
my $dir = '/var/tmp';
$cgi->set_directory ($dir) or die "Cannot use directory $dir.\n";
examples/upload view on Meta::CPAN
# Set the platform. "Unix" is the default. The method accepts
# platforms in a case insensitive manner, so you can pass
# "UNIX", "Unix", "unix", etc.
$cgi->set_platform ("Unix");
# Set the buffer size to 1024 bytes (1K). This is the default.
$cgi->set_buffer_size (1024);
# Let's change the way uploaded files are named!
$cgi->filter_filename (\&my_way);
# Tell the module to return filehandles.
$cgi->set_file_type ('handle');
# We want CGI::Lite to perform EOL conversion for all files that have the
# following MIME types:
#
examples/upload view on Meta::CPAN
my $data = $cgi->parse_form_data;
print "Content-type: text/plain", "\n\n";
if ($cgi->is_error) {
my $error_message = $cgi->get_error_message;
print <<End_of_Error;
Oops! An error occurred while uploading the file. Please go back
and try to upload the file again. In the meanwhile, you may
want to report the following error to the Webmaster:
$error_message
Sorry, and thanks for being patient!
End_of_Error
} else {
# Dereferences the variable to get a filehandle. Then,
# iterates through the file, displaying each line to STDOUT.
#
# NOTE: $readme also contains the name of the file.
my $readme = $data->{readme};
print <<End_of_Header;
Thanks for uploading the file: $readme to our server. Just
in case you're interested, here are the contents of your uploaded
file:
End_of_Header
while (<$readme>) {
print;
}
# Make sure to close the file!
lib/CGI/Lite.pm view on Meta::CPAN
my $form = $cgi->parse_new_form_data;
my $status = $cgi->is_error;
if ($status) {
my $message = $cgi->get_error_message;
die $message;
}
=head1 DESCRIPTION
This module can be used to decode form data, query strings, file uploads
and cookies in a very simple manner.
It has only one dependency and is therefore relatively fast to
instantiate. This makes it well suited to a non-persistent CGI scenario.
=head1 METHODS
Here are the methods used to process the forms and cookies:
lib/CGI/Lite.pm view on Meta::CPAN
This handles the following types of requests: GET, HEAD and POST.
By default, CGI::Lite uses the environment variable REQUEST_METHOD to
determine the manner in which the query/form information should be
decoded. However, it may also be passed a valid request
method as a scalar string to force CGI::Lite to decode the information in
a specific manner.
my $params = $cgi->parse_form_data ('GET');
For multipart/form-data, uploaded files are stored in the user selected
directory (see L<set_directory|/set_directory>). If timestamp mode is on (see
L<add_timestamp|/add_timestamp>), the files are named in the following format:
timestamp__filename
where the filename is specified in the "Content-disposition" header.
I<NOTE:>, the browser URL encodes the name of the file. This module
makes I<no> effort to decode the information for security reasons.
However, this can be achieved by creating a subroutine and then using
the L<filter_filename|/filter_filename> method.
lib/CGI/Lite.pm view on Meta::CPAN
of any errors can be checked by calling the L<is_error|/is_error> method.
my $msg = $cgi->get_error_message ();
Returns the error message as a plain text string.
=head2 set_platform
This method is used to set the platform on which the web server is
running. CGI::Lite uses this information to translate end-of-line
(EOL) characters for uploaded files (see the L<add_mime_type|/add_mime_type> and
L<remove_mime_type|/remove_mime_type> methods) so that they are accounted for properly on
that platform.
$cgi->set_platform ($platform);
$platform can be any of (case insensitive):
Unix EOL: \012 = \n
Windows, Windows95, DOS, NT, PC EOL: \015\012 = \r\n
Mac or Macintosh EOL: \015 = \r
lib/CGI/Lite.pm view on Meta::CPAN
To set a specific limit on the total size of the request (in bytes) call
this method with that size as the sole argument. A size of zero
effectively disables POST requests. To specify an unlimited size (the
default) use an argument of -1.
my $size_limit = $cgi->set_size_limit (10_000_000);
Returns the new value if provided, otherwise the existing value.
=head2 deny_uploads
To prevent any file uploads simply call this method with an argument of
1. To enable them again, use an argument of zero.
my $deny_uploads = $cgi->deny_uploads (1);
Returns the new value if provided, otherwise the existing value.
=head2 force_unique_cookies
It is generally considered a mistake to send an HTTP request with
multiple cookies of the same name. However, the RFC is somewhat vague
regarding how servers are expected to handle such an eventuality.
CGI::Lite has always allowed such multiple values and returned them as
an arrayref to be entirely consistent with the same treatment of
lib/CGI/Lite.pm view on Meta::CPAN
Note that if there is already an item of data in the CGI::Lite object
which matches the name of a cookie then the subsequent L<parse_cookies|/parse_cookies>
call will treat the new cookie value as another data item and the resulting
behaviour will be affected by this method. This is another reason to
call L<parse_cookies|/parse_cookies> before L<parse_form_data|/parse_form_data>.
Returns the new value if provided, otherwise the existing value.
=head2 set_directory
Used to set the directory where the uploaded files will be stored
(only applies to the I<multipart/form-data> encoding scheme).
my $tmpdir = '/some/dir';
$cgi->set_directory ($tmpdir) or
die "Directory $tmpdir cannot be used.\n";
This function should be called I<before> L<parse_form_data|/parse_form_data>,
or else the directory defaults to "/tmp". If the application cannot
write to the directory for whatever reason, an error status is returned.
Returns 0 on error, 1 otherwise.
=head2 close_all_files
$cgi->close_all_files;
All uploaded files that are opened as a result of calling L<set_file_type|/set_file_type>
with the "handle" argument can be closed in one shot by calling this
method which takes no arguments and returns undef.
=head2 add_mime_type
By default, EOL characters are translated for all uploaded files
with specific MIME types (i.e. text/plain, text/html, etc.).
This method can be used to add to the list of MIME types. For example,
if you want CGI::Lite to translate EOL characters for uploaded
files of I<application/mac-binhex40>, then you would do this:
$cgi->add_mime_type ('application/mac-binhex40');
Returns 1 if this MIME type is newly added, 0 otherwise.
=head2 remove_mime_type
This method is the converse of L<add_mime_type|/add_mime_type>. It allows for the
removal of a particular MIME type. For example, if you do not want
CGI::Lite to translate EOL characters for uploaded files of type I<text/html>,
then you would do this:
$cgi->remove_mime_type ('text/html');
Returns 1 if this MIME type is newly deleted, 0 otherwise.
=head2 get_mime_types
Returns the list of the
MIME types for which EOL translation is performed.
my @mimelist = $cgi->get_mime_types ();
=head2 get_upload_type
Returns the MIME type of uploaded data. Takes the field name as a scalar
argument. This previously undocumented function was named print_mime_type
prior to version 3.0.
my $this_type = $cgi->get_upload_type ($field);
Returns the MIME type as a scalar string if single valued, an arrayref
if multi-valued or undef if the argument does not exist or has no type.
=head2 set_file_type
The I<names> of uploaded files are returned by default when
the L<parse_form_data|/parse_form_data> method is called . But if this method is passed the string "handle" as its argument beforehand then
the I<handles> to the files are returned instead. However, the name
of each handle still corresponds to the filename.
# $fh has been set to one of 'handle' or 'file'
$cgi->set_file_type ($fh);
This function should be called I<before> any call to L<parse_form_data|/parse_form_data>, or
else it will have no effect.
=head2 add_timestamp
By default, a timestamp is added to the front of uploaded files.
However, there is the option of completely turning off timestamp mode
(value 0), or adding a timestamp only for existing files (value 2).
$cgi->add_timestamp ($tsflag);
# where $tsflag takes one of these values
# 0 = no timestamp
# 1 = timestamp all files (default)
# 2 = timestamp only if file exists
=head2 filter_filename
This method is used to change the manner in which uploaded
files are named. For example, if you want uploaded filenames
to be all upper case, you can use the following code:
$cgi->filter_filename (\&make_uppercase);
$cgi->parse_form_data;
# ...
sub make_uppercase
{
my $file = shift;
lib/CGI/Lite.pm view on Meta::CPAN
buffer_size => 1024,
timestamp => 1,
filter => undef,
web_data => {},
ordered_keys => [],
all_handles => [],
error_status => 0,
error_message => undef,
file_size_limit => 2097152, # Unused as yet
size_limit => -1,
deny_uploads => 0,
unique_cookies => 0,
};
$self->{convert} = {
'text/html' => 1,
'text/plain' => 1
};
$self->{file} = {Unix => '/', Mac => ':', PC => '\\'};
$self->{eol} = {Unix => "\012", Mac => "\015", PC => "\015\012"};
bless ($self, $class);
return $self;
}
sub Version
{
return $VERSION;
}
sub deny_uploads
{
my ($self, $newval) = @_;
if (defined $newval) {
$self->{deny_uploads} = $newval ? 1 : 0;
}
return $self->{deny_uploads};
}
sub set_size_limit
{
my ($self, $limit) = @_;
return unless defined $limit;
if ($limit =~ /^[0-9]+$/) {
$self->{size_limit} = $limit;
} else {
$self->{size_limit} = -1;
lib/CGI/Lite.pm view on Meta::CPAN
if (!$content_type
|| ($content_type =~ /^application\/x-www-form-urlencoded/)) {
read (STDIN, $post_data, $content_length);
$self->_decode_url_encoded_data (\$post_data, 'form');
return wantarray ? %{$self->{web_data}} : $self->{web_data};
} elsif ($content_type =~ /multipart\/form-data/) {
if ($self->{deny_uploads}) {
$self->_error ("multipart/form-data unacceptable when "
. "deny_uploads is set");
return;
}
($boundary) = $content_type =~ /boundary=(\S+)$/;
$self->_parse_multipart_data ($content_length, $boundary);
return wantarray ? %{$self->{web_data}} : $self->{web_data};
} else {
$self->_error ('Invalid content type!');
}
lib/CGI/Lite.pm view on Meta::CPAN
my $value = $self->{web_data}->{$key};
if (ref $value) {
print "$key = @$value$eol";
} else {
print "$key = $value$eol";
}
}
}
sub get_upload_type
{
my ($self, $field) = @_;
return ($self->{'mime_types'}->{$field});
}
sub wrap_textarea
{
my ($self, $string, $length) = @_;
my ($new_string, $platform, $eol);
t/large_file_upload.txt view on Meta::CPAN
Content-Type: text/plain
This is a test of a plain text document.
It has several lines of text,
and can be used to test how the larger documents
are handled by CGI::Lite.
It is not intended for any other purpose.
There has to be a lot of text in here because we need it to be several
times the size of the buffer in order to test all the possible
situations which the upload handler will encounter.
The smallest buffer size is 256 of your puny Earth bytes and therefore
this file ought to be somewhat in excess of three times that just to be
sure. That's a lot of text when you stop to think about it and, as it
turns out, even more when you have to come up with it.
Why on earth are you reading this in the first place? It's really just
placeholder text. I could have welched out and used Lorem Ipsum instead
but how dull and uninspiring would that be? Designers, somewhat
surprisiingly, appear to have little creativity when it comes to such
placeholder text. Perhaps their programmer friends could help them out
t/other_boundary.txt view on Meta::CPAN
Content-Type: text/plain
This is a test of a plain text document.
It has several lines of text,
and can be used to test how the larger documents
are handled by CGI::Lite.
It is not intended for any other purpose.
There has to be a lot of text in here because we need it to be several
times the size of the buffer in order to test all the possible
situations which the upload handler will encounter.
The smallest buffer size is 256 of your puny Earth bytes and therefore
this file ought to be somewhat in excess of three times that just to be
sure. That's a lot of text when you stop to think about it and, as it
turns out, even more when you have to come up with it.
Why on earth are you reading this in the first place? It's really just
placeholder text. I could have welched out and used Lorem Ipsum instead
but how dull and uninspiring would that be? Designers, somewhat
surprisiingly, appear to have little creativity when it comes to such
placeholder text. Perhaps their programmer friends could help them out
t/uploads.t view on Meta::CPAN
#
#===============================================================================
#
# FILE: uploads.t
#
# DESCRIPTION: Test of multipart/form-data uploads
#
# FILES: good_upload.txt
# BUGS: ---
# NOTES: This borrows very heavily from upload.t in CGI.pm
# AUTHOR: Pete Houston (cpan@openstrike.co.uk)
# COMPANY: Openstrike
# CREATED: 20/05/14 14:01:34
#===============================================================================
use strict;
use warnings;
use Test::More tests => 14269;
t/uploads.t view on Meta::CPAN
# Set up a CGI environment
$ENV{REQUEST_METHOD} = 'POST';
$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} = 'there.is.no.try.com';
$ENV{QUERY_STRING} = '';
my $datafile = 't/good_upload.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
$ENV{CONTENT_TYPE} = q#multipart/form-data; boundary=`!"$%^&*()-+[]{}'@.?~\#|aaa#;
my $uploaddir = 'tmpcgilite';
mkdir $uploaddir unless -d $uploaddir;
my ($cgi, $form) = post_data ($datafile, $uploaddir);
is ($cgi->is_error, 0, 'Parsing data with POST');
like ($form->{'does_not_exist_gif'}, qr/[0-9]+__does_not_exist\.gif/, 'Second file');
like ($form->{'100;100_gif'}, qr/[0-9]+__100;100\.gif/, 'Third file');
like ($form->{'300x300_gif'}, qr/[0-9]+__300x300\.gif/, 'Fourth file');
is ($cgi->get_upload_type ('300x300_gif'), 'image/gif', 'MIME Type');
# Same, but check it can also return as a hash
($cgi, $form) = post_data ($datafile, $uploaddir, undef, 1);
is ($cgi->is_error, 0, 'Parsing data with POST into hash');
like ($form->{'does_not_exist_gif'}, qr/[0-9]+__does_not_exist\.gif/,
'Second file from hash');
like ($form->{'100;100_gif'}, qr/[0-9]+__100;100\.gif/,
'Third file from hash');
like ($form->{'300x300_gif'}, qr/[0-9]+__300x300\.gif/,
'Fourth file from hash');
my @files = (0, 0);
is (ref $form->{'hello_world'}, 'ARRAY',
'Duplicate file fieldnames become array') and
@files = @{$form->{'hello_world'}};
like ($files[0], qr/[0-9]+__goodbye_world\.txt/,
'First duplicate file has correct name');
like ($files[1], qr/[0-9]+__hello_world\.txt/,
'Second duplicate file has correct name');
my $res = $cgi->get_upload_type ('hello_world');
ok (defined $res, 'Duplicate fields have upload type set');
is (ref $res, 'ARRAY', 'Duplicate fields have array ref of upload types');
is ($res->[0], 'text/plain', 'Duplicate fields have correct upload types');
@files = qw/does_not_exist_gif 100;100_gif 300x300_gif/;
my @sizes = qw/0 896 1656/;
for my $i (0..2) {
my $file = "$uploaddir/$form->{$files[$i]}";
ok (-e $file, "Uploaded file exists ($i)") or warn "Name = '$file'\n" . $cgi->get_error_message;
is ((stat($file))[7], $sizes[$i], "File size check ($i)") or
warn_tail ($file);
}
is ($cgi->set_directory ('/srhslgvsgnlsenhglsgslvngh'), 0,
'Set directory (non-existant)');
my $testdir = 'testperms';
mkdir $testdir, 0400;
t/uploads.t view on Meta::CPAN
'Correct mime types after removal');
# Filename tests
$cgi->add_timestamp (-1);
is ($cgi->{timestamp}, 1, 'Timestamp < 0');
$cgi->add_timestamp (3);
is ($cgi->{timestamp}, 1, 'Timestamp > 3');
$cgi->add_timestamp (0);
is ($cgi->{timestamp}, 0, 'timestamp is zero');
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 0, 'Parsing data with POST');
like ($form->{'does_not_exist_gif'}, qr/^does_not_exist\.gif/, 'Second file');
like ($form->{'100;100_gif'}, qr/^100;100\.gif/, 'Third file');
like ($form->{'300x300_gif'}, qr/^300x300\.gif/, 'Fourth file');
unlink ("$uploaddir/300x300.gif");
$cgi->add_timestamp (1);
is ($cgi->{timestamp}, 1, 'timestamp is 1');
$cgi->add_timestamp (2);
is ($cgi->{timestamp}, 2, 'timestamp is 2');
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 0, 'Parsing data with POST');
like ($form->{'does_not_exist_gif'}, qr/[0-9]+__does_not_exist\.gif/, 'Second file');
like ($form->{'100;100_gif'}, qr/[0-9]+__100;100\.gif/, 'Third file');
like ($form->{'300x300_gif'}, qr/^300x300\.gif/, 'Fourth file');
sub cleanfile {
my $name = shift;
$name =~ s/[^a-z0-9\._-]+/_/ig;
return $name
}
unlink "$uploaddir/100_100.gif" if -e "$uploaddir/100_100.gif";
$cgi->filter_filename (\&cleanfile);
ok (defined $cgi->{filter}, 'Filename filter set');
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 0, 'Parsing data with POST');
like ($form->{'does_not_exist_gif'}, qr/^[0-9]+__does_not_exist\.gif/, 'Second file');
like ($form->{'100;100_gif'}, qr/^100_100\.gif/, 'Third file');
like ($form->{'300x300_gif'}, qr/^[0-9]+__300x300\.gif/, 'Fourth file');
# Buffer size setting tests
is ($cgi->set_buffer_size(1), 256, 'Buffer size too low');
is ($cgi->set_buffer_size(1000000), $ENV{CONTENT_LENGTH}, 'Buffer size too high');
# Tests without CONTENT_LENGTH
my $tmpcl = $ENV{CONTENT_LENGTH};
$ENV{CONTENT_LENGTH} = 0;
is ($cgi->set_buffer_size(1), 0, 'Buffer size unset without CONTENT_LENGTH');
$ENV{CONTENT_LENGTH} = $tmpcl;
# File type tests
unlink "$uploaddir/100_100.gif" if -e "$uploaddir/100_100.gif";
$cgi->set_file_type ('jibber');
is ($cgi->{file_type}, 'name', 'File type defaults to name');
$cgi->set_file_type ('handle');
is ($cgi->{file_type}, 'handle', 'File type set to handle');
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 0, 'Parsing data with POST');
like ($form->{'does_not_exist_gif'}, qr/^[0-9]+__does_not_exist\.gif/, 'Second file');
like ($form->{'100;100_gif'}, qr/^100_100\.gif/, 'Third file');
like ($form->{'300x300_gif'}, qr/^[0-9]+__300x300\.gif/, 'Fourth file');
# Check the handles
my $imgdata = '';
my $handle = $form->{'100;100_gif'};
while (<$handle>) {
$imgdata .= $_;
}
is (length ($imgdata), 896, 'File handle upload');
is (eof ($form->{'300x300_gif'}), '', 'File open');
$cgi->close_all_files;
is (eof ($form->{'300x300_gif'}), 1, 'File closed');
# Tests required for these:
# check mime types are honoured on upload
# The text/plain should be altered, but the text/html should not.
# Run this with a wide window of buffer sizes to ensure there are no
# edge cases.
$datafile = 't/mime_upload.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
$cgi->add_timestamp (0);
$cgi->set_file_type ('name');
@files = qw/plain_txt html_txt plain_win_txt html_win_txt/;
@sizes = qw/186 212 186 219/;
@sizes = qw/191 212 191 219/ if $^O eq 'MSWin32';
for my $buf_size (256 .. 1500) {
$cgi->set_buffer_size($buf_size);
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 0, "Parsing data with POST (buffer size $buf_size)");
for my $i (0..3) {
my $file = "$uploaddir/$form->{$files[$i]}";
ok (-e $file, "Uploaded file exists ($i - buffer size $buf_size") or
warn "Name = '$file'\n" . $cgi->get_error_message;
is ((stat($file))[7], $sizes[$i],
"File size check ($i - buffer size $buf_size)") or
warn_tail ($file);
unlink ($file);
}
}
is ($cgi->deny_uploads (), 0, 'Set deny_uploads undef');
is ($cgi->deny_uploads (0), 0, 'Set deny_uploads false');
is ($cgi->deny_uploads (1), 1, 'Set deny_uploads true');
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 1, "Upload successfully denied");
# Upload but no files
$datafile = 't/upload_no_files.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
($cgi, $form) = post_data ($datafile);
is ($cgi->is_error, 0, 'Parsing upload data with no files');
# Special case where the file uploads appear not last
$datafile = 't/upload_no_trailing_files.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
($cgi, $form) = post_data ($datafile, $uploaddir);
is ($cgi->is_error, 0, 'Parsing upload data with no trailling files');
$datafile = 't/large_file_upload.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
@sizes = (1027);
@sizes = (1049) if $^O eq 'MSWin32';
for my $buf_size (256 .. 1250) {
$cgi->set_buffer_size ($buf_size);
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 0,
"Parsing upload data with a large file - buffer size $buf_size");
my $file = "$uploaddir/$form->{plain_txt}";
ok (-e $file, "Uploaded file exists ($file - buffer size $buf_size") or
warn "Name = '$file'\n" . $cgi->get_error_message;
is ((stat($file))[7], $sizes[0],
"File size check ($file - buffer size $buf_size)") or
warn_tail ($file);
unlink ($file);
}
$ENV{CONTENT_LENGTH} += 500;
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 1, 'Parsing upload data with over large content length');
{
$datafile = 't/other_boundary.txt';
local $ENV{CONTENT_TYPE} = q#multipart/form-data; boundary=otherstring#;
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 0, 'Parsing upload data with different boundary');
ok (exists $form->{other_file}, 'Parsing of different boundary complete');
my $file = "$uploaddir/$form->{other_file}";
ok (-e $file, "Uploaded file exists for different boundary ($file)") or
warn "Name = '$file'\n" . $cgi->get_error_message;
is ((stat($file))[7], $sizes[0],
"File size check for different boundary ($file)") or
warn_tail ($file);
unlink ($file);
}
# Use Test::Trap where available to test lack of wanrings
SKIP: {
skip "Test::Trap not available", 2 unless $have_test_trap;
$datafile = 't/upload_no_headers.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
my @r = trap { ($cgi, $form) = post_data ($datafile, $uploaddir); };
is ($trap->stderr, '',
'Upload of params with no Content-Type is quiet');
is_deeply ($form->{foolots}, [qw/bar baz quux/],
'Upload of params with no Content-Type is correct');
}
# Special case where the file uploads appear not last
sub post_data {
my ($datafile, $dir, $cgi, $as_array) = @_;
local *STDIN;
open STDIN, '<', $datafile
or die "Cannot open test file $datafile: $!";
binmode STDIN;
$cgi ||= CGI::Lite->new;
$cgi->set_platform ('DOS') if $^O eq 'MSWin32';
$cgi->set_directory ($dir);
if ($as_array) {
my %form = $cgi->parse_new_form_data;
close STDIN;
return ($cgi, \%form);
}
my $form = $cgi->parse_new_form_data;
close STDIN;
return ($cgi, $form);
}
sub warn_tail {
# If there's a size mismatch on the uploaded files, dump the end of
# the file here. Ideally this should never be called.
my $file = shift;
my $n = 32;
open (my $in, '<', $file) or return warn "Cannot open $file for reading. $!";
binmode $in;
local $/ = undef;
my $contents = <$in>;
close $file;
my $lastn = substr ($contents, 0 - $n);
foreach (split (//, $lastn, $n)) {
( run in 1.255 second using v1.01-cache-2.11-cpan-b16cb0d3907 )