view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

#!/usr/bin/env perl

# t/edge_cases.t -- Hostile, pathological, boundary-condition, and security
# tests for CGI::Lingua.
#
# Strategy: every subtest actively tries to break, inject, overflow, or
# subvert the module.  Inputs are chosen specifically to probe the validation
# and sanitisation layer rather than the happy path.

use strict;
use warnings;

use CHI;
use Readonly;
use Scalar::Util qw(blessed weaken);
use Test::Most;
use Test::Mockingbird;
use Test::Returns qw(returns_ok);

use lib 't/lib';

BEGIN { use_ok('CGI::Lingua') }

# Pre-require lazily-loaded modules before installing mocks
my $HAS_LWP  = eval { require LWP::Simple::WithCache; 1 } ? 1 : 0;
my $HAS_JSON = eval { require JSON::Parse;             1 } ? 1 : 0;

# ── Constants ─────────────────────────────────────────────────────────────────

Readonly my %LANG => (EN => 'en', FR => 'fr', EN_GB => 'en-gb');

Readonly my %IP => (
	PUBLIC   => '8.8.8.8',
	LOOPBACK => '127.0.0.1',
	PRIVATE  => '192.168.1.1',
);

# Accept-Language header string of exactly ACCEPT_LANG_MAX (256) chars.
Readonly my $ACCEPT_LANG_AT_MAX  => 'a' x 256;
# One byte over the documented 256-byte cap.
Readonly my $ACCEPT_LANG_OVER    => 'a' x 257;
# String of 'a' chars long enough to stress the limit.
Readonly my $ACCEPT_LANG_HUGE    => 'a' x 10_000;

# Cache namespace as defined in the module constant CACHE_NS.
Readonly my $CACHE_NS => 'CGI::Lingua:';

# ── Global network block ──────────────────────────────────────────────────────
_block_network();

# ── Helpers ───────────────────────────────────────────────────────────────────

sub _block_network {
	Test::Mockingbird::mock('CGI::Lingua', '_resolve_country_via_whois', sub { });
	Test::Mockingbird::mock('LWP::Simple::WithCache', 'get', sub { undef })
		if $HAS_LWP;
}

sub _obj {
	my ($supported, %extra) = @_;
	CGI::Lingua->new(supported => $supported, %extra);
}

# Inject "IP::Country present but returns the given code" for a fresh object.
sub _inject_ipcountry {
	my ($l, $cc) = @_;
	Test::Mockingbird::mock('IP::Country::Fast', 'inet_atocc', sub { $cc });
	$l->{_have_ipcountry} = 1;
	$l->{_ipcountry}      = bless {}, 'IP::Country::Fast';
	$l->{_have_geoip}     = 0;
	$l->{_have_geoipfree} = 0;
}

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 1: Constructor hostile inputs