desktop results from the CPAN

CGI-Info

use Scalar::Util qw(blessed);
use Test::Mockingbird 0.08 qw(mock mock_scoped mock_return spy restore_all);

# CGI::Info must load cleanly before any mocking
BEGIN { use_ok('CGI::Info') or BAIL_OUT('CGI::Info failed to load') }

# Silence Log::Abstraction's _high_priority stderr for the entire run.
# WAF blocks and validation failures generate expected log output that
# would otherwise pollute harness output; we assert on return values.
mock 'Log::Abstraction::_high_priority' => sub { };

# ============================================================
# Configuration constants -- no magic literals anywhere below
# ============================================================
Readonly my $UPLOAD_SMALL      => 100;
Readonly my $UPLOAD_MAX        => 2048;
Readonly my $UPLOAD_OVERSIZED  => 999_999_999;
Readonly my $GOOD_IP           => '1.2.3.4';
Readonly my $GOOGLEBOT_IP      => '66.249.66.1';
Readonly my $PORT_HTTP         => 80;
Readonly my $PORT_HTTPS        => 443;
Readonly my $STATUS_OK         => 200;
Readonly my $STATUS_FORBIDDEN  => 403;
Readonly my $STATUS_NOT_FOUND  => 404;
Readonly my $STATUS_METHOD_NA  => 405;
Readonly my $STATUS_LENGTH_REQ => 411;
Readonly my $STATUS_TOO_LARGE  => 413;
Readonly my $STATUS_UNPROC     => 422;
Readonly my $UA_IPHONE  => 'Mozilla/5.0 (iPhone; CPU iPhone OS 14_0 like Mac OS X)';
Readonly my $UA_ANDROID => 'Mozilla/5.0 (Linux; Android 10; Pixel 3)';
Readonly my $UA_IPAD    => 'Mozilla/5.0 (iPad; CPU OS 14_0 like Mac OS X)';
Readonly my $UA_DESKTOP => 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 Chrome/120';
Readonly my $UA_GBOT         => 'Googlebot/2.1 (+http://www.google.com/bot.html)';
Readonly my $UA_CBOT         => 'ClaudeBot/1.0';
Readonly my $UA_CLAUDE_WEB   => 'Claude-Web/1.0';
Readonly my $UA_GPTBOT       => 'Mozilla/5.0 AppleWebKit/537.36 (KHTML, like Gecko; compatible; GPTBot/1.2; +https://openai.com/gptbot)';
Readonly my $UA_CHATGPT_USER => 'Mozilla/5.0 AppleWebKit/537.36 (KHTML, like Gecko); ChatGPT-User/1.0; +https://openai.com/bot)';
Readonly my $UA_COHERE_AI    => 'cohere-ai/1.0';
# GPTBot UA that also embeds a SQL injection payload: used to verify WAF ordering
Readonly my $UA_GPTBOT_SQL   => 'GPTBot/1.0 SELECT foo AND bar FROM baz';

# %config gathers all constants for Object::Configure-style flexibility
my %config = (
	upload_small      => $UPLOAD_SMALL,
	upload_max        => $UPLOAD_MAX,
	upload_oversized  => $UPLOAD_OVERSIZED,
	good_ip           => $GOOD_IP,
	googlebot_ip      => $GOOGLEBOT_IP,
	port_http         => $PORT_HTTP,
	port_https        => $PORT_HTTPS,
	status_ok         => $STATUS_OK,
	status_forbidden  => $STATUS_FORBIDDEN,
	status_not_found  => $STATUS_NOT_FOUND,
	status_method_na  => $STATUS_METHOD_NA,
	status_length_req => $STATUS_LENGTH_REQ,
	status_too_large  => $STATUS_TOO_LARGE,
	status_unproc     => $STATUS_UNPROC,
	ua_iphone         => $UA_IPHONE,
	ua_android        => $UA_ANDROID,
	ua_ipad           => $UA_IPAD,
	ua_desktop        => $UA_DESKTOP,
	ua_gbot           => $UA_GBOT,
	ua_cbot           => $UA_CBOT,
	ua_claude_web     => $UA_CLAUDE_WEB,
	ua_gptbot         => $UA_GPTBOT,
	ua_chatgpt_user   => $UA_CHATGPT_USER,
	ua_cohere_ai      => $UA_COHERE_AI,
	ua_gptbot_sql     => $UA_GPTBOT_SQL,
);

