#!/usr/bin/perl -w
use strict;
use lib ('./blib','./lib','../blib','../lib');
use CGI::Minimal;
my $do_tests = [1..2];
my $test_subs = {
1 => { -code => \&test_calling_parms_table, -desc => 'generate calling parms table ' },
2 => { -code => \&test_rfc1123_date, -desc => 'generate RFC 1123 date ' },
};
run_tests($test_subs,$do_tests);
exit;
###########################################################################################
sub reset_form {
$ENV{'QUERY_STRING'} = 'hello=testing;hello2=SGML+encoded+FORM;submit+button=submit';
$ENV{'CONTENT_LENGTH'} = length($ENV{'QUERY_STRING'});
$ENV{'CONTENT_TYPE'} = 'application/sgml-form-urlencoded';
$ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1';
$ENV{'REQUEST_METHOD'} = 'GET';
CGI::Minimal::reset_globals;
}
###########################################################################################
sub test_calling_parms_table {
my $calling_parms_table = eval {
reset_form();
$ENV{'QUERY_STRING'} = '';
$ENV{'CONTENT_LENGTH'} = length($ENV{'QUERY_STRING'});
my $cgi = CGI::Minimal->new;
return $cgi->calling_parms_table;
};
if ($@) {
return "unexpected failure $@";
}
if ($calling_parms_table eq '') { return 'failed to generate calling parms table with no parms for decoding'; };
$calling_parms_table = eval {
reset_form();
my $cgi = CGI::Minimal->new;
return $cgi->calling_parms_table;
};
if ($@) {
return "unexpected failure $@";
}
if ($calling_parms_table eq '') { return 'failed to generate calling parms table'; };
$calling_parms_table = eval {
reset_form();
my $cgi = generate_and_read_multipart_form();;
return $cgi->calling_parms_table;
};
if ($@) {
return "unexpected failure $@";
}
if ($calling_parms_table eq '') { return 'failed to generate calling parms table for multipart form'; };
return '';
}
###########################################################################################
sub test_rfc1123_date {
my $rfc_date = eval {
reset_form();
return CGI::Minimal->date_rfc1123(0);
};
if ($@) {
return "unexpected failure $@";
}
unless ($rfc_date eq 'Thu, 01 Jan 1970 00:00:00 GMT') {
return "Generated unexpected date of $rfc_date for epoch date '0'";
}
return '';
}
###########################################################################################
sub generate_and_read_multipart_form {
local $^W;
my $basic_boundary = 'lkjsdlkjsd';
my $data = multipart_data($basic_boundary);
$ENV{'CONTENT_LENGTH'} = length($data);
$ENV{'CONTENT_TYPE'} = "multipart/form-data; boundary=---------------------------$basic_boundary";
$ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1';
$ENV{'REQUEST_METHOD'} = 'POST';
my $test_file = "test-data.$$.data";
open (TESTFILE,">$test_file") || return ("failed : could not open test file $test_file for writing: $!");
binmode (TESTFILE);
print TESTFILE $data;
close (TESTFILE);
# "Bad evil naughty Zoot"
CGI::Minimal::reset_globals;
open (STDIN,$test_file) || return ("failed : could not open test file $test_file for reading: $!");
my $cgi = CGI::Minimal->new;
close (STDIN);
unlink $test_file;
return $cgi;
}
######################################################
# multipart test data #
######################################################
sub multipart_data {
my ($boundary) = @_;
my $data =<<"EOD";
-----------------------------$boundary
Content-Disposition: form-data; name="hello"; filename="hello1.txt"
testing
-----------------------------$boundary
Content-Disposition: form-data; name="hello"; filename="hello1.xml"
Content-Type: application/xml
<data>also testing</data>
-----------------------------$boundary
Content-Disposition: form-data; name="hello2"; filename="example"
Content-Type: text/html
testing2
-----------------------------$boundary
Content-Disposition: form-data; name="submit button"
submit
-----------------------------$boundary--
EOD
$data =~ s/\012/\015\012/gs;
return $data;
}
###########################################################################################
sub run_tests {
my ($test_subs,$do_tests) = @_;
print @$do_tests[0],'..',@$do_tests[$#$do_tests],"\n";
print STDERR "\n";
my $n_failures = 0;
foreach my $test (@$do_tests) {
my $sub = $test_subs->{$test}->{-code};
my $desc = $test_subs->{$test}->{-desc};
my $failure = '';
eval { $failure = &$sub; };
if ($@) {
$failure = $@;
}
if ($failure ne '') {
chomp $failure;
print "not ok $test\n";
print STDERR " $desc - $failure\n";
$n_failures++;
} else {
print "ok $test\n";
print STDERR " $desc - ok\n";
}
}
print "END\n";
}