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 )