# ---------------------------------------------------------------------------
# Helper: wipe CGI environment variables and class state between subtests
# ---------------------------------------------------------------------------
sub reset_env {
	delete $ENV{$_} for qw(
		GATEWAY_INTERFACE REQUEST_METHOD QUERY_STRING CONTENT_TYPE
		CONTENT_LENGTH SCRIPT_NAME SCRIPT_FILENAME DOCUMENT_ROOT
		C_DOCUMENT_ROOT HTTP_HOST SERVER_NAME SSL_TLS_SNI SERVER_PROTOCOL
		SERVER_PORT SCRIPT_URI REMOTE_ADDR HTTP_USER_AGENT HTTP_COOKIE
		HTTP_X_WAP_PROFILE HTTP_SEC_CH_UA_MOBILE HTTP_REFERER IS_MOBILE
		IS_SEARCH_ENGINE IS_AI LOGDIR
	);
	CGI::Info->reset();
}

# ============================================================
# 1. new()
# ============================================================

# Basic object construction
subtest 'new() - basic instantiation returns blessed object' => sub {
	plan tests => 2;
	reset_env();
	my $info = CGI::Info->new();
	ok(blessed($info), 'new() returns a blessed reference');
	isa_ok($info, 'CGI::Info');
};

# Hashref argument style
subtest 'new() - hashref args set internal fields' => sub {
	plan tests => 1;
	reset_env();
	my $info = CGI::Info->new({ max_upload_size => $config{upload_small} });
	is($info->{max_upload_size}, $config{upload_small}, 'max_upload_size set via hashref');
};

# Flat hash argument style
subtest 'new() - flat hash args set internal fields' => sub {
	plan tests => 1;
	reset_env();
	my $info = CGI::Info->new(max_upload_size => $config{upload_max});
	is($info->{max_upload_size}, $config{upload_max}, 'max_upload_size set via flat hash');
};

# Clone path merges args over parent, parent unchanged
subtest 'new() - clone overrides field without modifying parent' => sub {
	plan tests => 2;
	reset_env();
	my $orig  = CGI::Info->new(max_upload_size => 999);
	my $clone = $orig->new(max_upload_size => 111);
	is($clone->{max_upload_size}, 111, 'clone has overridden field');

t/function.t view on Meta::CPAN


# SERVER_PORT 443 boundary -- exact value, one below, one above
subtest 'protocol() - SERVER_PORT 443 boundary' => sub {
	plan tests => 3;
	reset_env();
	my $guard = mock_scoped 'Socket::getservbyport' => sub { return undef };

	$ENV{SERVER_PORT} = $config{port_https};
	is(CGI::Info->new()->protocol(), 'https', 'port 443 => https');

	$ENV{SERVER_PORT} = $config{port_https} - 1;
	my $p = CGI::Info->new()->protocol();
	ok(!defined($p) || $p ne 'https', 'port 442 does not return https');

	$ENV{SERVER_PORT} = $config{port_https} + 1;
	$p = CGI::Info->new()->protocol();
	ok(!defined($p) || $p ne 'https', 'port 444 does not return https');
};

# SERVER_PORT 80 boundary
subtest 'protocol() - SERVER_PORT 80 boundary' => sub {
	plan tests => 3;
	reset_env();
	my $guard = mock_scoped 'Socket::getservbyport' => sub { return undef };

	$ENV{SERVER_PORT} = $config{port_http};
	is(CGI::Info->new()->protocol(), 'http', 'port 80 => http');

	$ENV{SERVER_PORT} = $config{port_http} - 1;
	my $p = CGI::Info->new()->protocol();
	ok(!defined($p) || $p ne 'http', 'port 79 does not return http');

	$ENV{SERVER_PORT} = $config{port_http} + 1;
	$p = CGI::Info->new()->protocol();
	ok(!defined($p) || $p ne 'http', 'port 81 does not return http');
};

# ============================================================
# 10. is_mobile()
# ============================================================

# iPhone UA detected as mobile
subtest 'is_mobile() - iPhone user-agent' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_iphone};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	ok(CGI::Info->new()->is_mobile(), 'iPhone UA detected as mobile');
};

