t: replace variable root directory in tests

[perl/plp/.git] / t / 50-cgi.t

diff --git a/t/50-cgi.t b/t/50-cgi.t
index 0f3eeaf4e5f8582fd53b6795bd1fe7459028995f..ed39da5a1fc38f53c176a885d357c16383287f4e 100644 (file)
--- a/t/50-cgi.t
+++ b/t/50-cgi.t
@@ -1,138 +1,17 @@
 use strict;
 use warnings;
 
-use Cwd;
 use File::Basename qw( dirname );
 use File::Spec;
-use Test::More;
-use PLP::Functions qw( DecodeURI );
+use Test::More tests => 25;
 
-eval {
-       require Test::LongString;
-       Test::LongString->import(max => 128);
-
-       no warnings 'redefine';  # override module to not escape newlines
-       my $formatter = *Test::LongString::_display;
-       my $parent = \&{$formatter};
-       *{$formatter} = sub {
-               my $s = &{$parent};
-               $s =~ s/\Q\x{0a}/\n              /g;  # revert newline quoting
-               return $s;
-       };
-} or *is_string = \&is;  # fallback to ugly unformatted is()
-
-eval { require PerlIO::scalar };
-plan skip_all => "PerlIO required (perl 5.8) to test PLP" if $@;
-
-plan tests => 24;
-
-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)
 
 chdir File::Spec->catdir(dirname($0), '50-cgi')
        or BAIL_OUT('cannot change to test directory ./50-cgi/');
-my $ORGDIR = Cwd::getcwd();
-open ORGOUT, '>&', *STDOUT;
-
-sub plp_is {
-       my ($test, $src, $expect, $env, $in) = @_;
-       local $Test::Builder::Level = $Test::Builder::Level + 1;
-
-       %ENV = (
-               REQUEST_METHOD => 'GET',
-               REQUEST_URI => "/$src/test/123",
-               QUERY_STRING => 'test=1&test=2',
-               GATEWAY_INTERFACE => 'CGI/1.1',
-               
-               SCRIPT_NAME => '/plp.cgi',
-               SCRIPT_FILENAME => "$ORGDIR/plp.cgi",
-               PATH_INFO => "/$src/test/123",
-               PATH_TRANSLATED => "$ORGDIR/$src/test/123",
-               DOCUMENT_ROOT => $ORGDIR,
-               
-               $env ? %{$env} : (),
-       ); # Apache/2.2.4 CGI environment
-
-       if (defined $in) {
-               $ENV{CONTENT_LENGTH} = length $in;
-               $ENV{CONTENT_TYPE} = 'application/x-www-form-urlencoded';
-               close STDIN;
-               open STDIN, '<', $in;
-       }
-
-       close STDOUT;
-       open STDOUT, '>', \my $output;  # STDOUT buffered to scalar
-       select STDOUT;  # output before start() (which selects PLPOUT)
-       eval {
-               local $SIG{__WARN__} = sub {
-                       # include warnings in stdout (but modified to distinguish)
-                       my $msg = shift;
-                       my $eol = $msg =~ s/(\s*\z)// && $1;
-                       print "<warning>$msg</warning>$eol"
-               };
-               PLP::everything();
-       };
-       my $failure = $@;
-       select ORGOUT;  # return to original STDOUT
-
-       if ($failure) {
-               fail($test);
-               diag("    Error: $failure");
-               return;
-       }
-       $output =~ s{((?:.+\n)*)}{ join "", sort split /(?<=\n)/, $1 }e; # order headers
-       is_string($output, $expect, $test);
-}
-
-sub getwarning {
-       # captures the first warning produced by the given code string
-       my ($code, $line, $file) = @_;
-
-       local $SIG{__WARN__} = sub { die @_ };
-       # warnings module runs at BEGIN, so we need to use icky expression evals
-       eval qq(# line $line "$file"\n$code; return);
-       my $res = $@;
-       chomp $res;
-       return $res;
-}
-
-sub plp_ok {
-       my ($file, %replace) = @_;
-
-       (my $name = $file) =~ s/[.][^.]+$//;
-       $file = "$name.html";
-       my $infile = delete $replace{-input} // "$name.plp";
-       my $addin = -e "$name.txt" && "$name.txt";
-       $name =~ s/^(\d*)-// and $name .= " ($1)";
-       DecodeURI($name);
-
-       my $out = eval {
-               local $/ = undef;  # slurp
-               open my $fh, '<', $file or die "$!\n";
-               return readline $fh;
-       };
-       if (not defined $out) {
-               fail($name);
-               diag("error reading output from $file: $@");
-               return;
-       }
-
-       my $env = delete $replace{-env};
-       $replace{HEAD} //= "Content-Type: text/html\nX-PLP-Version: $PLP::VERSION\n";
-       $replace{VERSION        } //= $PLP::VERSION;
-       $replace{SCRIPT_NAME    } //= $infile;
-       $replace{SCRIPT_FILENAME} //= "$ORGDIR/$infile";
-
-       chomp $out;
-       $out =~ s/\$$_/$replace{$_}/g for keys %replace;
-       $out =~ s{
-               <eval \s+ line="([^"]*)"> (.*?) </eval>
-       }{ getwarning($2, $1, $infile) }msxge;
-
-       plp_is($name, $infile, $out, $env, $addin);
-}
 
 # 0*: permission checks using generated dummy files
 SKIP:
@@ -166,7 +45,7 @@ plp_ok($_) for glob '[12]*.html';
 SKIP: {
        my @inctests = glob '3*.html';
 
-       my $INCFILE = File::Spec->rel2abs("$ORGDIR/missinginclude");
+       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);
@@ -176,12 +55,20 @@ SKIP: {
        plp_ok($_, INCWARN => $INCWARN) for @inctests;
 }
 
-# 4*-7*: apache environment (default)
-plp_ok($_) for glob '[4-7]*.html';
+# 4*-6*: apache environment (default)
+plp_ok($_) for glob '[4-6]*.html';
 
 #TODO: %fields
 #TODO: %cookie
 
+# 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
@@ -191,7 +78,7 @@ plp_ok($_, -env => {
        GATEWAY_INTERFACE => 'CGI/1.1',
        
        SCRIPT_NAME => "/$_", #XXX: .plp?
-       SCRIPT_FILENAME => "$ORGDIR/$_",
+       SCRIPT_FILENAME => "./$_",
        PATH_INFO => '/test/123',
        PATH_TRANSLATED => undef,
        DOCUMENT_ROOT => undef,