X-Git-Url: http://git.shiar.nl/perl/plp/.git/blobdiff_plain/0cfa86cf4c741be9c11ee71e138963671d0e2f3c..0f7b5b7aeb4d224aa1de019d5c8815669f5b0dec:/t/50-cgi.t diff --git a/t/50-cgi.t b/t/50-cgi.t index 1873c8f..ed39da5 100644 --- a/t/50-cgi.t +++ b/t/50-cgi.t @@ -1,179 +1,86 @@ use strict; use warnings; -use Cwd qw(cwd); -use Test::More; +use File::Basename qw( dirname ); +use File::Spec; +use Test::More tests => 25; -eval { require PerlIO::scalar }; -plan skip_all => "PerlIO required (perl 5.8) to test PLP" if $@; - -plan tests => 18; - -require_ok('PLP::Backend::CGI') or BAIL_OUT(); +use_ok('Test::PLP'); $PLP::use_cache = 0 if $PLP::use_cache; #TODO: caching on (change file names) -my $base = -w '/tmp' ? '/tmp' : cwd(); -my $testfile = 'testfile.plp'; -not -f "$base/$testfile" or BAIL_OUT("$testfile exists"); - -open ORGOUT, '>&', STDOUT; +chdir File::Spec->catdir(dirname($0), '50-cgi') + or BAIL_OUT('cannot change to test directory ./50-cgi/'); -sub plp_is { - my ($test, $plp, $expect) = @_; - chomp $expect; - local $Test::Builder::Level = $Test::Builder::Level + 1; - - eval { - open my $testfh, '>', "$base/$testfile" or die $!; - print {$testfh} $plp or die $!; - close $testfh or die $!; - }; - not $@ or fail("write $testfile"), diag(" Error: $@"), return; - - close STDOUT; - open STDOUT, '>', \my $output; # STDOUT buffered to scalar +# 0*: permission checks using generated dummy files +SKIP: +for my $file (glob '0*.html') { + $file =~ s/[.]html$/.plp/; + my ($mode) = $file =~ /^..-(\d*)\b/; eval { - local $SIG{__WARN__} = sub { print $_[0] }; # enables warnings - PLP::everything(); - }; - select ORGOUT; # return to original STDOUT - - not $@ or fail($test), diag(" Error: $@"), return; - is($output, $expect, $test); -} - -%ENV = ( - REQUEST_METHOD => 'GET', - REQUEST_URI => "/$testfile/test/123", - QUERY_STRING => 'test=1&test=2', - GATEWAY_INTERFACE => 'CGI/1.1', - - SCRIPT_NAME => '/plp.cgi', - SCRIPT_FILENAME => "$base/plp.cgi", - PATH_INFO => "/$testfile/test/123", - PATH_TRANSLATED => "$base/$testfile/test/123", - DOCUMENT_ROOT => $base, -); # Apache/2.2.4 CGI environment + if ($mode eq 404) { + return 1; # do not create + } -my $HEAD = <', $file or die "cannot generate source file ($!)\n"; + print {$out} 'ok'; -plp_is('print', '0<: print print 2 :>3', "$HEAD\n0213"); + if ($mode eq 403) { + chmod 0244, $file or die "cannot change permissions ($!)\n"; + } -plp_is('exit', '1<:exit:>not <(reached)>', "$HEAD\n1"); + return -e $file; + } or chomp $@, skip("$file: $@", 1); # ignore generation failure -plp_is('<:=', '1<:=$foo=2:>3<:= $foo', "$HEAD\n1232"); + plp_ok($file); + eval { unlink $file }; # clean up +} -plp_is('%get', '<: print $get{test} if defined $get{test} and not exists $get{test2}', "$HEAD\n2\n"); +# 1*-2*: generic tests with standard environment +plp_ok($_) for glob '[12]*.html'; -plp_is('%get array', '<:= @{$get{q/@test/}}', "$HEAD\n12\n"); +# 3*: error tests depending on warning message +SKIP: { + my @inctests = glob '3*.html'; -plp_is('%header', - '<: $headers{x_test}=2; print $header{x_PLP_version}; BEGIN { $header{"X-tesT"}=1 }', - "X-tesT: 2\n$HEAD\n$PLP::VERSION" -); + my $INCFILE = File::Spec->rel2abs("./missinginclude"); + if (open my $dummy, "<", $INCFILE) { # like PLP::source will + fail("file missinginclude shouldn't exist"); + skip("missinginclude tests (3*)", @inctests - 1); + } + my $INCWARN = qq{Can't open "$INCFILE" ($!)}; -plp_is('%header', '.<: BEGIN{$header{x}="1\n2"} $header{x}=3', < $INCWARN) for @inctests; +} -.
Debug information:
Can't set headers after sending them at testfile.plp line 1. -(Output started at testfile.plp line 1.) -
-TEST +# 4*-6*: apache environment (default) +plp_ok($_) for glob '[4-6]*.html'; -#TODO: %post #TODO: %fields #TODO: %cookie -plp_is('PLP_END', '<: PLP_END{print 1}; PLP_END{print 2}; print 3', "$HEAD\n321"); - -plp_is('no warnings by default', '<: ignoreme :>ok', "$HEAD\nok"); - -rename "$base/$testfile", "$base/$testfile.inc"; -plp_is('include', "<($testfile.inc)> <: include '$testfile.inc'", "$HEAD\nok ok"); -unlink "$base/$testfile.inc"; - -plp_is('fatal error', "runtime\n<: syntax(error :>\nruntime", <Debug information:
syntax error at $testfile line 2, at EOF - (Might be a runaway multi-line \cq\cq string starting on line 1) - -TEST - -plp_is('warnings', split /\n\n/, < -2 -<: 42 :> -3 -<: warn "warning" :> -4 -<: include "missinginclude" :> -5 -<(missinginclude)> -6 - -$HEAD -Useless use of a constant in void context at $testfile line 4. -1 - -2 - -3 -warning at $testfile line 6. - -4 -
Debug information:
Can't open "$base/missinginclude" (No such file or directory) at $testfile line 8. -
-5 -
Debug information:
Can't open "$base/missinginclude" (No such file or directory) at $testfile line 10. -
-TEST - -plp_is('$PLP::ERROR', - '<: $PLP::ERROR = sub {print "Oh no: $_[0]"} :> <(missinginclude)>.', - qq{$HEAD\n Oh no: Can't open "$base/missinginclude" (No such file or directory) at $testfile line 1.\n\n} -); - -#TODO: 404 -#TODO: 403 - -plp_is('$PLP::DEBUG', - '<: $PLP::DEBUG = 2 :>1<(missinginclude)>2', - "Content-Type: text/plain\n\n$HEAD\n1" -); - -plp_is('utf8', '<: use open qw/:std :utf8/; print chr 191', < <:=$ENV{SCRIPT_FILENAME}', - "$HEAD\nok /$testfile $base/$testfile" -); - -plp_is('%ENV (on apache)', @envtest); - -%ENV = ( +# 7*: multipart posts +TODO: { + local $TODO = 'future feature'; + plp_ok($_, -env => { + CONTENT_TYPE => 'multipart/form-data; boundary=knip', + }) for glob '7*.html'; +} + +# 8*: lighttpd environment +plp_ok($_, -env => { + # lighttpd/1.4.7 CGI environment REQUEST_METHOD => 'GET', - REQUEST_URI => "/$testfile/test/123", + REQUEST_URI => "/$_/test/123", QUERY_STRING => 'test=1&test=2', GATEWAY_INTERFACE => 'CGI/1.1', - SCRIPT_NAME => "/$testfile", #XXX: .plp? - SCRIPT_FILENAME => "$base/$testfile", + SCRIPT_NAME => "/$_", #XXX: .plp? + SCRIPT_FILENAME => "./$_", PATH_INFO => '/test/123', -); # lighttpd/1.4.7 CGI environment - -plp_is('%ENV on lighttpd', @envtest); - -unlink "$base/$testfile"; + PATH_TRANSLATED => undef, + DOCUMENT_ROOT => undef, +}) for glob '8*.plp';