# Android UA detected as mobile
subtest 'is_mobile() - Android user-agent' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_android};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	ok(CGI::Info->new()->is_mobile(), 'Android UA detected as mobile');
};

# Desktop UA not detected as mobile
subtest 'is_mobile() - desktop user-agent not mobile' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_desktop};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	ok(!CGI::Info->new()->is_mobile(), 'desktop UA not detected as mobile');
};

# Sec-CH-UA-Mobile: ?1 header
subtest 'is_mobile() - Sec-CH-UA-Mobile hint' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_SEC_CH_UA_MOBILE} = '?1';
	ok(CGI::Info->new()->is_mobile(), 'Sec-CH-UA-Mobile ?1 detected as mobile');
};

# HTTP_X_WAP_PROFILE signals a mobile device
subtest 'is_mobile() - WAP profile header' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_X_WAP_PROFILE} = 'http://wap.example.com/profile';
	ok(CGI::Info->new()->is_mobile(), 'HTTP_X_WAP_PROFILE signals mobile');
};

# IS_MOBILE env override
subtest 'is_mobile() - IS_MOBILE env override' => sub {
	plan tests => 1;
	reset_env();
	$ENV{IS_MOBILE} = 1;
	ok(CGI::Info->new()->is_mobile(), 'IS_MOBILE env override works');
};

# ============================================================
# 11. is_tablet()
# ============================================================

subtest 'is_tablet() - iPad user-agent' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_ipad};
	ok(CGI::Info->new()->is_tablet(), 'iPad UA detected as tablet');
};

subtest 'is_tablet() - desktop user-agent not a tablet' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Windows NT 10.0)';
	ok(!CGI::Info->new()->is_tablet(), 'desktop UA not detected as tablet');
};

# ============================================================
# 12. is_robot()
# ============================================================

# Googlebot may be classed as robot or search engine, both are correct
subtest 'is_robot() - Googlebot classed as robot or search engine' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_gbot};
	$ENV{REMOTE_ADDR}     = $config{googlebot_ip};
	my $info   = CGI::Info->new();
	my $result = $info->is_robot() || $info->is_search_engine();
	ok($result, 'Googlebot classified as robot or search engine');
};

# ClaudeBot is a known robot
subtest 'is_robot() - ClaudeBot detected' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_cbot};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	ok(CGI::Info->new()->is_robot(), 'ClaudeBot detected as robot');
};

# SQL injection in UA sets 403 and marks as robot
subtest 'is_robot() - SQL injection in UA sets 403' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_USER_AGENT} = 'Mozilla SELECT foo AND bar FROM baz';
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	my $info = CGI::Info->new();
	ok($info->is_robot(), 'SQL injection UA flagged as robot');
	is($info->status(), $config{status_forbidden}, 'status 403 on SQL injection UA');
};

# No CGI environment means assume real person (return 0)
subtest 'is_robot() - no CGI env returns 0' => sub {
	plan tests => 1;
	reset_env();
	is(CGI::Info->new()->is_robot(), 0, 'no CGI env returns 0 (assumes real person)');
};

# Critical security invariant: the SQL injection WAF check runs BEFORE is_ai(),
# so an AI crawler UA that also contains an injection payload still receives 403.
# If this order were reversed, the AI check would short-circuit and skip the WAF.
subtest 'is_robot() - SQL injection in AI crawler UA triggers 403 (ordering invariant)' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_gptbot_sql};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	my $info = CGI::Info->new();
	ok($info->is_robot(), 'injection in AI UA => is_robot still true');
	is($info->status(), $config{status_forbidden},
		'injection in AI UA => HTTP 403 set (WAF not bypassed by AI classification)');
};

# ============================================================
# 13. is_search_engine()
# ============================================================

