CGI-Info

 view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

};

# ============================================================
# 9. Browser detection + params in same session
# ============================================================

subtest 'mobile browser: browser_type, is_mobile, params all consistent' => sub {
    reset_env();
    $ENV{HTTP_USER_AGENT}   = 'Mozilla/5.0 (iPhone; CPU iPhone OS 15_0 like Mac OS X)';
    $ENV{REMOTE_ADDR}       = '1.2.3.4';
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'view=compact&page=1';

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

    ok($info->is_mobile(),               'is_mobile() true for iPhone');
    ok(!$info->is_tablet(),              'is_tablet() false for iPhone');
    is($info->browser_type(), 'mobile',  'browser_type() is mobile');
    ok(!$info->is_robot(),               'is_robot() false for real user');
    ok(!$info->is_search_engine(),       'is_search_engine() false for iPhone');

    my $params = $info->params();
    is($params->{view}, 'compact', 'params parsed correctly alongside mobile detection');
    is($params->{page}, '1',       'page param parsed');
};

subtest 'tablet browser: is_tablet, is_mobile, browser_type consistent' => sub {
    reset_env();
    $ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (iPad; CPU OS 15_0 like Mac OS X)';
    $ENV{REMOTE_ADDR}     = '1.2.3.4';

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

    ok($info->is_tablet(),              'is_tablet() true for iPad');
    ok($info->is_mobile(),              'is_mobile() true for iPad (tablets are mobile)');
    is($info->browser_type(), 'mobile', 'browser_type() mobile for tablet');
};

subtest 'robot browser: is_robot, browser_type, params blocked on SQL UA' => sub {
    reset_env();
    $ENV{HTTP_USER_AGENT}   = 'ClaudeBot/1.0 (+http://www.anthropic.com)';
    $ENV{REMOTE_ADDR}       = '1.2.3.4';
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'q=test';

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

    ok($info->is_robot(),              'is_robot() true for ClaudeBot');
    is($info->browser_type(), 'robot', 'browser_type() is robot');
    ok(!$info->is_mobile(),            'is_mobile() false for robot');
    ok(!$info->is_tablet(),            'is_tablet() false for robot');

    # params() should still work for a robot (it only blocks on bad content)
    my $params = $info->params();
    ok(!defined($params) || defined($params->{q}),
        'params accessible for robot with clean query');
};

subtest 'desktop browser: browser_type web, not mobile/tablet/robot' => sub {
    reset_env();
    $ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 Chrome/120';
    $ENV{REMOTE_ADDR}     = '1.2.3.4';

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

    ok(!$info->is_mobile(),          'desktop is not mobile');
    ok(!$info->is_tablet(),          'desktop is not tablet');
    ok(!$info->is_robot(),           'desktop is not robot');
    is($info->browser_type(), 'web', 'desktop browser_type is web');
};

# ============================================================
# 10. Stateful: --mobile/--robot/--tablet/--search-engine ARGV flags
#     Each flag sets the appropriate state AND params() still works
# ============================================================

subtest 'ARGV --mobile flag: is_mobile true, params still parsed' => sub {
    reset_env();
    local @ARGV = ('--mobile', 'section=news', 'limit=10');
    my $info = CGI::Info->new();
    $info->params();

    ok($info->is_mobile(), '--mobile sets is_mobile');
    my $p = $info->params();
    is($p->{section}, 'news', 'section param parsed after --mobile');
    is($p->{limit},   '10',   'limit param parsed after --mobile');
};

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

    ok($info->is_robot(),              '--robot sets is_robot');
    is($info->browser_type(), 'robot', 'browser_type robot after --robot');
};

subtest 'ARGV --tablet flag: is_tablet true, is_mobile still works' => sub {
    reset_env();
    local @ARGV = ('--tablet', 'view=grid');
    my $info = CGI::Info->new();
    my $p = $info->params();

    ok($info->is_tablet(), '--tablet sets is_tablet');
    is($p->{view}, 'grid', 'view param parsed after --tablet');
};

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

    ok($info->is_search_engine(), '--search-engine sets is_search_engine');
    is($info->browser_type(), 'search', 'browser_type search after flag');
};

# ============================================================
# 11. Site details: host_name, domain_name, cgi_host_url, protocol consistent
# ============================================================

