X-Git-Url: http://git.shiar.net/perl/plp/.git/blobdiff_plain/552db5b79604f6c669eb0a63069b3a5501135e9e..3101a5b68f01e5ad27d8e28da42e43aad68a0b49:/t/50-cgi.t

diff --git a/t/50-cgi.t b/t/50-cgi.t
index aaea969..09ebd0b 100644
--- a/t/50-cgi.t
+++ b/t/50-cgi.t
@@ -4,135 +4,16 @@ 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 => 25;
-
-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);
-}
+my $ORGDIR = '.'; # Cwd::getcwd();
 
 # 0*: permission checks using generated dummy files
 SKIP: