#!/usr/bin/env perl

use strict;
use warnings;
use Test::Most tests => 39;
use lib 't/lib';
use MyLogger;

BEGIN { use_ok('CGI::Info') }

PARAM: {
	# Initial sanity tests
	{
		# Preserve the current %ENV, so changes are local to this subtest
		local %ENV = %ENV;

		$ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1';
		$ENV{'REQUEST_METHOD'} = 'GET';
		$ENV{'QUERY_STRING'} = 'foo=bar&baz=qux';
		my $mess = 'mess is undefined';

		{
			package MockLogger;

			sub new { bless { }, shift }
			sub trace { }
			sub debug { }
			sub warn { shift; $mess = join(' ' , @_) }
		}

		my $obj = CGI::Info->new(
			allow => { foo => undef, baz => undef },
			logger => MockLogger->new()
		);

		is_deeply($obj->param(), { foo => 'bar', baz => 'qux' }, 'No arguments returns all params');

		is($obj->param('foo'), 'bar', 'Fetching allowed parameter "foo"');

		is($obj->param('baz'), 'qux', 'Fetching allowed parameter "baz"');

		is($obj->param('invalid'), undef, 'Fetching disallowed parameter "invalid" returns undef');
		diag(Data::Dumper->new([$obj->messages()])->Dump()) if($ENV{'TEST_VERBOSE'});
		# Get the warnings that the object has generated
		my @warnings = grep defined, map { ($_->{'level'} eq 'warn') ? $_->{'message'} : undef } @{$obj->messages()};
		like(
			$warnings[0],
			qr/param: invalid isn't in the allow list/,
			'Warning generated for disallowed parameter'
		);

		delete $ENV{'QUERY_STRING'};
		$obj = CGI::Info->new();
		is($obj->param('foo'), undef, 'No params set, fetching "foo" returns undef');
	};

	$ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1';
	$ENV{'REQUEST_METHOD'} = 'GET';
	$ENV{'QUERY_STRING'} = 'foo=bar';

	my $i = new_ok('CGI::Info');
	cmp_ok($i->param('foo'), 'eq', 'bar', 'basic param() test');
	is($i->param('fred'), undef, 'param() returns undef when needed');
	cmp_ok($i->as_string(), 'eq', 'foo=bar', 'basic as_string test');

	$ENV{'QUERY_STRING'} = '=bar';

	$i = new_ok('CGI::Info');
	ok(!defined($i->param('fred')));
	ok($i->as_string() eq '');

	$ENV{'QUERY_STRING'} = 'foo=bar&fred=wilma';

	$i = new_ok('CGI::Info');
	ok($i->param('foo') eq 'bar');
	ok($i->param('fred') eq 'wilma');
	ok($i->as_string() eq 'foo=bar; fred=wilma');

	$ENV{'QUERY_STRING'} = 'foo=bar&fred=wilma&foo=baz';
	$i = new_ok('CGI::Info');
	ok($i->param('foo') eq 'bar,baz');
	ok($i->param('fred') eq 'wilma');
	ok($i->as_string() eq 'foo=bar,baz; fred=wilma');

	# Reading twice should yield the same result
	ok($i->param('foo') eq 'bar,baz');

	$ENV{'QUERY_STRING'} = 'foo=&fred=wilma';
	$i = new_ok('CGI::Info');
	my %p = %{$i->param()};
	ok(!defined($i->param('foo')));
	cmp_ok($i->as_string(), 'eq', 'fred=wilma', 'as_string works');
	cmp_ok($p{'fred'}, 'eq', 'wilma', 'param() with no arguments returns correct HASH');

	$ENV{'QUERY_STRING'} = 'foo=bar\u0026fred=wilma';
	$i = new_ok('CGI::Info');
	is($i->param('foo'), 'bar', '\u0026 is interpreted as &');

	# Don't pass XSS through
	$ENV{'QUERY_STRING'} = 'foo=<script>alert(hello)</script>';
	$i = new_ok('CGI::Info');
	# ok(defined($i->param('foo')));
	# ok($i->as_string() eq 'foo=&lt\;script&gt\;alert(hello)&lt\;/script&gt\;');
	ok(!defined($i->param('foo')));
	ok($i->as_string() eq '');

	$ENV{'QUERY_STRING'} = 'foo=&fred=wilma&foo=bar';
	$i = new_ok('CGI::Info');
	ok($i->param('foo', logger => MyLogger->new()) eq 'bar');
	ok($i->param('fred') eq 'wilma');
	ok($i->as_string() eq 'foo=bar; fred=wilma');

	subtest 'SQL injection is blocked' => sub {
		# Preserve the current %ENV, so changes are local to this subtest
		local %ENV = %ENV;

		$ENV{'REQUEST_METHOD'} = 'GET';
		$ENV{'QUERY_STRING'} = 'nan=lost&redir=-8717%22%20OR%208224%3D6013--%20ETLn';

		my $info = new_ok('CGI::Info');
		ok(!defined($info->param('nan')));
		ok(!defined($info->param('redir')));
	};

	subtest 'Test GET' => sub {
		# Preserve the current %ENV, so changes are local to this subtest
		local %ENV = %ENV;

		my $info = CGI::Info->new();

		$ENV{'REQUEST_METHOD'} = 'GET';
		$ENV{'QUERY_STRING'} = 'name=John&age=30';

		is($info->param('name'), 'John', 'name parameter is correct');
		is($info->name(), 'John', 'name parameter is correct with AUTOLOAD')
	};

	subtest 'Test POST' => sub {
		# Preserve the current %ENV, so changes are local to this subtest
		local %ENV = %ENV;

		CGI::Info->reset();	# Force stdin re-read

		my $info = CGI::Info->new();
		my $data = 'name=Jane&age=25';

		$ENV{'CONTENT_LENGTH'} = length($data);
		$ENV{'REQUEST_METHOD'} = 'POST';
		$ENV{'CONTENT_TYPE'} = 'application/x-www-form-urlencoded';

		# Simulate the input stream using an in-memory filehandle
		open(my $fh, '<', \$data);
		local *STDIN = $fh;	# Redirect STDIN to read from our in-memory filehandle
		binmode($fh);

		is($info->param('name'), 'Jane', 'name parameter is correct');
		is($info->name(), 'Jane', 'name parameter is correct with AUTOLOAD');

		close $fh
	};
}
