use strict;
use warnings;

use Cwd;
use File::Basename qw( dirname );
use File::Spec;
use Test::More;
use PLP::Functions qw( DecodeURI );

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();

$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:
for my $file (glob '0*.html') {
	$file =~ s/[.]html$/.plp/;
	my ($mode) = $file =~ /^..-(\d*)\b/;
	eval {
		if ($mode eq 404) {
			return 1;  # do not create
		}

		# prepare input
		open my $out, '>', $file or die "cannot generate source file ($!)\n";
		print {$out} 'ok';

		if ($mode eq 403) {
			chmod 0244, $file or die "cannot change permissions ($!)\n";
		}

		return -e $file;
	} or chomp $@, skip("$file: $@", 1);  # ignore generation failure

	plp_ok($file);
	eval { unlink $file };  # clean up
}

# 1*-2*: generic tests with standard environment
plp_ok($_) for glob '[12]*.html';

# 3*: error tests depending on warning message
SKIP: {
	my @inctests = glob '3*.html';

	my $INCFILE = File::Spec->rel2abs("$ORGDIR/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_ok($_, INCWARN => $INCWARN) for @inctests;
}

# 4*-7*: apache environment (default)
plp_ok($_) for glob '[4-7]*.html';

#TODO: %fields
#TODO: %cookie

# 8*: lighttpd environment
plp_ok($_, -env => {
	# lighttpd/1.4.7 CGI environment
	REQUEST_METHOD => 'GET',
	REQUEST_URI => "/$_/test/123",
	QUERY_STRING => 'test=1&test=2',
	GATEWAY_INTERFACE => 'CGI/1.1',
	
	SCRIPT_NAME => "/$_", #XXX: .plp?
	SCRIPT_FILENAME => "$ORGDIR/$_",
	PATH_INFO => '/test/123',
	PATH_TRANSLATED => undef,
	DOCUMENT_ROOT => undef,
}) for glob '8*.plp';

