CGI-Info
view release on metacpan or search on metacpan
t/function.t view on Meta::CPAN
};
subtest 'is_mobile() - Android user agent' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Linux; Android 10; Pixel 3)';
$ENV{REMOTE_ADDR} = '1.2.3.4';
my $info = CGI::Info->new();
ok($info->is_mobile(), 'Android UA detected as mobile');
};
subtest 'is_mobile() - desktop user agent' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36';
$ENV{REMOTE_ADDR} = '1.2.3.4';
my $info = CGI::Info->new();
ok(!$info->is_mobile(), 'desktop UA not detected as mobile');
};
subtest 'is_mobile() - Sec-CH-UA-Mobile hint' => sub {
reset_env();
$ENV{HTTP_SEC_CH_UA_MOBILE} = '?1';
my $info = CGI::Info->new();
ok($info->is_mobile(), 'Sec-CH-UA-Mobile ?1 detected as mobile');
};
subtest 'is_mobile() - HTTP_X_WAP_PROFILE' => sub {
t/function.t view on Meta::CPAN
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (iPad; CPU OS 14_0 like Mac OS X)';
my $info = CGI::Info->new();
ok($info->is_tablet(), 'iPad UA detected as tablet');
};
subtest 'is_tablet() - non-tablet user agent' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Windows NT 10.0)';
my $info = CGI::Info->new();
ok(!$info->is_tablet(), 'desktop UA not a tablet');
};
# ============================================================
# 12. is_robot()
# ============================================================
subtest 'is_robot() - known bot UA' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Googlebot/2.1 (+http://www.google.com/bot.html)';
$ENV{REMOTE_ADDR} = '66.249.66.1';
my $info = CGI::Info->new();
t/function.t view on Meta::CPAN
# 14. browser_type()
# ============================================================
subtest 'browser_type() - mobile' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (iPhone; CPU iPhone OS 14_0 like Mac OS X)';
$ENV{REMOTE_ADDR} = '1.2.3.4';
my $info = CGI::Info->new();
is($info->browser_type(), 'mobile', 'mobile browser_type');
};
subtest 'browser_type() - web (desktop)' => 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();
is($info->browser_type(), 'web', 'desktop browser_type is web');
};
# ============================================================
# 15. cookie() / get_cookie()
# ============================================================
subtest 'cookie() - returns value for existing cookie' => sub {
reset_env();
$ENV{HTTP_COOKIE} = 'session=abc123; user=bob';
my $info = CGI::Info->new();
is($info->cookie('session'), 'abc123', 'cookie() returns session value');
t/integration.t view on Meta::CPAN
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');
t/integration.t view on Meta::CPAN
$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');
ok(CGI::Info->new()->is_mobile(), 'iPhone UA is mobile');
};
subtest 'is_mobile() - true for Android user agent' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Linux; Android 11; Pixel 5)';
$ENV{REMOTE_ADDR} = '1.2.3.4';
ok(CGI::Info->new()->is_mobile(), 'Android UA is mobile');
};
subtest 'is_mobile() - false for desktop user agent' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) Chrome/120';
$ENV{REMOTE_ADDR} = '1.2.3.4';
ok(!CGI::Info->new()->is_mobile(), 'desktop UA is not mobile');
};
subtest 'is_mobile() - overridden by IS_MOBILE=1' => sub {
reset_env();
$ENV{IS_MOBILE} = 1;
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Windows NT 10.0)';
ok(CGI::Info->new()->is_mobile(), 'IS_MOBILE=1 overrides UA detection');
};
subtest 'is_mobile() - true via Sec-CH-UA-Mobile hint' => sub {
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (iPad; CPU OS 15_0 like Mac OS X)';
ok(CGI::Info->new()->is_tablet(), 'iPad UA is tablet');
};
subtest 'is_tablet() - false for iPhone user agent' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (iPhone; CPU iPhone OS 15_0 like Mac OS X)';
ok(!CGI::Info->new()->is_tablet(), 'iPhone UA is not a tablet');
};
subtest 'is_tablet() - false for desktop user agent' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64)';
ok(!CGI::Info->new()->is_tablet(), 'desktop UA is not a tablet');
};
# ============================================================
# is_robot()
# POD: returns boolean; true for robots/crawlers;
# SQL injection in UA sets status 403 and returns true
# ============================================================
subtest 'is_robot() - false when no CGI environment' => sub {
reset_env();
# POD: returns one of 'web', 'search', 'robot', 'mobile'
# ============================================================
subtest 'browser_type() - returns mobile for smartphone UA' => 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';
is(CGI::Info->new()->browser_type(), 'mobile', 'smartphone => mobile');
};
subtest 'browser_type() - returns web for desktop browser' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) Chrome/120';
$ENV{REMOTE_ADDR} = '1.2.3.4';
is(CGI::Info->new()->browser_type(), 'web', 'desktop => web');
};
subtest 'browser_type() - returns robot for known bot' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'ClaudeBot/1.0';
$ENV{REMOTE_ADDR} = '1.2.3.4';
is(CGI::Info->new()->browser_type(), 'robot', 'bot => robot');
};
subtest 'browser_type() - return value is one of the four valid strings' => sub {
( run in 2.422 seconds using v1.01-cache-2.11-cpan-bbb979687b5 )