subtest 'is_search_engine() - IS_SEARCH_ENGINE env override' => sub {
	plan tests => 1;
	reset_env();
	$ENV{IS_SEARCH_ENGINE} = 1;
	$ENV{REMOTE_ADDR}      = $config{good_ip};
	$ENV{HTTP_USER_AGENT}  = 'SomeBot';
	ok(CGI::Info->new()->is_search_engine(), 'IS_SEARCH_ENGINE env override works');
};

subtest 'is_search_engine() - no CGI env returns 0' => sub {
	plan tests => 1;
	reset_env();
	is(CGI::Info->new()->is_search_engine(), 0, 'no CGI env returns 0');
};

# ============================================================
# 14. is_ai()
# ============================================================

# Known AI training crawler => is_ai true and browser_type 'ai'
subtest 'is_ai() - ClaudeBot detected as AI crawler' => sub {
	plan tests => 3;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_cbot};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	my $info = CGI::Info->new();
	ok($info->is_ai(),                     'ClaudeBot => is_ai true');
	ok($info->is_robot(),                  'ClaudeBot => is_robot true (invariant)');
	is($info->browser_type(), 'ai',        'ClaudeBot => browser_type is ai');
};

# UA with no "bot"/"spider" token must still satisfy is_ai AND is_robot
subtest 'is_ai() - ChatGPT-User (no bot token) satisfies invariant' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 AppleWebKit/537.36 (KHTML, like Gecko); ChatGPT-User/1.0; +https://openai.com/bot)';
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	my $info = CGI::Info->new();
	ok($info->is_ai(),    'ChatGPT-User => is_ai true');
	ok($info->is_robot(), 'ChatGPT-User => is_robot true (is_robot calls is_ai internally)');
};

# IS_AI env override (use local so the override cannot bleed into later tests)
subtest 'is_ai() - IS_AI env override' => sub {
	plan tests => 1;
	reset_env();
	local $ENV{IS_AI}     = 1;
	$ENV{HTTP_USER_AGENT} = $config{ua_desktop};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	ok(CGI::Info->new()->is_ai(), 'IS_AI=1 env override forces is_ai true');
};

# Non-AI UA must not trigger is_ai
subtest 'is_ai() - desktop UA is not AI' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_desktop};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	ok(!CGI::Info->new()->is_ai(), 'desktop UA is not detected as AI crawler');
};

# No CGI environment => 0
subtest 'is_ai() - no CGI env returns 0' => sub {
	plan tests => 1;
	reset_env();
	is(CGI::Info->new()->is_ai(), 0, 'no CGI env returns 0');
};

# Call-order invariant: is_robot() first, then is_ai()
subtest 'is_ai() - call order: is_robot first still gives is_ai true' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_claude_web};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	my $info = CGI::Info->new();
	ok($info->is_robot(), 'Claude-Web: is_robot() true when called first');
	ok($info->is_ai(),    'Claude-Web: is_ai() true after is_robot()');
};

# IS_AI=0 must force false even when the UA matches the AI pattern.
# The env override is authoritative in both directions.
subtest 'is_ai() - IS_AI=0 override forces false for known AI UA' => sub {
	plan tests => 1;
	reset_env();
	local $ENV{IS_AI}     = 0;
	$ENV{HTTP_USER_AGENT} = $config{ua_cbot};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	ok(!CGI::Info->new()->is_ai(), 'IS_AI=0 env override suppresses AI detection');
};

# Without REMOTE_ADDR the CGI environment is incomplete; method returns 0
# without caching, consistent with is_robot() and is_search_engine() behaviour.
subtest 'is_ai() - no REMOTE_ADDR returns 0' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_cbot};
	# REMOTE_ADDR deliberately absent
	ok(!CGI::Info->new()->is_ai(), 'absent REMOTE_ADDR => is_ai returns 0');
};

# GPTBot (OpenAI training crawler): representative OpenAI-family UA.
# Confirms that is_ai does not depend on "ClaudeBot" alone.
subtest 'is_ai() - GPTBot detected as AI crawler' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_gptbot};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	my $info = CGI::Info->new();
	ok($info->is_ai(),    'GPTBot => is_ai true');
	ok($info->is_robot(), 'GPTBot => is_robot true (invariant holds)');
};

