"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "t/uploads.t" between
CGI-Lite-3.01.tar.gz and CGI-Lite-3.02.tar.gz

About: CGI-Lite is a Perl module to decode form and query information, including file uploads, as well as cookies in a very simple manner.

uploads.t  (CGI-Lite-3.01):uploads.t  (CGI-Lite-3.02)
skipping to change at line 19 skipping to change at line 19
# BUGS: --- # BUGS: ---
# NOTES: This borrows very heavily from upload.t in CGI.pm # NOTES: This borrows very heavily from upload.t in CGI.pm
# AUTHOR: Pete Houston (cpan@openstrike.co.uk) # AUTHOR: Pete Houston (cpan@openstrike.co.uk)
# COMPANY: Openstrike # COMPANY: Openstrike
# CREATED: 20/05/14 14:01:34 # CREATED: 20/05/14 14:01:34
#=============================================================================== #===============================================================================
use strict; use strict;
use warnings; use warnings;
use Test::More tests => 11280; use Test::More tests => 14268;
use lib './lib'; use lib './lib';
# Test exits and outputs; # Test exits and outputs;
my $have_test_trap; my $have_test_trap;
our $trap; # Imported our $trap; # Imported
BEGIN { BEGIN {
eval { eval {
require Test::Trap; require Test::Trap;
Test::Trap->import (qw/trap $trap :flow Test::Trap->import (qw/trap $trap :flow
skipping to change at line 91 skipping to change at line 91
'Second duplicate file has correct name'); 'Second duplicate file has correct name');
my $res = $cgi->get_upload_type ('hello_world'); my $res = $cgi->get_upload_type ('hello_world');
ok (defined $res, 'Duplicate fields have upload type set'); ok (defined $res, 'Duplicate fields have upload type set');
is (ref $res, 'ARRAY', 'Duplicate fields have array ref of upload types'); is (ref $res, 'ARRAY', 'Duplicate fields have array ref of upload types');
is ($res->[0], 'text/plain', 'Duplicate fields have correct upload types'); is ($res->[0], 'text/plain', 'Duplicate fields have correct upload types');
@files = qw/does_not_exist_gif 100;100_gif 300x300_gif/; @files = qw/does_not_exist_gif 100;100_gif 300x300_gif/;
my @sizes = qw/0 896 1656/; my @sizes = qw/0 896 1656/;
for my $i (0..2) { for my $i (0..2) {
my $file = "$uploaddir/$form->{$files[$i]}"; my $file = "$uploaddir/$form->{$files[$i]}";
ok (-e "$file", "Uploaded file exists ($i)") or warn "Name = '$file'\n" . $cgi->get_error_message; 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 is ((stat($file))[7], $sizes[$i], "File size check ($i)") or
warn_tail ($file); warn_tail ($file);
} }
is ($cgi->set_directory ('/srhslgvsgnlsenhglsgslvngh'), 0, is ($cgi->set_directory ('/srhslgvsgnlsenhglsgslvngh'), 0,
'Set directory (non-existant)'); 'Set directory (non-existant)');
my $testdir = 'testperms'; my $testdir = 'testperms';
mkdir $testdir, 0400; mkdir $testdir, 0400;
SKIP: { SKIP: {
skipping to change at line 240 skipping to change at line 240
@files = qw/plain_txt html_txt plain_win_txt html_win_txt/; @files = qw/plain_txt html_txt plain_win_txt html_win_txt/;
@sizes = qw/186 212 186 219/; @sizes = qw/186 212 186 219/;
@sizes = qw/191 212 191 219/ if $^O eq 'MSWin32'; @sizes = qw/191 212 191 219/ if $^O eq 'MSWin32';
for my $buf_size (256 .. 1500) { for my $buf_size (256 .. 1500) {
$cgi->set_buffer_size($buf_size); $cgi->set_buffer_size($buf_size);
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi); ($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 0, "Parsing data with POST (buffer size $buf_size)"); is ($cgi->is_error, 0, "Parsing data with POST (buffer size $buf_size)");
for my $i (0..3) { for my $i (0..3) {
my $file = "$uploaddir/$form->{$files[$i]}"; my $file = "$uploaddir/$form->{$files[$i]}";
ok (-e "$file", "Uploaded file exists ($i - buffer size $buf_size ") or ok (-e $file, "Uploaded file exists ($i - buffer size $buf_size") or
warn "Name = '$file'\n" . $cgi->get_error_message; warn "Name = '$file'\n" . $cgi->get_error_message;
is ((stat($file))[7], $sizes[$i], is ((stat($file))[7], $sizes[$i],
"File size check ($i - buffer size $buf_size)") or "File size check ($i - buffer size $buf_size)") or
warn_tail ($file); warn_tail ($file);
unlink ($file); unlink ($file);
} }
} }
is ($cgi->deny_uploads (), 0, 'Set deny_uploads undef'); is ($cgi->deny_uploads (), 0, 'Set deny_uploads undef');
is ($cgi->deny_uploads (0), 0, 'Set deny_uploads false'); is ($cgi->deny_uploads (0), 0, 'Set deny_uploads false');
is ($cgi->deny_uploads (1), 1, 'Set deny_uploads true'); is ($cgi->deny_uploads (1), 1, 'Set deny_uploads true');
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi); ($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 1, "Upload successfully denied"); is ($cgi->is_error, 1, "Upload successfully denied");
#$datafile = 't/post_text.txt';
#$ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
#($cgi, $form) = post_data ($datafile);
#is ($cgi->is_error, 1, 'Parsing bad data with POST');
#warn $cgi->get_error_message if $cgi->is_error;
##use Data::Dumper;
##warn Dumper ($form);
# Upload but no files # Upload but no files
$datafile = 't/upload_no_files.txt'; $datafile = 't/upload_no_files.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7]; $ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
($cgi, $form) = post_data ($datafile); ($cgi, $form) = post_data ($datafile);
is ($cgi->is_error, 0, 'Parsing upload data with no files'); is ($cgi->is_error, 0, 'Parsing upload data with no files');
# Special case where the file uploads appear not last # Special case where the file uploads appear not last
$datafile = 't/upload_no_trailing_files.txt'; $datafile = 't/upload_no_trailing_files.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7]; $ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
($cgi, $form) = post_data ($datafile, $uploaddir); ($cgi, $form) = post_data ($datafile, $uploaddir);
is ($cgi->is_error, 0, 'Parsing upload data with no trailling files'); is ($cgi->is_error, 0, 'Parsing upload data with no trailling files');
$datafile = 't/large_file_upload.txt'; $datafile = 't/large_file_upload.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7]; $ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
$cgi->set_buffer_size (256); @sizes = (1027);
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi); @sizes = (1049) if $^O eq 'MSWin32';
is ($cgi->is_error, 0, 'Parsing upload data with a large file'); 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; $ENV{CONTENT_LENGTH} += 500;
($cgi, $form) = post_data ($datafile, $uploaddir, $cgi); ($cgi, $form) = post_data ($datafile, $uploaddir, $cgi);
is ($cgi->is_error, 1, 'Parsing upload data with over large content length'); 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 # Use Test::Trap where available to test lack of wanrings
SKIP: { SKIP: {
skip "Test::Trap not available", 2 unless $have_test_trap; skip "Test::Trap not available", 2 unless $have_test_trap;
$datafile = 't/upload_no_headers.txt'; $datafile = 't/upload_no_headers.txt';
$ENV{CONTENT_LENGTH} = (stat ($datafile))[7]; $ENV{CONTENT_LENGTH} = (stat ($datafile))[7];
my @r = trap { ($cgi, $form) = post_data ($datafile, $uploaddir); }; my @r = trap { ($cgi, $form) = post_data ($datafile, $uploaddir); };
is ($trap->stderr, '', is ($trap->stderr, '',
'Upload of params with no Content-Type is quiet'); 'Upload of params with no Content-Type is quiet');
is_deeply ($form->{foolots}, [qw/bar baz quux/], is_deeply ($form->{foolots}, [qw/bar baz quux/],
'Upload of params with no Content-Type is correct'); 'Upload of params with no Content-Type is correct');
skipping to change at line 330 skipping to change at line 351
# the file here. Ideally this should never be called. # the file here. Ideally this should never be called.
my $file = shift; my $file = shift;
my $n = 32; my $n = 32;
open (my $in, '<', $file) or return warn "Cannot open $file for reading. $!"; open (my $in, '<', $file) or return warn "Cannot open $file for reading. $!";
binmode $in; binmode $in;
local $/ = undef; local $/ = undef;
my $contents = <$in>; my $contents = <$in>;
close $file; close $file;
my $lastn = substr ($contents, 0 - $n); my $lastn = substr ($contents, 0 - $n);
foreach (split (//, $lastn, $n)) { foreach (split (//, $lastn, $n)) {
print $n-- . " chars from the end: " . ord ($_) . "\n"; diag ($n-- . " chars from the end: " . ord ($_) . "\n");
} }
} }
 End of changes. 7 change blocks. 
15 lines changed or deleted 38 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)