CGI-Info

 view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'x=mustleak.com/probe';
	my $info = CGI::Info->new();
	ok(!defined $info->params(), 'mustleak attack returns undef');
	is($info->status(), 403, 'status 403 on mustleak');
};

subtest 'params() - POST: missing CONTENT_LENGTH => undef + status 411' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'POST';
	my $info = CGI::Info->new();
	ok(!defined $info->params(), 'POST without CONTENT_LENGTH returns undef');
	is($info->status(), 411, 'status 411 on missing CONTENT_LENGTH');
};

subtest 'params() - POST: oversized body => undef + status 413' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'POST';
	$ENV{CONTENT_LENGTH}	= 999_999_999;
	my $info = CGI::Info->new(max_upload_size => 100);
	ok(!defined $info->params(), 'oversized POST returns undef');
	is($info->status(), 413, 'status 413 on oversized body');
};

subtest 'params() - OPTIONS => undef + status 405' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'OPTIONS';
	my $info = CGI::Info->new();
	ok(!defined $info->params(), 'OPTIONS returns undef');
	is($info->status(), 405, 'status 405 on OPTIONS');
};

subtest 'params() - DELETE => undef + status 405' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'DELETE';
	my $info = CGI::Info->new();
	ok(!defined $info->params(), 'DELETE returns undef');
	is($info->status(), 405, 'status 405 on DELETE');
};

subtest 'params() - POST XML: body stored under XML key' => sub {
	reset_env();
	my $xml = '<root><item>test</item></root>';
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'POST';
	$ENV{CONTENT_TYPE}	  = 'text/xml';
	$ENV{CONTENT_LENGTH}	= length($xml);
	$CGI::Info::stdin_data  = $xml;
	my $p = CGI::Info->new()->params();
	ok(defined $p,		 'XML POST returns a hashref');
	is($p->{XML}, $xml,	'XML body stored under the XML key');
};

subtest 'params() - command-line ARGV pairs parsed (non-CGI)' => sub {
	reset_env();
	local @ARGV = ('city=London', 'country=UK');
	my $p = CGI::Info->new()->params();
	is($p->{city},	'London', 'city from ARGV');
	is($p->{country}, 'UK',	 'country from ARGV');
};

subtest 'params() - second call returns same cached hashref' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'k=v';
	my $info = CGI::Info->new();
	my $p1   = $info->params();
	my $p2   = $info->params();
	is($p1, $p2, 'repeated call returns cached hashref');
};

# ============================================================
# param($field)
# POD: returns single parameter value; undef if not present;
#	  warns if field not in allow list;
#	  no arg => delegates to params()
# ============================================================

subtest 'param() - returns value for existing key' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'foo=bar';
	is(CGI::Info->new()->param('foo'), 'bar', 'param() returns value');
};

subtest 'param() - returns undef for absent key' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'foo=bar';
	ok(!defined CGI::Info->new()->param('nosuchkey'),
		'param() returns undef for absent key');
};

subtest 'param() - no argument delegates to params()' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'x=1';
	my $result = CGI::Info->new()->param();
	ok(ref($result) eq 'HASH', 'param() with no arg returns hashref');
};

subtest 'param() - returns undef for key outside allow list' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'foo=1';
	my $info = CGI::Info->new(allow => { foo => qr/\d+/ });
	$info->params();
	ok(!defined $info->param('bar'),
		'param() returns undef for key not in allow list');
};



( run in 1.625 second using v1.01-cache-2.11-cpan-364913b4093 )