# cohere-ai contains no "bot" or "spider" token; this exercises the regex
# branches that cover unusual AI crawler UA string formats.
subtest 'is_ai() - cohere-ai UA (no bot/spider token) satisfies invariant' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_cohere_ai};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	my $info = CGI::Info->new();
	ok($info->is_ai(),    'cohere-ai => is_ai true');
	ok($info->is_robot(), 'cohere-ai => is_robot true (no "bot" token -- tests invariant path)');
};

# Googlebot is a search engine robot but NOT an AI training crawler;
# is_ai() must return false for it even though is_robot() returns true.
subtest 'is_ai() - Googlebot is robot but not AI' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_gbot};
	$ENV{REMOTE_ADDR}     = $config{googlebot_ip};
	my $info = CGI::Info->new();
	ok(!$info->is_ai(), 'Googlebot => is_ai false');
	ok($info->is_robot() || $info->is_search_engine(),
		'Googlebot => still classified as robot or search engine');
};

# The first call computes and caches $self->{is_ai}; the second call must
# return the same result from the cache without re-evaluating the UA regex.
subtest 'is_ai() - result is cached within the same instance' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_cbot};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	my $info   = CGI::Info->new();
	my $first  = $info->is_ai();
	my $second = $info->is_ai();	# must hit $self->{is_ai} cache
	ok($first,             'first call => is_ai true');
	is($second, $first,    'second call => identical cached result');
};

# Call-order: is_ai() first sets $self->{is_robot}=1; is_robot() then hits
# the instance cache and returns 1 without re-running its own detection logic.
subtest 'is_ai() - call order: is_ai first populates is_robot cache' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_claude_web};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	my $info = CGI::Info->new();
	ok($info->is_ai(),    'Claude-Web: is_ai() true when called first');
	ok($info->is_robot(), 'Claude-Web: is_robot() true after is_ai() (cache set by is_ai)');
};

# ============================================================
# 15. browser_type()
# ============================================================

subtest 'browser_type() - mobile' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_iphone};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	is(CGI::Info->new()->browser_type(), 'mobile', 'iPhone browser_type is mobile');
};

subtest 'browser_type() - desktop is web' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_desktop};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	is(CGI::Info->new()->browser_type(), 'web', 'desktop browser_type is web');
};

# AI crawlers must be classified as 'ai', which is checked before 'robot'.
# Verifies the priority order: mobile > ai > search > robot > web.
subtest 'browser_type() - returns ai for known AI crawler' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = $config{ua_cbot};
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	is(CGI::Info->new()->browser_type(), 'ai', 'ClaudeBot => browser_type is ai');
};

# A generic spider that is NOT in the AI list must still return 'robot',
# not 'ai', confirming the AI check does not over-reach.
subtest 'browser_type() - generic spider returns robot not ai' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_USER_AGENT} = 'SomeGenericSpider/1.0';
	$ENV{REMOTE_ADDR}     = $config{good_ip};
	is(CGI::Info->new()->browser_type(), 'robot', 'generic spider => browser_type is robot');
};

# ============================================================
# 15. cookie() / get_cookie()
# ============================================================

# cookie() returns value for known cookie name
subtest 'cookie() - returns value for known cookie' => sub {
	plan tests => 2;
	reset_env();
	$ENV{HTTP_COOKIE} = 'session=abc123; user=bob';
	my $info = CGI::Info->new();
	is($info->cookie('session'), 'abc123', 'cookie() returns session value');
	is($info->cookie('user'),    'bob',    'cookie() returns user value');
};

# Missing cookie returns undef
subtest 'cookie() - returns undef for missing cookie' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_COOKIE} = 'a=1';
	ok(!defined CGI::Info->new()->cookie('nosuchcookie'), 'missing cookie returns undef');
};

# get_cookie() is an alias for cookie()
subtest 'get_cookie() - named-arg alias for cookie()' => sub {
	plan tests => 1;
	reset_env();
	$ENV{HTTP_COOKIE} = 'token=xyz';
	my $info = CGI::Info->new();
	is($info->get_cookie(cookie_name => 'token'), 'xyz', 'get_cookie() named-arg alias works');
};

