view release on metacpan or  search on metacpan

t/uploads.t  view on Meta::CPAN

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

	# See http://www.perlmonks.org/?node_id=587550 for a discussion of
	# the futility of chmod and friends on MS Windows systems.
	SKIP: {
		skip "Not available on $^O", 2 if ($^O eq 'MSWin32' or $^O eq 'cygwin');
		skip "Running as privileged user: $ENV{USER}", 2 unless $>;
		is ($cgi->set_directory ($testdir), 0, 'Set directory (unwriteable)');
		chmod 0200, $testdir;
		is ($cgi->set_directory ($testdir), 0, 'Set directory (unreadable)');
	}
	rmdir $testdir and open my $td, '>', $testdir;
	print $td "Test\n";
	close $td;
	is ($cgi->set_directory ($testdir), 0, 'Set directory (non-directory)');
	unlink $testdir;
}

# Mime type tests
# Documentation says get_mime_types can return an arrayref, but 
# that seems not to be the case.

my @mimetypes = $cgi->get_mime_types ();
ok ($#mimetypes > 0, 'get_mime_types returns array');
is_deeply (\@mimetypes, [ 'text/html', 'text/plain' ],
	'default mime types');

is ($cgi->add_mime_type (), 0, 'Undefined mime type');

$cgi->add_mime_type ('application/json');
@mimetypes = $cgi->get_mime_types ();
is ($#mimetypes, 2, 'added a mime type');
is ($mimetypes[0], 'application/json', 'added mime type is correct');
is ($cgi->add_mime_type ('application/json'), 0, 'added mime type again');

is ($cgi->remove_mime_type ('foo/bar'), 0,
	'removed non-existant mime type');
is ($cgi->remove_mime_type ('text/html'), 1,
	'removed existant mime type');
@mimetypes = $cgi->get_mime_types ();
is ($#mimetypes, 1, 'Count of mime types after removal');
is_deeply (\@mimetypes, [ 'application/json', 'text/plain' ],
	'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');