view release on metacpan or  search on metacpan

t/uploads.t  view on Meta::CPAN

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;
SKIP: {
	skip "subdir '$testdir' could not be created", 3 unless (-d $testdir);

t/uploads.t  view on Meta::CPAN

@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');

t/uploads.t  view on Meta::CPAN

@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];