subtest 'site details: all methods consistent for http://www.example.com' => sub {
    reset_env();
    $ENV{HTTP_HOST}       = 'www.example.com';
    $ENV{SERVER_PROTOCOL} = 'HTTP/1.1';

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

t/integration.t  view on Meta::CPAN

    $ENV{HTTP_USER_AGENT}   = 'Googlebot/2.1 (+http://www.google.com/bot.html)';
    $ENV{REMOTE_ADDR}       = '66.249.66.1';
    $ENV{HTTP_HOST}         = 'www.example.com';
    $ENV{SERVER_PROTOCOL}   = 'HTTP/1.1';
    $ENV{SCRIPT_FILENAME}   = '/var/www/cgi-bin/search.cgi';
    $ENV{SCRIPT_NAME}       = '/cgi-bin/search.cgi';
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = '';

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

    # Site identity
    is($info->host_name(),   'www.example.com', 'host_name correct');
    is($info->domain_name(), 'example.com',     'domain_name correct');
    is($info->protocol(),    'http',             'protocol correct');

    # Script identity
    is($info->script_name(), 'search.cgi', 'script_name correct');
    if($^O ne 'MSWin32') {
        is($info->script_dir(), '/var/www/cgi-bin', 'script_dir correct');
    } else {
        ok(defined $info->script_dir(), 'script_dir defined on Windows');
    }

    # Browser classification — Googlebot may be search or robot; both acceptable
    my $type = $info->browser_type();
    ok($type eq 'search' || $type eq 'robot',
        "browser_type is search or robot for Googlebot (got '$type')");
    ok(!$info->is_mobile(), 'Googlebot is not mobile');

    # No query string
    ok(!defined $info->params(), 'empty query string returns undef params');
    is($info->status(), 200, 'status 200 for clean bot request');
};

# ============================================================
# 22. Full realistic CGI session: authenticated user submits a form
# ============================================================

subtest 'realistic session: authenticated user form submission' => sub {
    reset_env();
    $ENV{HTTP_USER_AGENT}   = 'Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) Chrome/120';
    $ENV{REMOTE_ADDR}       = '203.0.113.5';
    $ENV{HTTP_HOST}         = 'www.myapp.example.com';
    $ENV{SERVER_PROTOCOL}   = 'HTTP/1.1';
    $ENV{SCRIPT_FILENAME}   = '/var/www/cgi-bin/submit.cgi';
    $ENV{SCRIPT_NAME}       = '/cgi-bin/submit.cgi';
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'action=save&title=My+Post&category=tech';
    $ENV{HTTP_COOKIE}       = 'sessionid=s3cr3t; csrf=tok3n';

    my $info = CGI::Info->new(allow => {
        action   => qr/^(save|preview|delete)$/,
        title    => qr/^[\w\s\+]+$/,
        category => qr/^[a-z]+$/,
    });

    # Browser classification
    ok(!$info->is_mobile(),          'desktop Mac not mobile');
    ok(!$info->is_robot(),           'Chrome not a robot');
    is($info->browser_type(), 'web', 'browser_type is web');

    # Site details
    is($info->host_name(),   'www.myapp.example.com', 'host correct');
    is($info->domain_name(), 'myapp.example.com',     'domain correct');

    # Form params
    my $p = $info->params();
    ok(defined $p, 'params returned');
    is($p->{action},   'save', 'action param correct');
    is($p->{category}, 'tech', 'category param correct');

    # Individual param access
    is($info->param('action'), 'save', 'param(action) correct');

    # Cookie access
    is($info->cookie('sessionid'), 's3cr3t', 'session cookie read');
    is($info->cookie('csrf'),      'tok3n',  'csrf cookie read');

    # as_string for cache key
    my $key = $info->as_string();
    like($key, qr/action=save/, 'as_string usable as cache key');

    # Clean status throughout
    is($info->status(), 200, 'status 200 for authenticated form submission');
};

# ============================================================
# 23. Stateful: reset() between requests in FCGI-like environment
# ============================================================

subtest 'FCGI-like: reset() between requests prevents state bleed' => sub {
    # First request
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'user=alice';
    my $p1 = CGI::Info->new()->params();
    is($p1->{user}, 'alice', 'first request: user=alice');

    # Simulate FCGI reset between requests
    CGI::Info->reset();

    # Second request with different data
    $ENV{QUERY_STRING} = 'user=bob';
    my $p2 = CGI::Info->new()->params();
    is($p2->{user}, 'bob', 'second request after reset: user=bob');

    # No cross-contamination
    isnt($p1->{user}, $p2->{user}, 'no state bleed between requests');
};

# ============================================================
# 24. Stateful: messages_as_string joins all messages as semicolons
# ============================================================

subtest 'messages_as_string: multiple messages joined by semicolons' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';



( run in 0.520 second using v1.01-cache-2.11-cpan-bbb979687b5 )