view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

    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');
    ok($info->is_ai(),              'is_ai() true for ClaudeBot');
    is($info->browser_type(), 'ai', 'browser_type() is ai for AI crawler');
    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();

    my $host   = $info->host_name();
    my $domain = $info->domain_name();
    my $url    = $info->cgi_host_url();
    my $proto  = $info->protocol();

    is($host,   'www.example.com', 'host_name correct');
    is($domain, 'example.com',     'domain_name strips www.');
    like($url,  qr{^http://},      'cgi_host_url starts with http://');
    like($url,  qr/example\.com/,  'cgi_host_url contains host');
    is($proto,  'http',            'protocol is http');

    # domain_name is a suffix of host_name
    like($host, qr/\Q$domain\E$/, 'host_name ends with domain_name');

    # cgi_host_url contains the host_name
    like($url, qr/\Q$host\E/, 'cgi_host_url contains host_name');
};

subtest 'site details: HTTPS site consistent' => sub {
    reset_env();
    $ENV{SCRIPT_URI} = 'https://secure.example.org/cgi-bin/app.cgi';
    $ENV{HTTP_HOST}  = 'secure.example.org';

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

    is($info->protocol(),    'https',              'protocol is https');
    is($info->host_name(),   'secure.example.org', 'host_name correct');
    is($info->domain_name(), 'secure.example.org', 'domain_name (no www to strip)');
    like($info->cgi_host_url(), qr{^https?://},    'cgi_host_url has protocol');
};

# ============================================================
# 12. script_name, script_path, script_dir all consistent
# ============================================================

subtest 'script methods: name, path, dir all consistent' => sub {
    reset_env();
    if($^O eq 'MSWin32') {
        pass('script methods Unix-path test skipped on Windows');
        return;
    }
    $ENV{SCRIPT_FILENAME} = '/var/www/cgi-bin/myapp.cgi';