5 use File::Basename qw( dirname );
8 use PLP::Functions qw( DecodeURI );
11 require Test::LongString;
12 Test::LongString->import(max => 128);
14 no warnings 'redefine'; # override module to not escape newlines
15 my $formatter = *Test::LongString::_display;
16 my $parent = \&{$formatter};
19 $s =~ s/\Q\x{0a}/\n /g; # revert newline quoting
22 } or *is_string = \&is; # fallback to ugly unformatted is()
24 eval { require PerlIO::scalar };
25 plan skip_all => "PerlIO required (perl 5.8) to test PLP" if $@;
29 require_ok('PLP::Backend::CGI') or BAIL_OUT();
31 $PLP::use_cache = 0 if $PLP::use_cache;
32 #TODO: caching on (change file names)
34 chdir File::Spec->catdir(dirname($0), '50-cgi')
35 or BAIL_OUT('cannot change to test directory ./50-cgi/');
36 my $ORGDIR = Cwd::getcwd();
37 open ORGOUT, '>&', *STDOUT;
40 my ($test, $src, $expect, $env, $in) = @_;
41 local $Test::Builder::Level = $Test::Builder::Level + 1;
44 REQUEST_METHOD => 'GET',
45 REQUEST_URI => "/$src/test/123",
46 QUERY_STRING => 'test=1&test=2',
47 GATEWAY_INTERFACE => 'CGI/1.1',
49 SCRIPT_NAME => '/plp.cgi',
50 SCRIPT_FILENAME => "$ORGDIR/plp.cgi",
51 PATH_INFO => "/$src/test/123",
52 PATH_TRANSLATED => "$ORGDIR/$src/test/123",
53 DOCUMENT_ROOT => $ORGDIR,
56 ); # Apache/2.2.4 CGI environment
59 $ENV{CONTENT_LENGTH} = length $in;
60 $ENV{CONTENT_TYPE} = 'application/x-www-form-urlencoded';
66 open STDOUT, '>', \my $output; # STDOUT buffered to scalar
67 select STDOUT; # output before start() (which selects PLPOUT)
69 local $SIG{__WARN__} = sub {
70 # include warnings in stdout (but modified to distinguish)
72 my $eol = $msg =~ s/(\s*\z)// && $1;
73 print "<warning>$msg</warning>$eol"
78 select ORGOUT; # return to original STDOUT
82 diag(" Error: $failure");
85 $output =~ s{((?:.+\n)*)}{ join "", sort split /(?<=\n)/, $1 }e; # order headers
86 is_string($output, $expect, $test);
90 # captures the first warning produced by the given code string
91 my ($code, $line, $file) = @_;
93 local $SIG{__WARN__} = sub { die @_ };
94 # warnings module runs at BEGIN, so we need to use icky expression evals
95 eval qq(# line $line "$file"\n$code; return);
102 my ($file, %replace) = @_;
104 (my $name = $file) =~ s/[.][^.]+$//;
105 $file = "$name.html";
106 my $infile = delete $replace{-input} // "$name.plp";
107 my $addin = -e "$name.txt" && "$name.txt";
108 $name =~ s/^(\d*)-// and $name .= " ($1)";
112 local $/ = undef; # slurp
113 open my $fh, '<', $file or die "$!\n";
116 if (not defined $out) {
118 diag("error reading output from $file: $@");
122 my $env = delete $replace{-env};
123 $replace{HEAD} //= "Content-Type: text/html\nX-PLP-Version: $PLP::VERSION\n";
124 $replace{VERSION } //= $PLP::VERSION;
125 $replace{SCRIPT_NAME } //= $infile;
126 $replace{SCRIPT_FILENAME} //= "$ORGDIR/$infile";
129 $out =~ s/\$$_/$replace{$_}/g for keys %replace;
131 <eval \s+ line="([^"]*)"> (.*?) </eval>
132 }{ getwarning($2, $1, $infile) }msxge;
134 plp_is($name, $infile, $out, $env, $addin);
137 # 0*: permission checks using generated dummy files
139 for my $file (glob '0*.html') {
140 $file =~ s/[.]html$/.plp/;
141 my ($mode) = $file =~ /^..-(\d*)\b/;
144 return 1; # do not create
148 open my $out, '>', $file or die "cannot generate source file ($!)\n";
152 chmod 0244, $file or die "cannot change permissions ($!)\n";
156 } or chomp $@, skip("$file: $@", 1); # ignore generation failure
159 eval { unlink $file }; # clean up
162 # 1*-2*: generic tests with standard environment
163 plp_ok($_) for glob '[12]*.html';
165 # 3*: error tests depending on warning message
167 my @inctests = glob '3*.html';
169 my $INCFILE = File::Spec->rel2abs("$ORGDIR/missinginclude");
170 if (open my $dummy, "<", $INCFILE) { # like PLP::source will
171 fail("file missinginclude shouldn't exist");
172 skip("missinginclude tests (3*)", @inctests - 1);
174 my $INCWARN = qq{Can't open "$INCFILE" ($!)};
176 plp_ok($_, INCWARN => $INCWARN) for @inctests;
179 # 4*-7*: apache environment (default)
180 plp_ok($_) for glob '[4-7]*.html';
185 # 8*: lighttpd environment
187 # lighttpd/1.4.7 CGI environment
188 REQUEST_METHOD => 'GET',
189 REQUEST_URI => "/$_/test/123",
190 QUERY_STRING => 'test=1&test=2',
191 GATEWAY_INTERFACE => 'CGI/1.1',
193 SCRIPT_NAME => "/$_", #XXX: .plp?
194 SCRIPT_FILENAME => "$ORGDIR/$_",
195 PATH_INFO => '/test/123',
196 PATH_TRANSLATED => undef,
197 DOCUMENT_ROOT => undef,
198 }) for glob '8*.plp';