# No HTTP_COOKIE means undef
subtest 'cookie() - no HTTP_COOKIE returns undef' => sub {
	plan tests => 1;
	reset_env();
	ok(!defined CGI::Info->new()->cookie('x'), 'no HTTP_COOKIE env returns undef');
};

t/function.t view on Meta::CPAN

	# Object::Configure has injected a logger; _error must not croak
	lives_ok { $info->_error('logged error') }
		'_error does not croak when a logger is present';
};

# ============================================================
# 30. POST with application/json content type
# ============================================================

subtest 'params() - POST JSON body decoded to hash' => sub {
	plan tests => 1;
	reset_env();
	my $json_body = '{"alpha":"one","beta":"two"}';
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}    = 'POST';
	$ENV{CONTENT_TYPE}      = 'application/json';
	$ENV{CONTENT_LENGTH}    = length($json_body);
	$CGI::Info::stdin_data  = $json_body;

	my $info = CGI::Info->new();
	my $p    = $info->params();
	if (defined $p) {
		is($p->{alpha}, 'one', 'JSON POST: alpha=one');
	} else {
		pass('JSON POST: no result (JSON module unavailable, acceptable)');
	}
};

# ============================================================
# 31. POST with text/xml content type
# ============================================================

subtest 'params() - POST XML body stored under XML key' => sub {
	plan tests => 2;
	reset_env();
	my $xml_body = '<root><item>test</item></root>';
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}    = 'POST';
	$ENV{CONTENT_TYPE}      = 'text/xml';
	$ENV{CONTENT_LENGTH}    = length($xml_body);
	$CGI::Info::stdin_data  = $xml_body;

	my $info = CGI::Info->new();
	my $p    = $info->params();
	ok(defined $p,          'XML POST returns a defined hashref');
	is($p->{XML}, $xml_body, 'XML body stored under key "XML"');
};

# ============================================================
# 32. $_ preservation (internal helpers must not clobber $_)
# Any internal use of for/foreach without a lexical variable could
# overwrite $_ in the caller's scope.
# ============================================================

subtest '$_ not clobbered by public methods' => sub {
	plan tests => 6;
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}    = 'GET';
	$ENV{QUERY_STRING}      = 'x=1';
	$ENV{HTTP_USER_AGENT}   = $config{ua_desktop};
	$ENV{REMOTE_ADDR}       = $config{good_ip};
	$ENV{HTTP_HOST}         = 'example.com';

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

	# Set $_ to a sentinel and verify each method leaves it unchanged
	local $_ = 'SENTINEL';

	$info->params();
	is($_, 'SENTINEL', 'params() does not clobber $_');

	$info->is_mobile();
	is($_, 'SENTINEL', 'is_mobile() does not clobber $_');

	$info->is_robot();
	is($_, 'SENTINEL', 'is_robot() does not clobber $_');

	$info->as_string();
	is($_, 'SENTINEL', 'as_string() does not clobber $_');

	$info->script_name();
	is($_, 'SENTINEL', 'script_name() does not clobber $_');

	$info->host_name();
	is($_, 'SENTINEL', 'host_name() does not clobber $_');
};

# Internal helpers must also preserve $_
subtest '$_ not clobbered by internal helpers' => sub {
	plan tests => 3;
	reset_env();
	my $info = CGI::Info->new();

	local $_ = 'SENTINEL2';

	$info->_log('info', 'msg');
	is($_, 'SENTINEL2', '_log does not clobber $_');

	$info->_debug('dbg');
	is($_, 'SENTINEL2', '_debug does not clobber $_');

	CGI::Info::_sanitise_input('hello world');
	is($_, 'SENTINEL2', '_sanitise_input does not clobber $_');
};

# ============================================================
# 33. Test::Memory::Cycle -- object must be cycle-free
# ============================================================

subtest 'CGI::Info object has no circular references' => sub {
	plan tests => 1;
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}    = 'GET';
	$ENV{QUERY_STRING}      = 'a=1&b=2';
	$ENV{HTTP_USER_AGENT}   = $config{ua_iphone};
	$ENV{REMOTE_ADDR}       = $config{good_ip};
	$ENV{HTTP_HOST}         = 'example.com';

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

( run in 4.748 seconds using v1.01-cache-2.11-cpan-9789f410c06 )