view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

    ok(!defined $p, 'XSS injection blocked');
    is($info->status(), 403, 'status 403 on XSS');
};

subtest 'params() - directory traversal blocked (GET)' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'file=../../etc/passwd';
    my $info = CGI::Info->new();
    my $p = $info->params();
    ok(!defined $p, 'directory traversal blocked');
    is($info->status(), 403, 'status 403 on directory traversal');
};

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

subtest 'params() - duplicate values comma-joined' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'color=red&color=blue';
    my $info = CGI::Info->new();
    my $p = $info->params();
    like($p->{color}, qr/red.*blue|blue.*red/, 'duplicate values comma-joined');
};

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

subtest 'params() - POST oversized => 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);
    my $p = $info->params();
    ok(!defined $p, 'oversized POST returns undef');
    is($info->status(), 413, 'status 413 on large upload');
};

subtest 'params() - command-line key=value pairs (non-CGI)' => sub {
    reset_env();
    local @ARGV = ('name=Alice', 'age=30');
    my $info = CGI::Info->new();
    my $p = $info->params();
    is($p->{name}, 'Alice', 'name from ARGV');
    is($p->{age},  '30',    'age from ARGV');
};

subtest 'params() - --mobile flag from ARGV' => sub {
    reset_env();
    local @ARGV = ('--mobile', 'x=1');
    my $info = CGI::Info->new();
    $info->params();
    ok($info->is_mobile(), '--mobile flag sets is_mobile');
};

subtest 'params() - --robot flag from ARGV' => sub {
    reset_env();
    local @ARGV = ('--robot');
    my $info = CGI::Info->new();
    $info->params();
    ok($info->is_robot(), '--robot flag sets is_robot');
};

subtest 'params() - --search-engine flag from ARGV' => sub {
    reset_env();
    local @ARGV = ('--search-engine');
    my $info = CGI::Info->new();
    $info->params();
    ok($info->is_search_engine(), '--search-engine flag sets is_search_engine');
};

subtest 'params() - --tablet flag from ARGV' => sub {
    reset_env();
    local @ARGV = ('--tablet');
    my $info = CGI::Info->new();
    $info->params();
    ok($info->is_tablet(), '--tablet flag sets is_tablet');
};

subtest 'params() - caches result on second call' => 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, 'second call returns same hashref (cached)');
};

# ============================================================
# 5. param($field)
# ============================================================
subtest 'param() - returns single value' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'foo=hello';
    my $info = CGI::Info->new();
    is($info->param('foo'), 'hello', 'param() returns correct value');
};

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

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

subtest 'param() - warns when key not in 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();
    my $val = $info->param('bar');
    ok(!defined $val, 'param() returns undef for key outside allow list');
};

# ============================================================
# 6. as_string()