CGI-Info
view release on metacpan or search on metacpan
$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 )