lib/CGI/Lingua.pm

        start → end → jump
        

    1: package CGI::Lingua;
    2: 
    3: use warnings;
    4: use strict;
    5: use autodie qw(:all);
    6: 
    7: use Carp qw(croak carp);
    8: use Object::Configure 0.23;
    9: use Params::Get 0.15;	# 0.15 fast-path: unblessed hashref returned directly
   10: use Readonly;
   11: use Scalar::Util qw(blessed);
   12: use JSON::PP ();
   13: use Class::Autouse qw{
   14: 	Locale::Language
   15: 	Locale::Object::Country
   16: 	Locale::Object::DB
   17: 	I18N::AcceptLanguage
   18: 	I18N::LangTags::Detect
   19: };
   20: 
   21: our $VERSION = '0.84';
   22: 
   23: # ── Module-level constants ───────────────────────────────────────────────────
   24: # Gathering magic strings here makes behavioural changes one-edit operations.
   25: 
   26: Readonly my $CACHE_TTL_LONG      => '1 month';
   27: Readonly my $CACHE_TTL_SHORT     => '1 hour';
   28: Readonly my $CACHE_NS            => 'CGI::Lingua:';    # namespace prefix for every key
   29: Readonly my $BROKEN_GEOIPFREE    => '45.128.139.41';  # https://github.com/bricas/geo-ipfree/issues/10
   30: Readonly my $BAIDU_SUBNET        => '185.10.104.0/22';# RT-86809: Baidu misreports as EU
   31: Readonly my $DEPRECATED_EN_UK    => 'en-uk';          # some browsers still send this
   32: Readonly my $CANONICAL_EN_GB     => 'en-gb';
   33: Readonly my $ACCEPT_LANG_MAX     => 256;              # max bytes we accept from the header
   34: Readonly my $UA_MAX              => 512;              # max bytes we accept from HTTP_USER_AGENT
   35: Readonly my $GEO_UNKNOWN         => -1;               # geo-module sentinel: not yet probed
   36: Readonly my $GEO_ABSENT          =>  0;               # geo-module sentinel: unavailable
   37: Readonly my $GEO_PRESENT         =>  1;               # geo-module sentinel: loaded OK
   38: Readonly my %RTL_LANGS           => (map { $_ => 1 }  # ISO 639-1 codes whose primary script is RTL
   39: 	qw(ar dv fa he ku ps sd ug ur yi));
   40: 
   41: =head1 NAME
   42: 
   43: CGI::Lingua - Create a multilingual web page
   44: 
   45: =head1 VERSION
   46: 
   47: Version 0.84
   48: 
   49: =cut
   50: 
   51: =head1 SYNOPSIS
   52: 
   53: CGI::Lingua is a powerful module for multilingual web applications
   54: offering extensive language/country detection strategies.
   55: 
   56: No longer does your website need to be in English only.
   57: CGI::Lingua provides a simple basis to determine which language to display a website.
   58: The website tells CGI::Lingua which languages it supports.
   59: Based on that list CGI::Lingua tells the application which language the user would like to use.
   60: 
   61:     use CGI::Lingua;
   62:     # ...
   63:     my $l = CGI::Lingua->new(['en', 'fr', 'en-gb', 'en-us']);
   64:     my $language = $l->language();
   65:     if ($language eq 'English') {
   66: 	print '<P>Hello</P>';
   67:     } elsif($language eq 'French') {
   68: 	print '<P>Bonjour</P>';
   69:     } else {	# $language eq 'Unknown'
   70: 	my $rl = $l->requested_language();
   71: 	print "<P>Sorry for now this page is not available in $rl.</P>";
   72:     }
   73:     my $c = $l->country();
   74:     if ($c eq 'us') {
   75:       # print contact details in the US
   76:     } elsif ($c eq 'ca') {
   77:       # print contact details in Canada
   78:     } else {
   79:       # print worldwide contact details
   80:     }
   81: 
   82:     # ...
   83: 
   84:     use CHI;
   85:     use CGI::Lingua;
   86:     # ...
   87:     my $cache = CHI->new(driver => 'File', root_dir => '/tmp/cache', namespace => 'CGI::Lingua-countries');
   88:     $l = CGI::Lingua->new({ supported => ['en', 'fr'], cache => $cache });
   89: 
   90: =head1 SUBROUTINES/METHODS
   91: 
   92: =head2 new
   93: 
   94: Creates a CGI::Lingua object.
   95: 
   96: =head3 API SPECIFICATION
   97: 
   98:     Input:
   99:       supported  => ArrayRef[Str] | Str   # required; RFC-1766 language codes
  100:       cache      => Object                # optional; CHI-compatible (get/set)
  101:       config_file => Str                  # optional; YAML/XML/INI config path
  102:       logger     => Object                # optional; must implement warn/info/error
  103:       info       => Object                # optional; CGI::Info-compatible
  104:       data       => Any                   # optional; forwarded to I18N::AcceptLanguage
  105:       dont_use_ip => Bool                 # optional; disable IP-based fallback
  106:       syslog     => Bool | HashRef        # optional; Sys::Syslog integration
  107:       debug      => Bool                  # optional; enable debug logging
  108: 
  109:     Returns: CGI::Lingua blessed hashref, or a clone when called on an object.
  110: 
  111: =head3 EXAMPLE
  112: 
  113:     # Array-ref of supported codes (most common form)
  114:     my $l = CGI::Lingua->new({ supported => ['en', 'fr', 'de'] });
  115: 
  116:     # Single scalar code
  117:     my $l = CGI::Lingua->new(supported => 'en');
  118: 
  119:     # With cache, logger, and CGI::Info object
  120:     use CHI;
  121:     my $cache = CHI->new(driver => 'File', root_dir => '/tmp/lingua-cache');
  122:     my $l = CGI::Lingua->new({
  123:         supported => ['en', 'fr'],
  124:         cache     => $cache,
  125:         logger    => $my_log_object,
  126:     });
  127: 
  128:     # Clone an existing object with different supported list
  129:     my $clone = $l->new(supported => ['de']);
  130: 
  131: =head3 MESSAGES
  132: 
  133:     "You must give a list of supported languages"  - no 'supported' key provided
  134:     "List of supported languages must be an array ref" - supported is wrong ref type
  135:     "Supported languages must be the short code"  - string too short or too long
  136:     "Logger must be a blessed object with warn/info/error methods" - bad logger arg
  137: 
  138: =head3 PSEUDOCODE
  139: 
  140:     1. Normalise args via Params::Get and Object::Configure
  141:     2. Validate logger (must be blessed with warn/info/error) if provided
  142:     3. Validate supported (required, string or arrayref)
  143:     4. If cache and REMOTE_ADDR set, attempt to thaw a previously stored state
  144:     5. Bless and return fresh object with sentinel flags set to GEO_UNKNOWN
  145: 
  146: =cut
  147: 
  148: sub new
  149: {
●150 → 154 → 171  150: 	my $class = shift;
  151: 	my $params = Params::Get::get_params('supported', @_);
  152: 
  153: 	# Handle ::new() misuse
  154: 	if(!defined($class)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  155: 		if($params) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  156: 			if(my $logger = $params->{'logger'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  157: 				$logger->error(__PACKAGE__ . ' use ->new() not ::new() to instantiate');
  158: 			}
  159: 			croak(__PACKAGE__ . ' use ->new() not ::new() to instantiate');
  160: 		}
  161: 		$class = __PACKAGE__;
  162: 	} elsif(ref($class)) {
  163: 		# Clone: overlay new params onto existing object state
  164: 		$params->{_supported} ||= $params->{supported} if defined $params->{'supported'};
  165: 		return bless { %{$class}, %{$params} }, ref($class);
  Mutants (Total: 2, Killed: 2, Survived: 0)
  166: 	}
  167: 
  168: 	# Validate blessed logger objects before Object::Configure runs.
  169: 	# Non-blessed values (arrayrefs, hashrefs) are valid config forms that
  170: 	# Object::Configure knows how to convert into a Log::Abstraction instance.
●171 → 171 → 181  171: 	if(defined $params->{'logger'} && blessed($params->{'logger'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  172: 		unless(
  Mutants (Total: 1, Killed: 1, Survived: 0)
  173: 			$params->{'logger'}->can('warn')
  174: 			&& $params->{'logger'}->can('info')
  175: 			&& $params->{'logger'}->can('error')
  176: 		) {
  177: 			croak('Logger must be a blessed object with warn/info/error methods');
  178: 		}
  179: 	}
  180: 
●181 → 185 → 201  181: 	$params = Object::Configure::configure($class, $params);
  182: 
  183: 	# Normalise supported / supported_languages alias
  184: 	$params->{'supported'} ||= $params->{'supported_languages'};
  185: 	if(defined($params->{supported})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  186: 		# Validate supported type/length
  187: 		if(ref($params->{supported})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  188: 			if(ref($params->{supported}) ne 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  189: 				croak('List of supported languages must be an array ref');
  190: 			}
  191: 		} elsif((length($params->{supported}) < 2) || (length($params->{supported}) > 5)) {
  Mutants (Total: 6, Killed: 6, Survived: 0)
  192: 			croak('Supported languages must be the short code');
  193: 		}
  194: 	} else {
  195: 		if(my $logger = $params->{'logger'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  196: 			$logger->error('You must give a list of supported languages');
  197: 		}
  198: 		croak('You must give a list of supported languages');
  199: 	}
  200: 
●201 → 205 → 239  201: 	my $cache = $params->{cache};
  202: 	my $info  = $params->{info};
  203: 
  204: 	# Try to restore a frozen state from the cache before doing any work
  205: 	if($cache && $ENV{'REMOTE_ADDR'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  206: 		my $key = _build_cache_key($ENV{'REMOTE_ADDR'}, $params, $class, $info);
  207: 		if(my $frozen = $cache->get($key)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  208: 			# JSON::PP is used in preference to Storable::thaw because Storable
  209: 			# can execute arbitrary Perl code via STORABLE_thaw hooks if an
  210: 			# attacker manages to write a crafted blob to the cache backend.
  211: 			# JSON cannot execute code regardless of its content.
  212: 			# If the blob is not valid JSON (e.g. a legacy Storable entry), the
  213: 			# eval catches the error and we fall through to fresh construction.
  214: 			my $rc = eval { local $SIG{__DIE__}; JSON::PP::decode_json($frozen) };
  215: 			unless(defined $rc && ref($rc) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  216: 				$rc = undef;    # stale or corrupt entry — rebuild below
  217: 			}
  218: 			if(defined $rc) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  219: 				bless $rc, $class;
  220: 				# Re-inject transient/non-serialisable fields
  221: 				$rc->{logger}           = $params->{'logger'};
  222: 			$rc->{_syslog}          = $params->{syslog};
  223: 			$rc->{_cache}           = $cache;
  224: 			$rc->{_supported}       = $params->{supported};
  225: 			$rc->{_info}            = $info;
  226: 			$rc->{_have_ipcountry}  = $GEO_UNKNOWN;
  227: 			$rc->{_have_geoip}      = $GEO_UNKNOWN;
  228: 			$rc->{_have_geoipfree}  = $GEO_UNKNOWN;
  229: 
  230: 			# If lang= CGI param is active, the cached language choice may be stale
  231: 				if(($rc->{_what_language} || $rc->{_rlanguage}) && $info && $info->lang()) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  232: 					delete @{$rc}{qw(_what_language _rlanguage _country)};
  233: 				}
  234: 				return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  235: 			}
  236: 		}
  237: 	}
  238: 
  239: 	return bless {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  240: 		%{$params},
  241: 		_supported => ref($params->{supported}) ? $params->{supported} : [ $params->{'supported'} ],
  242: 		_cache           => $cache,
  243: 		_info            => $info,
  244: 		_syslog          => $params->{syslog},
  245: 		_dont_use_ip     => $params->{dont_use_ip} || 0,
  246: 		_have_ipcountry  => $GEO_UNKNOWN,
  247: 		_have_geoip      => $GEO_UNKNOWN,
  248: 		_have_geoipfree  => $GEO_UNKNOWN,
  249: 		_debug           => $params->{debug} || 0,
  250: 	}, $class;
  251: }
  252: 
  253: # ── _build_cache_key ──────────────────────────────────────────────────────────
  254: # Purpose:      Produce a deterministic string key for the per-request cache
  255: #               entry stored in new() and DESTROY().
  256: # Entry:        $addr  — IP string (not yet taint-checked; used read-only here)
  257: #               $params — constructor params hashref
  258: #               $class  — package name
  259: #               $info   — optional CGI::Info object
  260: # Exit:         A plain string key of the form "ip/lang/lang1/lang2/..."
  261: sub _build_cache_key
  262: {
●263 → 270 → 281  263: 	my ($addr, $params, $class, $info) = @_;
  264: 
  265: 	my $key = "$addr/";
  266: 
  267: 	# Include the requested language (if determinable) so different
  268: 	# Accept-Language values get distinct cache slots for the same IP.
  269: 	my $l;
  270: 	if($info && ($l = $info->lang())) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  271: 		$key .= "$l/";
  272: 	} elsif($l = $class->_what_language()) {
  273: 		$key .= "$l/";
  274: 	}
  275: 
  276: 	# Fix: was ref($params->{'supported'} eq 'ARRAY') — eq was inside ref(),
  277: 	# so ref() always received a boolean (1 or ''), never the arrayref itself.
  278: 	# Result: arrayref-supported always fell through to the else branch and
  279: 	# stringified to 'ARRAY(0x...)' — a different address every request —
  280: 	# making cache lookups in new() permanently fail.
●281 → 281 → 287  281: 	if(ref($params->{'supported'}) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  282: 		$key .= join('/', @{$params->{supported}});
  283: 	} else {
  284: 		$key .= $params->{'supported'};
  285: 	}
  286: 
  287: 	return $key;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  288: }
  289: 
  290: # Some of the information takes a long time to work out, so cache what we can
  291: sub DESTROY {
●292 → 292 → 295  292: 	if(defined($^V) && ($^V ge 'v5.14.0')) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_292_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  293: 		return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
  294: 	}
  295: 	return unless $ENV{'REMOTE_ADDR'};
  296: 
  297: 	my $self = shift;
  298: 	return unless ref($self);
  299: 
  300: 	my $cache = $self->{_cache};
  301: 	return unless $cache;
  302: 
  303: 	my $key = _build_cache_key(
  304: 		$ENV{'REMOTE_ADDR'},
  305: 		{ supported => $self->{_supported} },
  306: 		ref($self),
  307: 		$self->{_info},
  308: 	);
  309: 	return if $cache->get($key);
  310: 
  311: 	$self->_debug("Storing self in cache as $key");
  312: 
  313: 	# Serialise only the computed state — not loggers, file handles, or
  314: 	# geo-module objects (they are re-initialised on next construction).
  315: 	# JSON::PP is used instead of Storable so that a compromised cache backend
  316: 	# cannot deliver a blob that executes code via STORABLE_thaw hooks.
  317: 	my %state = (
  318: 		_slanguage               => $self->{_slanguage},
  319: 		_slanguage_code_alpha2   => $self->{_slanguage_code_alpha2},
  320: 		_sublanguage_code_alpha2 => $self->{_sublanguage_code_alpha2},
  321: 		_country                 => $self->{_country},
  322: 		_rlanguage               => $self->{_rlanguage},
  323: 		_dont_use_ip             => $self->{_dont_use_ip},
  324: 		_have_ipcountry          => $self->{_have_ipcountry},
  325: 		_have_geoip              => $self->{_have_geoip},
  326: 		_have_geoipfree          => $self->{_have_geoipfree},
  327: 	);
  328: 
  329: 	$cache->set($key, JSON::PP::encode_json(\%state), $CACHE_TTL_LONG);
  330: }
  331: 
  332: =head2 language
  333: 
  334: Tells the CGI application in what language to display its messages.
  335: The language is the natural name e.g. 'English' or 'Japanese'.
  336: 
  337: Sublanguages are handled sensibly, so that if a client requests U.S. English
  338: on a site that only serves British English, language() will return 'English'.
  339: 
  340: If none of the requested languages is included within the supported lists,
  341: language() returns 'Unknown'.
  342: 
  343: =head3 EXAMPLE
  344: 
  345:     local $ENV{HTTP_ACCEPT_LANGUAGE} = 'fr,en;q=0.9';
  346:     my $l = CGI::Lingua->new(supported => ['en', 'fr']);
  347:     print $l->language();   # "French"
  348: 
  349: =head3 API SPECIFICATION
  350: 
  351:     Input:  none beyond $self
  352:     Returns: Str - human-readable language name, or 'Unknown'
  353: 
  354: =cut
  355: 
  356: sub language {
  357: 	my $self = $_[0];
  358: 
  359: 	$self->_find_language() unless $self->{_slanguage};
  360: 	return $self->{_slanguage};
  Mutants (Total: 2, Killed: 2, Survived: 0)
  361: }
  362: 
  363: =head2 preferred_language
  364: 
  365: Same as language().
  366: 
  367: =cut
  368: 
  369: sub preferred_language
  370: {
  371: 	my $self = shift;
  372: 	return $self->language(@_);
  Mutants (Total: 2, Killed: 2, Survived: 0)
  373: }
  374: 
  375: =head2 name
  376: 
  377: Synonym for language, for compatibility with Locale::Object::Language.
  378: 
  379: =cut
  380: 
  381: sub name {
  382: 	my $self = $_[0];
  383: 	return $self->language();
  Mutants (Total: 2, Killed: 2, Survived: 0)
  384: }
  385: 
  386: =head2 sublanguage
  387: 
  388: Tells the CGI what variant to use e.g. 'United Kingdom', or undef if
  389: it can't be determined.
  390: 
  391: =head3 EXAMPLE
  392: 
  393:     local $ENV{HTTP_ACCEPT_LANGUAGE} = 'en-gb';
  394:     my $l = CGI::Lingua->new(supported => ['en-gb']);
  395:     print $l->sublanguage();   # "United Kingdom"
  396: 
  397: =head3 API SPECIFICATION
  398: 
  399:     Input:  none beyond $self
  400:     Returns: Str | undef
  401: 
  402: =cut
  403: 
  404: sub sublanguage {
  405: 	my $self = $_[0];
  406: 
  407: 	$self->_trace('Entered sublanguage');
  408: 	$self->_find_language() unless $self->{_slanguage};
  409: 	$self->_trace('Leaving sublanguage ', ($self->{_sublanguage} || 'undef'));
  410: 	return $self->{_sublanguage};
  Mutants (Total: 2, Killed: 2, Survived: 0)
  411: }
  412: 
  413: =head2 language_code_alpha2
  414: 
  415: Gives the two-character representation of the supported language, e.g. 'en'
  416: when you've asked for en-gb.
  417: 
  418: If none of the requested languages is included within the supported lists,
  419: language_code_alpha2() returns undef.
  420: 
  421: =head3 EXAMPLE
  422: 
  423:     local $ENV{HTTP_ACCEPT_LANGUAGE} = 'en-gb';
  424:     my $l = CGI::Lingua->new(supported => ['en-gb']);
  425:     print $l->language_code_alpha2();   # "en"
  426: 
  427: =head3 API SPECIFICATION
  428: 
  429:     Input:  none beyond $self
  430:     Returns: Str (2 chars) | undef
  431: 
  432: =cut
  433: 
  434: sub language_code_alpha2 {
  435: 	my $self = $_[0];
  436: 
  437: 	$self->_trace('Entered language_code_alpha2');
  438: 	$self->_find_language() unless $self->{_slanguage};
  439: 	$self->_trace('language_code_alpha2 returns ', $self->{_slanguage_code_alpha2});
  440: 	return $self->{_slanguage_code_alpha2};
  Mutants (Total: 2, Killed: 2, Survived: 0)
  441: }
  442: 
  443: =head2 code_alpha2
  444: 
  445: Synonym for language_code_alpha2, kept for historical reasons.
  446: 
  447: =cut
  448: 
  449: sub code_alpha2 {
  450: 	my $self = $_[0];
  451: 	return $self->language_code_alpha2();
  Mutants (Total: 2, Killed: 2, Survived: 0)
  452: }
  453: 
  454: =head2 sublanguage_code_alpha2
  455: 
  456: Gives the two-character representation of the supported language, e.g. 'gb'
  457: when you've asked for en-gb, or undef.
  458: 
  459: =head3 EXAMPLE
  460: 
  461:     local $ENV{HTTP_ACCEPT_LANGUAGE} = 'en-gb';
  462:     my $l = CGI::Lingua->new(supported => ['en-gb']);
  463:     print $l->sublanguage_code_alpha2();   # "gb"
  464: 
  465: =head3 API SPECIFICATION
  466: 
  467:     Input:  none beyond $self
  468:     Returns: Str (2 chars) | undef
  469: 
  470: =cut
  471: 
  472: sub sublanguage_code_alpha2 {
  473: 	my $self = $_[0];
  474: 
  475: 	$self->_find_language() unless $self->{_slanguage};
  476: 	return $self->{_sublanguage_code_alpha2};
  Mutants (Total: 2, Killed: 2, Survived: 0)
  477: }
  478: 
  479: =head2 requested_language
  480: 
  481: Gives a human-readable rendition of what language the user asked for whether
  482: or not it is supported.
  483: 
  484: Returns the sublanguage (if appropriate) in parentheses,
  485: e.g. "English (United Kingdom)"
  486: 
  487: =head3 EXAMPLE
  488: 
  489:     local $ENV{HTTP_ACCEPT_LANGUAGE} = 'en-gb';
  490:     my $l = CGI::Lingua->new(supported => ['en']);
  491:     print $l->requested_language();   # "English (United Kingdom)"
  492: 
  493: =head3 API SPECIFICATION
  494: 
  495:     Input:  none beyond $self
  496:     Returns: Str - e.g. "English (United Kingdom)" or "Unknown"
  497: 
  498: =cut
  499: 
  500: sub requested_language {
  501: 	my $self = $_[0];
  502: 
  503: 	$self->_find_language() unless $self->{_rlanguage};
  504: 	return $self->{_rlanguage};
  Mutants (Total: 2, Killed: 2, Survived: 0)
  505: }
  506: 
  507: # ── _find_language ─────────────────────────────────────────────────────────
  508: # Purpose:      Populate _slanguage, _rlanguage, _sublanguage, and the
  509: #               various code fields by working through the detection pipeline:
  510: #               Accept-Language header → I18N::AcceptLanguage → IP country.
  511: # Entry:        $self->{_slanguage} must be undef (guards repeated calls).
  512: # Exit:         $self->{_slanguage} is set to a language name or 'Unknown'.
  513: # Side Effects: Populates _rlanguage, _sublanguage, *_code_alpha2 fields.
  514: sub _find_language
  515: {
●516 → 524 → 577  516: 	my $self = shift;
  517: 
  518: 	$self->_trace('Entered _find_language');
  519: 
  520: 	$self->{_rlanguage} = 'Unknown';
  521: 	$self->{_slanguage} = 'Unknown';
  522: 
  523: 	my $http_accept_language = $self->_what_language();
  524: 	if(defined($http_accept_language)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  525: 		$self->_debug(
  526: 			"language wanted: $http_accept_language, "
  527: 			. 'languages supported: '
  528: 			. join(', ', @{$self->{_supported}} // '')
  529: 		);
  530: 
  531: 		# Normalise the deprecated en-uk tag that some browsers send
  532: 		if($http_accept_language eq $DEPRECATED_EN_UK) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  533: 			$self->_debug("Resetting country code to GB for $http_accept_language");
  534: 			$http_accept_language = $CANONICAL_EN_GB;
  535: 		}
  536: 
  537: 		# Run the header through the Accept-Language resolver
  538: 		my ($l, $requested_sublanguage) =
  539: 			$self->_accept_language_match($http_accept_language);
  540: 
  541: 		# Resolve the matched code to a full language/sublanguage
  542: 		if($l) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  543: 			return if $self->_resolve_match($l, $requested_sublanguage, $http_accept_language);
  544: 		} elsif($http_accept_language =~ /;/) {
  545: 			# e.g. de-DE,de;q=0.9,en-US;q=0.8 and we support none of those
  546: 			$self->_notice(
  547: 				__PACKAGE__, ': ', __LINE__,
  548: 				": couldn't honour HTTP_ACCEPT_LANGUAGE=$http_accept_language,"
  549: 				. ' supported languages are: '
  550: 				. join(',', @{$self->{_supported}})
  551: 			);
  552: 		}
  553: 
  554: 		# Detected slanguage but rlanguage still Unknown — try I18N::LangTags
  555: 		if($self->{_slanguage} && ($self->{_slanguage} ne 'Unknown')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  556: 			if($self->{_rlanguage} eq 'Unknown') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_556_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  557: 				$self->{_rlanguage} = I18N::LangTags::Detect::detect();
  558: 			}
  559: 			if($self->{_rlanguage}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_559_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  560: 				if(my $resolved = $self->_code2language($self->{_rlanguage})) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_560_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  561: 					$self->{_rlanguage} = $resolved;
  562: 				}
  563: 				return;
  564: 			}
  565: 		}
  566: 
  567: 		# Last-chance: 2-char or xx-xx header where we have no match
  568: 		if(

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_568_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  569: 			((!$self->{_rlanguage}) || ($self->{_rlanguage} eq 'Unknown'))
  570: 			&& ((length($http_accept_language) == 2) || ($http_accept_language =~ /^..-..$/))

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
NUM_BOUNDARY_570_39_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
  571: 		) {
  572: 			$self->{_rlanguage} = $self->_code2language($http_accept_language) || 'Unknown';
  573: 		}
  574: 		$self->{_slanguage} = 'Unknown';
  575: 	}
  576: 
  577: 	return if $self->{_dont_use_ip};
  578: 
  579: 	# Fall back to the official language of the visitor's country
  580: 	$self->_find_language_from_ip($http_accept_language);
  581: }
  582: 
  583: # ── _accept_language_match ────────────────────────────────────────────────
  584: # Purpose:      Run I18N::AcceptLanguage strict matching plus two fallback
  585: #               left-to-right scan passes against $self->{_supported}.
  586: # Entry:        $http_accept_language — validated, untainted Accept-Language value.
  587: # Exit:         Returns ($matched_code, $requested_sublanguage) or (undef, undef).
  588: # Side Effects: Logs debug messages.
  589: sub _accept_language_match
  590: {
●591 → 603 → 608  591: 	my ($self, $http_accept_language) = @_;
  592: 
  593: 	# Suppress I18N::AcceptLanguage's uninitialized-value warnings (RT 74338)
  594: 	local $SIG{__WARN__} = sub {
  595: 		warn $_[0] unless $_[0] =~ /^Use of uninitialized value/;
  596: 	};
  597: 	my $i18n = I18N::AcceptLanguage->new(debug => $self->{_debug}, strict => 1);
  598: 	my $l = $i18n->accepts($http_accept_language, $self->{_supported});
  599: 	local $SIG{__WARN__} = 'DEFAULT';
  600: 
  601: 	# I18N-AcceptLanguage strict mode can return a sublanguage variant when
  602: 	# the request contains a sublanguage we don't support; force a retry.
  603: 	if($l && ($http_accept_language =~ /-/) && ($http_accept_language !~ qr/$l/i)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  604: 		$self->_debug('Forcing fallback');
  605: 		undef $l;
  606: 	}
  607: 
●608 → 609 → 622  608: 	my $requested_sublanguage;
  609: 	if(!$l) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  610: 		# Sort tokens by q-value once; both scan passes share the ordered list
  611: 		my $sorted = $self->_sorted_tokens($http_accept_language);
  612: 		# First fallback: scan for xx-yy pairs, try base language xx
  613: 		($l, $requested_sublanguage) =
  614: 			$self->_scan_sublanguage_pairs($i18n, $sorted);
  615: 		if(!$l) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  616: 			# Second fallback: scan plain tokens without sublanguages
  617: 			$l = $self->_scan_plain_tokens($i18n, $sorted);
  618: 			undef $requested_sublanguage if $l;
  619: 		}
  620: 	}
  621: 
  622: 	return ($l, $requested_sublanguage);
  623: }
  624: 
  625: # ── _sorted_tokens ────────────────────────────────────────────────────────
  626: # Purpose:      Parse an Accept-Language header into tokens sorted by
  627: #               descending quality value so fallback scans honour q= priority.
  628: # Entry:        $header — validated Accept-Language string.
  629: # Exit:         Arrayref of [$language_tag, $quality] pairs, highest q first.
  630: sub _sorted_tokens
  631: {
●632 → 634 → 643  632: 	my ($self, $header) = @_;
  633: 	my @tokens;
  634: 	for my $token (split /,/, $header) {
  635: 		$token =~ s/^\s+|\s+$//g;
  636: 		my $q = 1.0;
  637: 		if($token =~ s/;\s*q\s*=\s*(\d+(?:\.\d+)?)//) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  638: 			$q = $1 + 0;
  639: 		}
  640: 		$token =~ s/^\s+|\s+$//g;
  641: 		push @tokens, [$token, $q] if length $token;
  642: 	}
  643: 	return [sort { $b->[1] <=> $a->[1] } @tokens];
  644: }
  645: 
  646: # ── _scan_sublanguage_pairs ───────────────────────────────────────────────
  647: # Purpose:      Walk q-sorted tokens looking for xx-yy pairs; try accepting
  648: #               the base language xx from the supported list.
  649: # Entry:        $i18n — I18N::AcceptLanguage instance;
  650: #               $sorted — arrayref from _sorted_tokens.
  651: # Exit:         ($matched_code, $sublanguage_code) or (undef, undef).
  652: # Side Effects: Debug logging.
  653: sub _scan_sublanguage_pairs
  654: {
●655 → 658 → 668  655: 	my ($self, $i18n, $sorted) = @_;
  656: 
  657: 	$self->_debug(__PACKAGE__, ': ', __LINE__, ': scan q-sorted tokens for xx-yy pairs');
  658: 	for my $entry (@{$sorted}) {
  659: 		my ($tag) = @{$entry};
  660: 		next unless $tag =~ /^(..)-(..)$/;
  661: 		my ($base, $sub) = ($1, $2);
  662: 		$self->_debug(__PACKAGE__, ': ', __LINE__, ": see if $base is supported");
  663: 		if($i18n->accepts($base, $self->{_supported})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  664: 			$self->_debug("Fallback to $base as sublanguage $sub is not supported");
  665: 			return ($base, $sub);
  666: 		}
  667: 	}
  668: 	return (undef, undef);
  669: }
  670: 
  671: # ── _scan_plain_tokens ────────────────────────────────────────────────────
  672: # Purpose:      Walk q-sorted tokens that have no sublanguage suffix and try
  673: #               accepting each against the supported list.
  674: # Entry:        $i18n — I18N::AcceptLanguage instance;
  675: #               $sorted — arrayref from _sorted_tokens.
  676: # Exit:         Matched code string, or undef.
  677: # Side Effects: Debug logging.
  678: sub _scan_plain_tokens
  679: {
●680 → 683 → 692  680: 	my ($self, $i18n, $sorted) = @_;
  681: 
  682: 	$self->_debug(__PACKAGE__, ': ', __LINE__, ': scan q-sorted tokens for plain alternatives');
  683: 	for my $entry (@{$sorted}) {
  684: 		my ($tag) = @{$entry};
  685: 		next if $tag =~ /^..-../;    # already tried in the pair scan
  686: 		$self->_debug(__PACKAGE__, ': ', __LINE__, ": see if $tag is supported");
  687: 		if($i18n->accepts($tag, $self->{_supported})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  688: 			$self->_debug("Fallback to $tag as best alternative");
  689: 			return $tag;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  690: 		}
  691: 	}
  692: 	return;
  693: }
  694: 
  695: # ── _resolve_match ────────────────────────────────────────────────────────
  696: # Purpose:      Given a matched code $l (possibly xx or xx-yy), populate all
  697: #               of _slanguage, _rlanguage, _sublanguage and their code fields.
  698: # Entry:        $l — 2-char or xx-yy language code; $requested_sublanguage —
  699: #               2-char variety code or undef; $http_accept_language — full header.
  700: # Exit:         Returns true (1) if the caller should return immediately.
  701: # Side Effects: Mutates $self->{_slanguage}, _rlanguage, _sublanguage, etc.
  702: sub _resolve_match
  703: {
●704 → 708 → 715  704: 	my ($self, $l, $requested_sublanguage, $http_accept_language) = @_;
  705: 
  706: 	$self->_debug("l: $l");
  707: 
  708: 	if($l !~ /^..-../) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  709: 		# Base-language match (e.g. 'en') — no sublanguage component
  710: 		return $self->_resolve_base_match($l, $requested_sublanguage, $http_accept_language);
  Mutants (Total: 2, Killed: 2, Survived: 0)
  711: 	} elsif($l =~ /(.+)-(..)$/) {
  712: 		# Sublanguage match (e.g. 'en-gb') — resolve both language and variant
  713: 		return $self->_resolve_sublanguage_match($l, $1, $2, $http_accept_language);

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_713_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_713_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  714: 	}
  715: 	return 0;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_715_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_715_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  716: }
  717: 
  718: # ── _resolve_base_match ───────────────────────────────────────────────────
  719: # Purpose:      Handle the case where a base-language code matched (no hyphen).
  720: #               Sets _slanguage, _rlanguage; appends sublanguage name to rlanguage
  721: #               when the client requested one we don't support.
  722: # Entry:        $l — 2-char code; $requested_sublanguage — optional; $header.
  723: # Exit:         1 to signal caller should return, 0 otherwise.
  724: # Side Effects: Mutates slanguage, rlanguage, slanguage_code_alpha2.
  725: sub _resolve_base_match
  726: {
●727 → 738 → 747  727: 	my ($self, $l, $requested_sublanguage, $header) = @_;
  728: 
  729: 	$self->{_slanguage} = $self->_code2language($l);
  730: 	return 0 unless $self->{_slanguage};
  Mutants (Total: 2, Killed: 2, Survived: 0)
  731: 
  732: 	$self->_debug("_slanguage: $self->{_slanguage}");
  733: 	$self->{_slanguage_code_alpha2} = $l;
  734: 	$self->{_rlanguage}             = $self->{_slanguage};
  735: 
  736: 	# Attempt to name the sublanguage the client actually asked for
  737: 	my $sl;
  738: 	if($header =~ /..-(..)$/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  739: 		$self->_debug($1);
  740: 		$sl = $self->_code2country($1);
  741: 		$requested_sublanguage //= $1;
  742: 	} elsif($header =~ /..-([a-z]{2,3})$/i) {
  743: 		eval { $sl = Locale::Object::Country->new(code_alpha3 => $1) };
  744: 		$self->_info($@) if $@;
  745: 	}
  746: 
●747 → 747 → 756  747: 	if($sl) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  748: 		$self->{_rlanguage} .= ' (' . $sl->name() . ')';
  749: 	} elsif($requested_sublanguage) {
  750: 		if(my $c = $self->_code2countryname($requested_sublanguage)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  751: 			$self->{_rlanguage} .= " ($c)";
  752: 		} else {
  753: 			$self->{_rlanguage} .= " (Unknown: $requested_sublanguage)";
  754: 		}
  755: 	}
  756: 	return 1;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  757: }
  758: 
  759: # ── _resolve_sublanguage_match ────────────────────────────────────────────
  760: # Purpose:      Handle the case where the full xx-yy code matched in the
  761: #               supported list.  Resolves the variety name and caches results.
  762: # Entry:        $l — full code e.g. 'en-gb'; $alpha2 — 'en'; $variety — 'gb';
  763: #               $header — full Accept-Language value.
  764: # Exit:         1 to signal caller should return, 0 otherwise.
  765: # Side Effects: Mutates _slanguage, _rlanguage, _sublanguage and code fields;
  766: #               writes to cache.
  767: sub _resolve_sublanguage_match
  768: {
●769 → 775 → 830  769: 	my ($self, $l, $alpha2, $variety, $header) = @_;
  770: 
  771: 	my $i18n    = I18N::AcceptLanguage->new(strict => 1);
  772: 	my $accepts = $i18n->accepts($l, $self->{_supported});
  773: 	$self->_debug("accepts = $accepts");
  774: 
  775: 	if($accepts) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_775_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  776: 		$self->_debug("accepts: $accepts");
  777: 
  778: 		if($accepts =~ /\-/) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_778_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  779: 			delete $self->{_slanguage};
  780: 		} else {
  781: 			# Cache look-up for the base-language name
  782: 			my $from_cache;
  783: 			if($self->{_cache}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_783_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  784: 				$from_cache = $self->{_cache}->get($CACHE_NS . "accepts:$accepts");
  785: 			}
  786: 			my $slanguage;
  787: 			if($from_cache) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_787_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  788: 				$self->_debug("$accepts is in cache as $from_cache");
  789: 				$slanguage = (split(/=/, $from_cache))[0];
  790: 			} else {
  791: 				$slanguage = $self->_code2language($accepts);
  792: 			}
  793: 
  794: 			if($slanguage) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_794_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  795: 				$self->{_slanguage} = $slanguage;
  796: 
  797: 				# Normalise deprecated en-uk variety
  798: 				if($variety eq 'uk') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_798_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  799: 					$self->_warn({ warning => "Resetting country code to GB for $header" });
  800: 					$variety = 'gb';
  801: 				}
  802: 
  803: 				if(defined(my $c = $self->_code2countryname($variety))) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_803_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  804: 					$self->_debug(__PACKAGE__, ': ', __LINE__, ":  setting sublanguage to $c");
  805: 					$self->{_sublanguage} = $c;
  806: 				}
  807: 				$self->{_slanguage_code_alpha2}   = $accepts;
  808: 				$self->{_sublanguage_code_alpha2}  = $variety;
  809: 
  810: 				if($self->{_sublanguage}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_810_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  811: 					$self->{_rlanguage} = "$self->{_slanguage} ($self->{_sublanguage})";
  812: 					$self->_debug(__PACKAGE__, ': ', __LINE__, ": _rlanguage: $self->{_rlanguage}");
  813: 				}
  814: 
  815: 				unless($from_cache) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_815_5: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

  816: 					$self->_debug("Set $variety to $slanguage=$accepts");
  817: 					$self->{_cache}->set(
  818: 						$CACHE_NS . "accepts:$variety",
  819: 						"$slanguage=$accepts",
  820: 						$CACHE_TTL_LONG
  821: 					) if $self->{_cache};
  822: 				}
  823: 				return 1;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_823_5: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_823_5: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  824: 			}
  825: 		}
  826: 	}
  827: 
  828: 	# Accepts returned something but we couldn't resolve a language name —
  829: 	# try harder using the variety code directly
●830 → 840 → 897  830: 	$self->{_rlanguage} = $self->_code2language($alpha2);
  831: 	$self->_debug("_rlanguage: $self->{_rlanguage}");
  832: 
  833: 	return 0 unless $accepts;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_833_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_833_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  834: 
  835: 	$self->_debug("http_accept_language = $header");
  836: 	$l =~ /(..)-(..)/;
  837: 	$variety = lc($2);
  838: 
  839: 	# Skip numeric/region codes like en-029
  840: 	if(($variety =~ /[a-z]{2,3}/) && !defined($self->{_sublanguage})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  841: 		$self->_get_closest($alpha2, $alpha2);
  842: 		$self->_debug("Find the country code for $variety");
  843: 
  844: 		if($variety eq 'uk') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  845: 			$self->_warn({ warning => "Resetting country code to GB for $header" });
  846: 			$variety = 'gb';
  847: 		}
  848: 
  849: 		my ($from_cache, $language_name);
  850: 		if($self->{_cache}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  851: 			$from_cache = $self->{_cache}->get($CACHE_NS . "variety:$variety");
  852: 		}
  853: 
  854: 		if(defined($from_cache)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  855: 			$self->_debug("$variety is in cache as $from_cache");
  856: 			# Cache stores "countryname=langcode" (e.g. "United Kingdom=en").
  857: 			# Splitting on = gives the country name as the first field.
  858: 			($language_name) = split(/=/, $from_cache);
  859: 		} else {
  860: 			my $db = Locale::Object::DB->new();
  861: 			my @results = @{$db->lookup(
  862: 				table         => 'country',
  863: 				result_column => 'name',
  864: 				search_column => 'code_alpha2',
  865: 				value         => $variety
  866: 			)};
  867: 			if(defined($results[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  868: 				eval { $language_name = $self->_code2countryname($variety) };
  869: 			} else {
  870: 				$self->_debug("Can't find the country code for $variety in Locale::Object::DB");
  871: 			}
  872: 		}
  873: 
  874: 		if($@ || !defined($language_name)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  875: 			$self->_warn({ warning => $@ }) if $@;
  876: 			$self->_debug(__PACKAGE__, ': ', __LINE__, ': setting sublanguage to Unknown');
  877: 			$self->{_sublanguage} = 'Unknown';
  878: 			$self->_warn({ warning => "Can't determine values for $header" });
  879: 		} else {
  880: 			$self->{_sublanguage} = $language_name;
  881: 			$self->_debug('variety name ', $self->{_sublanguage});
  882: 			if($self->{_cache} && !defined($from_cache)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  883: 				# Store "countryname=langcode" so future cache hits return the country
  884: 				# name in the first field.  Previously this stored the language name
  885: 				# ("English=en" for en-gb) which was wrong — the cache-hit branch
  886: 				# split on = and used the first field as the sublanguage (country) name.
  887: 				$self->_debug("Set variety:$variety to $language_name=$self->{_slanguage_code_alpha2}");
  888: 				$self->{_cache}->set(
  889: 					$CACHE_NS . "variety:$variety",
  890: 					"$language_name=$self->{_slanguage_code_alpha2}",
  891: 					$CACHE_TTL_LONG
  892: 				);
  893: 			}
  894: 		}
  895: 	}
  896: 
●897 → 897 → 902  897: 	if(defined($self->{_sublanguage})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  898: 		$self->{_rlanguage} = "$self->{_slanguage} ($self->{_sublanguage})";
  899: 		$self->{_sublanguage_code_alpha2} = $variety;
  900: 		return 1;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_900_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_900_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  901: 	}
  902: 	return 0;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_902_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_902_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  903: }
  904: 
  905: # ── _find_language_from_ip ────────────────────────────────────────────────
  906: # Purpose:      Fall back to the visitor's IP country when the Accept-Language
  907: #               header produced no usable match.  Looks up the official language
  908: #               of the country and checks it against the supported list.
  909: # Entry:        $http_accept_language — may be undef if no header was present.
  910: # Exit:         Mutates _slanguage, _rlanguage via _get_closest if a match found.
  911: # Side Effects: Calls country(); may write to cache.
  912: sub _find_language_from_ip
  913: {
●914 → 919 → 926  914: 	my ($self, $http_accept_language) = @_;
  915: 
  916: 	my $country = $self->country();
  917: 
  918: 	# If country() returned nothing, try to derive from the LANG env var
  919: 	if(!defined($country) && (my $c = $self->_what_language())) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_919_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  920: 		if($c =~ /^(..)_(..)/) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_920_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  921: 			$country = $2;
  922: 		} elsif($c =~ /^(..)$/) {
  923: 			$country = $1;
  924: 		}
  925: 	}
●926 → 931 → 935  926: 	return unless defined $country;
  927: 
  928: 	$self->_debug("country: $country");
  929: 
  930: 	my ($language_name, $language_code2, $from_cache);
  931: 	if($self->{_cache}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  932: 		$from_cache = $self->{_cache}->get($CACHE_NS . 'language_name:' . $country);
  933: 	}
  934: 
●935 → 935 → 950  935: 	if($from_cache) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_935_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  936: 		$self->_debug("$country is in cache as $from_cache");
  937: 		($language_name, $language_code2) = split(/=/, $from_cache);
  938: 	} else {
  939: 		my $l = $self->_code2country(uc($country));
  940: 		if($l) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  941: 			$l = ($l->languages_official)[0];
  942: 			if(defined $l) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_942_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  943: 				$language_name  = $l->name;
  944: 				$language_code2 = $l->code_alpha2;
  945: 				$self->_debug("Official language: $language_name") if $language_name;
  946: 			}
  947: 		}
  948: 	}
  949: 
●950 → 953 → 957  950: 	my $ip = $ENV{'REMOTE_ADDR'};
  951: 	return unless $language_name;
  952: 
  953: 	if((!defined($self->{_rlanguage})) || ($self->{_rlanguage} eq 'Unknown')) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_953_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  954: 		$self->{_rlanguage} = $language_name;
  955: 	}
  956: 
●957 → 957 → 1002  957: 	unless((exists $self->{_slanguage}) && ($self->{_slanguage} ne 'Unknown')) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_957_2: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

  958: 		my $code;
  959: 
  960: 		if($language_name && $language_code2 && !defined($http_accept_language)) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_960_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  961: 			# Fast-path for search engines that hit with no Accept-Language
  962: 			$self->_debug("Fast assign to $language_code2");
  963: 			$code = $language_code2;
  964: 		} else {
  965: 			$self->_debug("Call language2code on $self->{_rlanguage}");
  966: 			$code = Locale::Language::language2code($self->{_rlanguage});
  967: 
  968: 			unless($code) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_968_4: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

  969: 				if($http_accept_language && ($http_accept_language ne $self->{_rlanguage})) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_969_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  970: 					$self->_debug("Call language2code on $http_accept_language");
  971: 					$code = Locale::Language::language2code($http_accept_language);
  972: 				}
  973: 				unless($code) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_973_5: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

  974: 					# Norwegian (Nynorsk) — strip the parenthetical qualifier
  975: 					if($self->{_rlanguage} =~ /(.+)\s\(.+/) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_975_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  976: 						if((!defined($http_accept_language)) || ($1 ne $self->{_rlanguage})) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_976_7: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  977: 							$self->_debug("Call language2code on $1");
  978: 							$code = Locale::Language::language2code($1);
  979: 						}
  980: 					}
  981: 					unless($code) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_981_6: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

  982: 						$self->_warn({
  983: 							warning => "Can't determine code from IP $ip for requested language $self->{_rlanguage}"
  984: 						});
  985: 					}
  986: 				}
  987: 			}
  988: 		}
  989: 
  990: 		if($code) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_990_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  991: 			$self->_get_closest($code, $language_code2);
  992: 			unless($self->{_slanguage}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_992_4: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

  993: 				$self->_warn({
  994: 					warning => "Couldn't determine closest language for $language_name in $self->{_supported}"
  995: 				});
  996: 			} else {
  997: 				$self->_debug("language set to $self->{_slanguage}, code set to $code");
  998: 			}
  999: 		}
 1000: 	}
 1001: 
●1002 → 1002 → 0 1002: 	if(!defined($self->{_slanguage_code_alpha2})) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1002_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1003: 		$self->_debug("Can't determine slanguage_code_alpha2");
 1004: 	} elsif(!defined($from_cache) && $self->{_cache} && defined($self->{_slanguage_code_alpha2})) {
 1005: 		$self->_debug("Set $country to $language_name=$self->{_slanguage_code_alpha2}");
 1006: 		$self->{_cache}->set(
 1007: 			$CACHE_NS . 'language_name:' . $country,
 1008: 			"$language_name=$self->{_slanguage_code_alpha2}",
 1009: 			$CACHE_TTL_LONG
 1010: 		);
 1011: 	}
 1012: }
 1013: 
 1014: # ── _get_closest ─────────────────────────────────────────────────────────
 1015: # Purpose:      If $language_string matches the base language of any supported
 1016: #               entry, set _slanguage and _slanguage_code_alpha2.
 1017: # Entry:        $language_string — base code e.g. 'en'; $alpha2 — same or variant.
 1018: # Exit:         Mutates _slanguage and _slanguage_code_alpha2 on match.
 1019: sub _get_closest
 1020: {
●1021 → 1027 → 0 1021: 	my ($self, $language_string, $alpha2) = @_;
 1022: 
 1023: 	# Map each supported entry to its base language code
 1024: 	my %base_languages =
 1025: 		map { /^(.+)-/ ? ($1 => $_) : ($_ => $_) } @{$self->{_supported}};
 1026: 
 1027: 	if(exists $base_languages{$language_string}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1028: 		$self->{_slanguage}             = $self->{_rlanguage};
 1029: 		$self->{_slanguage_code_alpha2} = $alpha2;
 1030: 	}
 1031: }
 1032: 
 1033: # ── _what_language ────────────────────────────────────────────────────────
 1034: # Purpose:      Return the raw (validated, untainted) Accept-Language string,
 1035: #               consulting in priority order: cached value, CGI lang= param,
 1036: #               HTTP_ACCEPT_LANGUAGE env var, LANG env var (local/debug mode).
 1037: # Entry:        May be called as a class method (no $self->{...} access) or
 1038: #               as an object method.
 1039: # Exit:         A validated language string, or undef if nothing available.
 1040: # Side Effects: Caches result in $self->{_what_language} on object calls.
 1041: sub _what_language {
●1042 → 1044 → 1058 1042: 	my $self = $_[0];
 1043: 
 1044: 	if(ref($self)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1045: 		$self->_trace('Entered _what_language');
 1046: 		if(defined($self->{_what_language})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1047: 			$self->_trace('_what_language: returning cached value: ', $self->{_what_language});
 1048: 			return $self->{_what_language};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1049: 		}
 1050: 		if(my $info = $self->{_info}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1051: 			if(my $rc = $info->lang()) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1052: 				$self->_trace("_what_language set language to $rc from the lang argument");
 1053: 				return $self->{_what_language} = $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1054: 			}
 1055: 		}
 1056: 	}
 1057: 
●1058 → 1058 → 1071 1058: 	if(my $raw_lang = $ENV{'HTTP_ACCEPT_LANGUAGE'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1059: 		# Validate and untaint — RFC 7231 §5.3.5 character set plus * wildcard
 1060: 		if($raw_lang =~ /^([A-Za-z0-9\-,;=.*\s]{1,$ACCEPT_LANG_MAX})$/a) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1061: 			my $rc = $1;    # untainted
 1062: 			if(ref($self)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1063: 				return $self->{_what_language} = $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1064: 			}
 1065: 			return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1066: 		} elsif(ref($self)) {
 1067: 			$self->_warn({ warning => 'HTTP_ACCEPT_LANGUAGE contains invalid characters; ignoring' });
 1068: 		}
 1069: 	}
 1070: 
●1071 → 1071 → 1087 1071: 	if(defined($ENV{'LANG'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1072: 		# Running locally (debug mode) — derive from system locale.
 1073: 		# Apply the same untainting discipline as HTTP_ACCEPT_LANGUAGE: only
 1074: 		# alphanumeric, hyphen, underscore, and dot are legitimate in a POSIX
 1075: 		# locale name (e.g. "en_US.UTF-8", "de_DE", "ja").  Anything else is
 1076: 		# either malformed or an injection attempt; discard it silently.
 1077: 		if($ENV{'LANG'} =~ /^([A-Za-z0-9_.\-]{1,$ACCEPT_LANG_MAX})$/a) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1078: 			my $rc = $1;    # untainted
 1079: 			if(ref($self)) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1079_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1080: 				return $self->{_what_language} = $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1081: 			}
 1082: 			return $rc;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1082_4: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1082_4: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1083: 		} elsif(ref($self)) {
 1084: 			$self->_warn({ warning => 'LANG contains invalid characters; ignoring' });
 1085: 		}
 1086: 	}
 1087: 	return;
 1088: }
 1089: 
 1090: =head2 country
 1091: 
 1092: Returns the two-character country code of the remote end in lowercase.
 1093: 
 1094: If L<IP::Country>, L<Geo::IPfree> or L<Geo::IP> is installed,
 1095: CGI::Lingua will make use of that, otherwise, it will do a Whois lookup.
 1096: If you do not have any of those installed I recommend you use the
 1097: caching capability of CGI::Lingua.
 1098: 
 1099: =head3 API SPECIFICATION
 1100: 
 1101:     Input:  none beyond $self
 1102:     Returns: Str (2 lowercase chars) | undef
 1103:       'Unknown' is only returned in the Baidu-EU special case via _handle_eu_country.
 1104: 
 1105: =head3 EXAMPLE
 1106: 
 1107:     # With mod_geoip (fastest - no IP lookup at all):
 1108:     local $ENV{GEOIP_COUNTRY_CODE} = 'DE';
 1109:     print $l->country();   # "de"
 1110: 
 1111:     # With REMOTE_ADDR and IP::Country installed:
 1112:     local $ENV{REMOTE_ADDR} = '8.8.8.8';
 1113:     print $l->country();   # "us" (depends on geo database)
 1114: 
 1115: =head3 MESSAGES
 1116: 
 1117:     "GEOIP_COUNTRY_CODE contains an invalid country code; ignoring"
 1118:     "HTTP_CF_IPCOUNTRY contains an invalid country code; ignoring"
 1119:     "X.X.X.X isn't a valid IP address"
 1120:     "Can't determine country from LAN connection X"
 1121:     "Can't determine country from loopback connection X"
 1122:     "cache contains a numeric country: N"
 1123:     "IP matches to a numeric country"
 1124: 
 1125: =head3 PSEUDOCODE
 1126: 
 1127:     1. Return cached _country if set
 1128:     2. Check GEOIP_COUNTRY_CODE env var (mod_geoip); validate /^[A-Z]{2}$/
 1129:     3. Check HTTP_CF_IPCOUNTRY (Cloudflare); skip 'XX'; validate /^[A-Z]{2}$/
 1130:     4. Untaint and validate REMOTE_ADDR; return undef if absent or invalid
 1131:     5. Skip private and loopback IPs (return undef)
 1132:     6. Check CHI cache; return cached value if present
 1133:     7. Try IP::Country::Fast (local DB, fastest)
 1134:     8. Try Geo::IP (local DB)
 1135:     9. Try Geo::IPfree (local DB, skip $BROKEN_GEOIPFREE)
 1136:     10. Try geoplugin.net JSON API (LWP::Simple::WithCache or LWP::Simple)
 1137:     11. Last resort: Net::Whois::IP then Net::Whois::IANA
 1138:     12. Sanitise: discard numeric, normalise HK->CN, handle EU special case
 1139:     13. Store in CHI cache; return result
 1140: 
 1141: =cut
 1142: 
 1143: sub country {
●1144 → 1153 → 1159 1144: 	my $self = shift;
 1145: 
 1146: 	$self->_trace(__PACKAGE__, ': Entered country()');
 1147: 
 1148: 	# Return cached result immediately if a previous call already resolved it.
 1149: 	# Note: undef results (private/loopback IPs) are NOT cached here because
 1150: 	# country() reads REMOTE_ADDR at call time, not construction time; caching
 1151: 	# undef would give wrong answers if REMOTE_ADDR changes between calls on
 1152: 	# the same object (the documented lazy-read design).  See LIMITATIONS.
 1153: 	if($self->{_country}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1154: 		$self->_trace('quick return: ', $self->{_country});
 1155: 		return $self->{_country};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1156: 	}
 1157: 
 1158: 	# mod_geoip: validate against ISO 3166-1 alpha-2 before trusting
●1159 → 1159 → 1169 1159: 	if(defined($ENV{'GEOIP_COUNTRY_CODE'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1160: 		if($ENV{'GEOIP_COUNTRY_CODE'} =~ /^([A-Z]{2})$/a) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1161: 			$self->{_country} = lc($1);
 1162: 			return $self->{_country};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1163: 		} else {
 1164: 			$self->_warn({ warning => 'GEOIP_COUNTRY_CODE contains an invalid country code; ignoring' });
 1165: 		}
 1166: 	}
 1167: 
 1168: 	# Cloudflare: 'XX' means Cloudflare couldn't determine country — skip it
●1169 → 1169 → 1178 1169: 	if(($ENV{'HTTP_CF_IPCOUNTRY'}) && ($ENV{'HTTP_CF_IPCOUNTRY'} ne 'XX')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1170: 		if($ENV{'HTTP_CF_IPCOUNTRY'} =~ /^([A-Z]{2})$/a) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1171: 			$self->{_country} = lc($1);
 1172: 			return $self->{_country};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1173: 		} else {
 1174: 			$self->_warn({ warning => 'HTTP_CF_IPCOUNTRY contains an invalid country code; ignoring' });
 1175: 		}
 1176: 	}
 1177: 
●1178 → 1183 → 1192 1178: 	my $raw_ip = $ENV{'REMOTE_ADDR'};
 1179: 	return unless defined $raw_ip;
 1180: 
 1181: 	# Validate and untaint the IP address before passing to any geo module
 1182: 	my $ip;
 1183: 	if($raw_ip =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/a) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1184: 		$ip = $1;    # untainted IPv4
 1185: 	} elsif($raw_ip =~ /^([0-9a-fA-F:]{2,39}|[0-9a-fA-F:]{2,30}:(?:\d{1,3}\.){3}\d{1,3})$/a) {
 1186: 		$ip = $1;    # untainted IPv6, including mixed notation (e.g. ::ffff:192.0.2.1)
 1187: 	} else {
 1188: 		$self->_warn({ warning => "$raw_ip isn't a valid IP address" });
 1189: 		return;
 1190: 	}
 1191: 
●1192 → 1195 → 1213 1192: 	require Data::Validate::IP;
 1193: 	Data::Validate::IP->import();
 1194: 
 1195: 	if(!is_ipv4($ip)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1196: 		$self->_debug("$ip isn't IPv4. Is it IPv6?");
 1197: 		if($ip eq '::1') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1197_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1198: 			$ip = '127.0.0.1';    # normalise loopback
 1199: 		} elsif($ip =~ /^::ffff:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/i) {
 1200: 			$ip = $1;             # normalise IPv4-mapped IPv6 (::ffff:a.b.c.d) to plain IPv4
 1201: 			# \d{1,3} matches 0-999; validate range before geo lookups because
 1202: 			# some inet_aton implementations wrap out-of-range octets modulo 256,
 1203: 			# turning 999.999.999.999 into a real routable address.
 1204: 			unless(is_ipv4($ip)) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1204_4: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 1205: 				$self->_warn({ warning => "$ip isn't a valid IP address" });
 1206: 				return;
 1207: 			}
 1208: 		} elsif(!is_ipv6($ip)) {
 1209: 			$self->_warn({ warning => "$ip isn't a valid IP address" });
 1210: 			return;
 1211: 		}
 1212: 	}
●1213 → 1213 → 1217 1213: 	if(is_private_ip($ip)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1214: 		$self->_debug("Can't determine country from LAN connection $ip");
 1215: 		return;
 1216: 	}
●1217 → 1217 → 1223 1217: 	if(is_loopback_ip($ip)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1218: 		$self->_debug("Can't determine country from loopback connection $ip");
 1219: 		return;
 1220: 	}
 1221: 
 1222: 	# Cache look-up — skip for LAN/loopback (already returned above)
●1223 → 1223 → 1239 1223: 	if($self->{_cache}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1224: 		$self->{_country} = $self->{_cache}->get($CACHE_NS . "country:$ip");
 1225: 		if(defined($self->{_country})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1226: 			if($self->{_country} !~ /\D/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1227: 				$self->_warn({ warning => 'cache contains a numeric country: ' . $self->{_country} });
 1228: 				$self->{_cache}->remove($CACHE_NS . "country:$ip");
 1229: 				delete $self->{_country};
 1230: 			} else {
 1231: 				$self->_debug("Get $ip from cache = $self->{_country}");
 1232: 				return $self->{_country};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1233: 			}
 1234: 		}
 1235: 		$self->_debug("$ip isn't in the cache");
 1236: 	}
 1237: 
 1238: 	# Try IP::Country first (fastest, local database)
●1239 → 1239 → 1249 1239: 	if($self->{_have_ipcountry} == $GEO_UNKNOWN) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1240: 		if(eval { require IP::Country::Fast }) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1240_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1241: 			# Require the concrete class directly; IP::Country->import() is not needed
 1242: 			# because IP::Country::Fast->new() is a fully-qualified class method call.
 1243: 			$self->{_have_ipcountry} = $GEO_PRESENT;
 1244: 			$self->{_ipcountry}      = IP::Country::Fast->new();
 1245: 		} else {
 1246: 			$self->{_have_ipcountry} = $GEO_ABSENT;
 1247: 		}
 1248: 	}
●1249 → 1251 → 1261 1249: 	$self->_debug("have_ipcountry $self->{_have_ipcountry}");
 1250: 
 1251: 	if($self->{_have_ipcountry}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1252: 		$self->{_country} = $self->{_ipcountry}->inet_atocc($ip);
 1253: 		if($self->{_country}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1254: 			$self->{_country} = lc($self->{_country});
 1255: 		} elsif(is_ipv4($ip)) {
 1256: 			$self->_debug("$ip is not known by IP::Country");
 1257: 		}
 1258: 	}
 1259: 
 1260: 	# Try Geo::IP if IP::Country gave nothing
●1261 → 1261 → 1292 1261: 	unless(defined($self->{_country})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1262: 		if($self->{_have_geoip} == $GEO_UNKNOWN) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1263: 			$self->_load_geoip();
 1264: 		}
 1265: 		if($self->{_have_geoip} == $GEO_PRESENT) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1266: 			$self->{_country} = $self->{_geoip}->country_code_by_addr($ip);
 1267: 		}
 1268: 
 1269: 		# Geo::IPfree has a known-broken entry for $BROKEN_GEOIPFREE
 1270: 		if(!defined($self->{_country}) && ($ip ne $BROKEN_GEOIPFREE)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1271: 			if($self->{_have_geoipfree} == $GEO_UNKNOWN) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1272: 				eval { require Geo::IPfree };
 1273: 				unless($@) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1273_5: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 1274: 					# No ->import(): Geo::IPfree uses only OO (->LookUp); the old
 1275: 					# Geo::IPfree::IP->import() call was a wrong package and could
 1276: 					# clobber Test::Mockingbird mocks on some versions.
 1277: 					$self->{_have_geoipfree} = $GEO_PRESENT;
 1278: 					$self->{_geoipfree}      = Geo::IPfree->new();
 1279: 				} else {
 1280: 					$self->{_have_geoipfree} = $GEO_ABSENT;
 1281: 				}
 1282: 			}
 1283: 			if($self->{_have_geoipfree} == $GEO_PRESENT) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1284: 				if(my $country = ($self->{_geoipfree}->LookUp($ip))[0]) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1285: 					$self->{_country} = lc($country);
 1286: 				}
 1287: 			}
 1288: 		}
 1289: 	}
 1290: 
 1291: 	# 'eu' is not a real country — discard
●1292 → 1292 → 1297 1292: 	if($self->{_country} && ($self->{_country} eq 'eu')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1293: 		delete $self->{_country};
 1294: 	}
 1295: 
 1296: 	# Remote JSON lookup via geoplugin
●1297 → 1297 → 1308 1297: 	if((!$self->{_country}) &&
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1298: 	   (eval { require LWP::Simple::WithCache; require JSON::Parse })) {
 1299: 		$self->_debug("Look up $ip on geoplugin");
 1300: 
 1301: 		if(my $data = LWP::Simple::WithCache::get("https://www.geoplugin.net/json.gp?ip=$ip")) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1301_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1302: 			eval { $self->{_country} = JSON::Parse::parse_json($data)->{'geoplugin_countryCode'} };
 1303: 			$self->_warn({ warning => "geoplugin returned unparseable JSON: $@" }) if $@;
 1304: 		}
 1305: 	}
 1306: 
 1307: 	# Last resort: Whois
●1308 → 1308 → 1313 1308: 	unless($self->{_country}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1309: 		$self->_resolve_country_via_whois($ip);
 1310: 	}
 1311: 
 1312: 	# Sanitise and normalise whatever we found
●1313 → 1313 → 1351 1313: 	if($self->{_country}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1314: 		if($self->{_country} !~ /\D/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1315: 			$self->_warn({ warning => 'IP matches to a numeric country' });
 1316: 			delete $self->{_country};
 1317: 		} else {
 1318: 			$self->{_country} = lc($self->{_country});
 1319: 
 1320: 			# Legacy mappings
 1321: 			if($self->{_country} eq 'hk') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1322: 				$self->{_country} = 'cn';    # HK is no longer a separate country in Whois
 1323: 			} elsif($self->{_country} eq 'eu') {
 1324: 				$self->_handle_eu_country($ip);
 1325: 			}
 1326: 
 1327: 			if($self->{_country} && ($self->{_country} !~ /\D/)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1328: 				$self->_warn({ warning => "cache contains a numeric country: $self->{_country}" });
 1329: 				delete $self->{_country};
 1330: 			} elsif($self->{_country} &&
 1331: 				$self->{_country} ne 'Unknown' &&
 1332: 				($self->{_country} !~ /^[a-z]{2}$/)) {
 1333: 				# Reject anything that is not exactly 2 lowercase ASCII letters,
 1334: 				# unless it is the 'Unknown' sentinel written by _handle_eu_country
 1335: 				# for EU addresses that do not map to a specific country.
 1336: 				# Guards against Whois CRLF injection leftovers ("gbx-header: evil")
 1337: 				# and XSS payloads in JSON API responses ("gb<script>...</script>").
 1338: 				$self->_warn({ warning => "Discarding malformed country code '$self->{_country}'" });
 1339: 				delete $self->{_country};
 1340: 			} elsif($self->{_country} && $self->{_cache}) {
 1341: 				$self->_debug("Set $ip to $self->{_country}");
 1342: 				$self->{_cache}->set(
 1343: 					$CACHE_NS . "country:$ip",
 1344: 					$self->{_country},
 1345: 					$CACHE_TTL_SHORT
 1346: 				);
 1347: 			}
 1348: 		}
 1349: 	}
 1350: 
 1351: 	return $self->{_country};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1352: }
 1353: 
 1354: # ── _resolve_country_via_whois ─────────────────────────────────────────────
 1355: # Purpose:      Attempt Net::Whois::IP then Net::Whois::IANA as a last resort.
 1356: # Entry:        $ip — validated, untainted IP string.
 1357: # Exit:         Sets $self->{_country} if a result was found.
 1358: # Side Effects: Network I/O; logs debug messages.
 1359: sub _resolve_country_via_whois
 1360: {
●1361 → 1376 → 1392 1361: 	my ($self, $ip) = @_;
 1362: 
 1363: 	$self->_debug("Look up $ip on Whois");
 1364: 
 1365: 	require Net::Whois::IP;
 1366: 	# No ->import(): whoisip_query is called fully-qualified, so import is unneeded
 1367: 	# and on some versions reinstalls the real function, clobbering Test::Mockingbird mocks.
 1368: 
 1369: 	my $whois;
 1370: 	eval {
 1371: 		# Catch connection timeouts by converting Carp::carp into a die
 1372: 		local $SIG{__WARN__} = sub { die $_[0] };
 1373: 		$whois = Net::Whois::IP::whoisip_query($ip);
 1374: 	};
 1375: 
 1376: 	unless($@ || !defined($whois) || (ref($whois) ne 'HASH')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1377: 		if(defined($whois->{Country})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1378: 			$self->{_country} = $whois->{Country};
 1379: 		} elsif(defined($whois->{country})) {
 1380: 			$self->{_country} = $whois->{country};
 1381: 		}
 1382: 		if($self->{_country}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1383: 			if($self->{_country} eq 'EU') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1384: 				delete $self->{_country};
 1385: 			} elsif(($self->{_country} eq 'US') && defined($whois->{'StateProv'}) && ($whois->{'StateProv'} eq 'PR')) {
 1386: 				# RT#131347: Puerto Rico is not the US
 1387: 				$self->{_country} = 'pr';
 1388: 			}
 1389: 		}
 1390: 	}
 1391: 
●1392 → 1392 → 1401 1392: 	if($self->{_country}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1393: 		$self->_debug("Found $ip on Net::Whois::IP as ", $self->{_country});
 1394: 		$self->{_country} = _clean_country_code($self->{_country});
 1395: 		# _clean_country_code returns undef for malformed values (e.g. CRLF
 1396: 		# injection leftovers); if so, fall through to the IANA look-up.
 1397: 		return if defined $self->{_country};
 1398: 		delete $self->{_country};
 1399: 	}
 1400: 
●1401 → 1408 → 1413 1401: 	$self->_debug("Look up $ip on IANA");
 1402: 
 1403: 	require Net::Whois::IANA;
 1404: 	# No ->import(): Net::Whois::IANA->new() is a class method; import not needed.
 1405: 
 1406: 	my $iana = Net::Whois::IANA->new();
 1407: 	eval { $iana->whois_query(-ip => $ip) };
 1408: 	unless($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1409: 		$self->{_country} = $iana->country();
 1410: 		$self->_debug("IANA reports $ip as ", $self->{_country});
 1411: 	}
 1412: 
●1413 → 1413 → 0 1413: 	if($self->{_country}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1414: 		$self->{_country} = _clean_country_code($self->{_country});
 1415: 		delete $self->{_country} unless defined $self->{_country};
 1416: 	}
 1417: }
 1418: 
 1419: # ── _clean_country_code ───────────────────────────────────────────────────
 1420: # Purpose:      Strip carriage returns and trailing "#…" comments that some
 1421: #               Whois servers append to their country field
 1422: #               (e.g. "US\r", "GB # United Kingdom").
 1423: # Entry:        $raw — raw country string from a Whois response.
 1424: # Exit:         Cleaned 2-char country code string.
 1425: sub _clean_country_code
 1426: {
●1427 → 1433 → 1436 1427: 	my ($raw) = @_;
 1428: 	$raw =~ s/[\r\n]//g;
 1429: 	# Accept exactly 2 alpha chars, optionally followed by whitespace and a
 1430: 	# comment (e.g. "GB # United Kingdom").  Anything else (CRLF injection
 1431: 	# leftovers, embedded headers) returns undef so the caller can discard it
 1432: 	# rather than propagating a malformed string through the geo pipeline.
 1433: 	if($raw =~ /^([A-Za-z]{2})\s*(?:#.*)?$/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1434: 		return $1;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1435: 	}
 1436: 	return;
 1437: }
 1438: 
 1439: # ── _handle_eu_country ────────────────────────────────────────────────────
 1440: # Purpose:      Resolve the ambiguous 'eu' country code.  RT-86809 shows that
 1441: #               Baidu reports itself as EU when it is actually in CN.  All
 1442: #               other 'eu' addresses are logged as Unknown.
 1443: # Entry:        $ip — validated, untainted IP string.
 1444: # Exit:         Sets $self->{_country} to 'cn' or 'Unknown'.
 1445: # Side Effects: Loads Net::Subnet; writes info log entry.
 1446: sub _handle_eu_country
 1447: {
●1448 → 1453 → 0 1448: 	my ($self, $ip) = @_;
 1449: 
 1450: 	require Net::Subnet;
 1451: 	Net::Subnet->import();
 1452: 
 1453: 	if(subnet_matcher($BAIDU_SUBNET)->($ip)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1454: 		$self->{_country} = 'cn';
 1455: 	} else {
 1456: 		$self->_info("$ip has country of eu");
 1457: 		$self->{_country} = 'Unknown';
 1458: 	}
 1459: }
 1460: 
 1461: # ── _load_geoip ───────────────────────────────────────────────────────────
 1462: # Purpose:      Probe for the Geo::IP database file and the Geo::IP module;
 1463: #               set _have_geoip and initialise _geoip on success.
 1464: # Entry:        _have_geoip must be GEO_UNKNOWN.
 1465: # Exit:         _have_geoip set to GEO_PRESENT or GEO_ABSENT.
 1466: # Side Effects: Requires Geo::IP; opens GeoIP.dat.
 1467: sub _load_geoip
 1468: {
●1469 → 1479 → 1484 1469: 	my $self = shift;
 1470: 
 1471: 	# Check for the database file before even trying to load the module
 1472: 	# (avoids noisy errors on Windows — CPANTESTERS report 54117bd0)
 1473: 	my $db_present = (
 1474: 		(($^O eq 'MSWin32') && (-r 'c:/GeoIP/GeoIP.dat'))
 1475: 		|| (-r '/usr/local/share/GeoIP/GeoIP.dat')
 1476: 		|| (-r '/usr/share/GeoIP/GeoIP.dat')
 1477: 	);
 1478: 
 1479: 	unless($db_present) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1479_2: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 1480: 		$self->{_have_geoip} = $GEO_ABSENT;
 1481: 		return;
 1482: 	}
 1483: 
●[NOT COVERED] 1484 → 1485 → 1491 1484: 	eval { require Geo::IP };
 1485: 	if($@) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1485_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1486: 		$self->{_have_geoip} = $GEO_ABSENT;
 1487: 		return;
 1488: 	}
 1489: 
 1490: 	# No ->import(): Geo::IP->open() and Geo::IP->new() are class methods; import unneeded.
●[NOT COVERED] 1491 → 1494 → 0 1491: 	$self->{_have_geoip} = $GEO_PRESENT;
 1492: 
 1493: 	# GEOIP_STANDARD = 0 (can't use the constant name directly)
 1494: 	if(-r '/usr/share/GeoIP/GeoIP.dat') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1494_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1495: 		$self->{_geoip} = Geo::IP->open('/usr/share/GeoIP/GeoIP.dat', 0);
 1496: 	} else {
 1497: 		$self->{_geoip} = Geo::IP->new(0);
 1498: 	}
 1499: }
 1500: 
 1501: =head2 locale
 1502: 
 1503: HTTP doesn't have a way of transmitting a browser's localisation information
 1504: which would be useful for default currency, date formatting, etc.
 1505: 
 1506: This method attempts to detect the information, but it is a best guess
 1507: and is not 100% reliable.  But it's better than nothing ;-)
 1508: 
 1509: Returns a L<Locale::Object::Country> object.
 1510: 
 1511: =head3 EXAMPLE
 1512: 
 1513:     local $ENV{REMOTE_ADDR} = '8.8.8.8';
 1514:     my $locale = $l->locale();
 1515:     if (defined $locale) {
 1516:         print $locale->name();          # e.g. "United States"
 1517:         print $locale->currency_code(); # e.g. "USD"
 1518:     }
 1519: 
 1520: =head3 API SPECIFICATION
 1521: 
 1522:     Input:  none beyond $self
 1523:     Returns: Locale::Object::Country | undef
 1524: 
 1525: =head3 PSEUDOCODE
 1526: 
 1527:     1. Return cached _locale immediately if already computed
 1528:     2. Parse HTTP_USER_AGENT parenthetical for xx-YY language tag
 1529:     3. Try HTTP::BrowserDetect on the full User-Agent string
 1530:     4. Fall back to country() IP lookup
 1531:     5. Fall back to GEOIP_COUNTRY_CODE env var (ISO 3166-1 validated)
 1532:     6. Return undef if all strategies fail
 1533: 
 1534: =cut
 1535: 
 1536: sub locale {
●1537 → 1545 → 1554 1537: 	my $self = shift;
 1538: 
 1539: 	return $self->{_locale} if $self->{_locale};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1540: 
 1541: 	# Validate and untaint HTTP_USER_AGENT before passing to any parser.
 1542: 	# The User-Agent header is attacker-controlled; apply the same discipline
 1543: 	# as HTTP_ACCEPT_LANGUAGE.  Printable ASCII (0x20-0x7e), bounded length.
 1544: 	my $agent;
 1545: 	if(defined(my $raw_agent = $ENV{'HTTP_USER_AGENT'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1546: 		if($raw_agent =~ /^([\x20-\x7e]{1,$UA_MAX})$/a) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1547: 			$agent = $1;    # untainted
 1548: 		} else {
 1549: 			$self->_warn({ warning => 'HTTP_USER_AGENT contains invalid characters or exceeds length limit; ignoring' });
 1550: 		}
 1551: 	}
 1552: 
 1553: 	# First try: parse the language tag from the User-Agent parenthetical
●1554 → 1554 → 1587 1554: 	if(defined($agent) && ($agent =~ /\((.+)\)/)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1555: 		foreach(split(/;/, $1)) {
 1556: 			my $candidate = $_;
 1557: 			$candidate =~ s/^\s+|\s+$//g;    # trim both ends
 1558: 
 1559: 			if($candidate =~ /^[a-zA-Z]{2}-([a-zA-Z]{2})$/) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1559_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1560: 				local $SIG{__WARN__} = undef;
 1561: 				if(my $c = $self->_code2country($1)) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1561_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1562: 					$self->{_locale} = $c;
 1563: 					return $c;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1564: 				}
 1565: 			}
 1566: 		}
 1567: 
 1568: 		# Second try: HTTP::BrowserDetect (works for more User-Agents)
 1569: 		if(eval { require HTTP::BrowserDetect }) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1569_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1570: 			HTTP::BrowserDetect->import();
 1571: 			my $browser = HTTP::BrowserDetect->new($agent);
 1572: 			# Validate country() result before use — the return value comes from
 1573: 			# the third-party module and is not yet untainted or range-checked.
 1574: 			if($browser) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1574_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1575: 				my $bc = $browser->country() // '';
 1576: 				if($bc =~ /^([A-Za-z]{2})$/a) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1576_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1577: 					if(my $c = $self->_code2country($1)) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1577_6: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1578: 						$self->{_locale} = $c;
 1579: 						return $c;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1579_7: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1579_7: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1580: 					}
 1581: 				}
 1582: 			}
 1583: 		}
 1584: 	}
 1585: 
 1586: 	# Third try: IP address
●1587 → 1588 → 1605 1587: 	my $country = $self->country();
 1588: 	if($country) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1589: 		$country =~ s/[\r\n]//g;
 1590: 		my $c;
 1591: 		eval {
 1592: 			local $SIG{__WARN__} = sub { die $_[0] };
 1593: 			$c = $self->_code2country($country);
 1594: 		};
 1595: 		unless($@) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1595_3: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 1596: 			if($c) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1596_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1597: 				$self->{_locale} = $c;
 1598: 				return $c;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1599: 			}
 1600: 		}
 1601: 	}
 1602: 
 1603: 	# Fourth try: mod_geoip env var — apply the same ISO 3166-1 validation
 1604: 	# used in country() to guard against spoofed or malformed values
●1605 → 1605 → 1613 1605: 	if(defined($ENV{'GEOIP_COUNTRY_CODE'})) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1605_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1606: 		if($ENV{'GEOIP_COUNTRY_CODE'} =~ /^([A-Z]{2})$/a) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1607: 			if(my $c = $self->_code2country(lc($1))) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1607_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1608: 				$self->{_locale} = $c;
 1609: 				return $c;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1609_5: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1609_5: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1610: 			}
 1611: 		}
 1612: 	}
 1613: 	return;
 1614: }
 1615: 
 1616: =head2 time_zone
 1617: 
 1618: Returns the timezone of the web client.
 1619: 
 1620: If L<Geo::IP> is installed,
 1621: CGI::Lingua will make use of that, otherwise it will use L<ip-api.com>
 1622: 
 1623: =head3 API SPECIFICATION
 1624: 
 1625:     Input:  none beyond $self
 1626:     Returns: Str (IANA timezone name) | undef
 1627: 
 1628: =head3 EXAMPLE
 1629: 
 1630:     local $ENV{REMOTE_ADDR} = '8.8.8.8';
 1631:     my $tz = $l->time_zone();
 1632:     print $tz // 'unknown';   # e.g. "America/New_York"
 1633: 
 1634: =head3 MESSAGES
 1635: 
 1636:     "Couldn't determine the timezone"
 1637:     "LWP::Simple::WithCache and LWP::Simple are both absent; cannot contact ip-api.com"
 1638:       Returns undef rather than croaking; install either LWP variant to enable ip-api lookups.
 1639: 
 1640: =head3 PSEUDOCODE
 1641: 
 1642:     1. Return cached _timezone immediately if already computed
 1643:     2. If REMOTE_ADDR is set:
 1644:        a. Untaint and validate the IP
 1645:        b. Try Geo::IP->time_zone() (local DB)
 1646:        c. Try LWP::Simple::WithCache + JSON::Parse against ip-api.com
 1647:        d. Fall back to LWP::Simple + JSON::Parse against ip-api.com
 1648:        e. Warn and return undef if neither LWP variant is installed
 1649:     3. If REMOTE_ADDR is absent (local/CLI mode):
 1650:        a. Read /etc/timezone if readable
 1651:        b. Fall back to DateTime::TimeZone::Local->TimeZone()->name()
 1652:     4. Warn "Couldn't determine the timezone" and return undef if all fail
 1653: 
 1654: =cut
 1655: 
 1656: sub time_zone {
●1657 → 1661 → 1666 1657: 	my $self = shift;
 1658: 
 1659: 	$self->_trace('Entered time_zone');
 1660: 
 1661: 	if($self->{_timezone}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1662: 		$self->_trace('quick return: ', $self->{_timezone});
 1663: 		return $self->{_timezone};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1664: 	}
 1665: 
●1666 → 1668 → 1724 1666: 	my $raw_ip = $ENV{'REMOTE_ADDR'};
 1667: 
 1668: 	if(defined $raw_ip) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1669: 		# Untaint before any external use — kept in sync with country()'s pattern,
 1670: 		# including the mixed-notation branch for ::ffff:a.b.c.d addresses.
 1671: 		my $ip;
 1672: 		if($raw_ip =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/a) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1673: 			$ip = $1;
 1674: 		} elsif($raw_ip =~ /^([0-9a-fA-F:]{2,39}|[0-9a-fA-F:]{2,30}:(?:\d{1,3}\.){3}\d{1,3})$/a) {
 1675: 			$ip = $1;
 1676: 		} else {
 1677: 			$self->_warn({ warning => "$raw_ip isn't a valid IP address" });
 1678: 			return;
 1679: 		}
 1680: 
 1681: 		if($self->{_have_geoip} == $GEO_UNKNOWN) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1682: 			$self->_load_geoip();
 1683: 		}
 1684: 		if($self->{_have_geoip} == $GEO_PRESENT) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1685: 			eval { $self->{_timezone} = $self->{_geoip}->time_zone($ip) };
 1686: 		}
 1687: 
 1688: 		unless($self->{_timezone}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1689: 			if(eval { require LWP::Simple::WithCache; require JSON::Parse }) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1690: 				$self->_debug("Look up $ip on ip-api.com");
 1691: 
 1692: 				if(my $data = LWP::Simple::WithCache::get("http://ip-api.com/json/$ip")) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1692_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1693: 					eval { $self->{_timezone} = JSON::Parse::parse_json($data)->{'timezone'} };
 1694: 					$self->_warn({ warning => "ip-api.com returned unparseable JSON: $@" }) if $@;
 1695: 				}
 1696: 			} elsif(eval { require LWP::Simple; require JSON::Parse }) {
 1697: 				$self->_debug("Look up $ip on ip-api.com");
 1698: 
 1699: 				if(my $data = LWP::Simple::get("http://ip-api.com/json/$ip")) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1699_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1700: 					eval { $self->{_timezone} = JSON::Parse::parse_json($data)->{'timezone'} };
 1701: 					$self->_warn({ warning => "ip-api.com returned unparseable JSON: $@" }) if $@;
 1702: 				}
 1703: 			} else {
 1704: 				# Neither LWP variant is available — degrade gracefully rather than
 1705: 				# killing the entire request with a croak; caller can check for undef.
 1706: 				$self->_warn({ warning => 'LWP::Simple::WithCache and LWP::Simple are both absent; cannot contact ip-api.com' });
 1707: 			}
 1708: 		}
 1709: 	} else {
 1710: 		# Local connection — read from /etc/timezone or DateTime::TimeZone
 1711: 		if(CORE::open(my $fin, '<', '/etc/timezone')) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1711_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1712: 			my $tz = <$fin>;
 1713: 			chomp $tz;
 1714: 			$self->{_timezone} = $tz;
 1715: 		} else {
 1716: 			$self->{_timezone} = DateTime::TimeZone::Local->TimeZone()->name();
 1717: 		}
 1718: 	}
 1719: 
 1720: 	# Validate the timezone string against a permissive but bounded IANA pattern.
 1721: 	# Rejects XSS payloads (e.g. "Europe/London<script>...") from hostile JSON
 1722: 	# responses while accepting all real IANA zone names (e.g. "America/New_York",
 1723: 	# "Etc/GMT+8", "UTC").
●1724 → 1724 → 1730 1724: 	if(defined($self->{_timezone}) &&
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1725: 	   $self->{_timezone} !~ /^[A-Za-z][A-Za-z0-9_+\-\/]{0,50}$/) {
 1726: 		$self->_warn({ warning => "Discarding malformed timezone '$self->{_timezone}'" });
 1727: 		delete $self->{_timezone};
 1728: 	}
 1729: 
●1730 → 1730 → 1733 1730: 	unless(defined($self->{_timezone})) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1730_2: Invert condition unless to if
MEDIUM: Add tests asserting both true and false outcomes

 1731: 		$self->_warn({ warning => "Couldn't determine the timezone" });
 1732: 	}
 1733: 	return $self->{_timezone};
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1734: }
 1735: 
 1736: =head2 is_rtl
 1737: 
 1738: Returns true (1) if the negotiated language is written right-to-left, false (0)
 1739: otherwise.  Covers Arabic, Hebrew, Persian, Urdu, Yiddish, Dhivehi, Pashto,
 1740: Sindhi, Uyghur, and Kurdish.
 1741: 
 1742: =head3 EXAMPLE
 1743: 
 1744:     local $ENV{HTTP_ACCEPT_LANGUAGE} = 'ar';
 1745:     my $l = CGI::Lingua->new(supported => ['ar', 'en']);
 1746:     print $l->is_rtl();   # 1
 1747: 
 1748: =head3 API SPECIFICATION
 1749: 
 1750:     Input:  none beyond $self
 1751:     Returns: 1 | 0
 1752: 
 1753: =cut
 1754: 
 1755: sub is_rtl
 1756: {
 1757: 	my $self = shift;
 1758: 	return $RTL_LANGS{$self->language_code_alpha2() // ''} ? 1 : 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1759: }
 1760: 
 1761: =head2 text_direction
 1762: 
 1763: Returns C<'rtl'> or C<'ltr'> for the negotiated language, suitable for direct
 1764: use as an HTML C<dir> attribute value.
 1765: 
 1766: =head3 EXAMPLE
 1767: 
 1768:     local $ENV{HTTP_ACCEPT_LANGUAGE} = 'he';
 1769:     my $l = CGI::Lingua->new(supported => ['he', 'en']);
 1770:     print qq(<html dir="} . $l->text_direction() . qq(">);   # dir="rtl"
 1771: 
 1772: =head3 API SPECIFICATION
 1773: 
 1774:     Input:  none beyond $self
 1775:     Returns: 'rtl' | 'ltr'
 1776: 
 1777: =cut
 1778: 
 1779: sub text_direction
 1780: {
 1781: 	my $self = shift;
 1782: 	return $self->is_rtl() ? 'rtl' : 'ltr';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1783: }
 1784: 
 1785: =head2 plural_category
 1786: 
 1787: Returns the CLDR plural category for the integer C<$n> in the negotiated
 1788: language.  The returned string is one of C<'zero'>, C<'one'>, C<'two'>,
 1789: C<'few'>, C<'many'>, or C<'other'>.
 1790: 
 1791: Rules are embedded for ~70 languages including Arabic (6 forms), Slavic
 1792: languages (3-4 forms), Celtic languages (up to 6 forms), and Hebrew, Maltese,
 1793: Romanian, Latvian, Lithuanian, and Slovenian.  Languages not in the table fall
 1794: back to the English rule (n == 1 => C<'one'>, else C<'other'>).
 1795: 
 1796: For fractional numbers or full CLDR v42+ accuracy, use C<Locale::CLDR>.
 1797: 
 1798: =head3 EXAMPLE
 1799: 
 1800:     local $ENV{HTTP_ACCEPT_LANGUAGE} = 'ru';
 1801:     my $l = CGI::Lingua->new(supported => ['ru']);
 1802:     print $l->plural_category(1);    # "one"
 1803:     print $l->plural_category(3);    # "few"
 1804:     print $l->plural_category(11);   # "many"
 1805: 
 1806: =head3 API SPECIFICATION
 1807: 
 1808:     Input:  $n - non-negative integer (fractional values are truncated)
 1809:     Returns: Str - one of zero/one/two/few/many/other
 1810: 
 1811: =cut
 1812: 
 1813: # CLDR plural category rules (https://unicode.org/cldr/charts/42/supplemental/language_plural_rules.html).
 1814: # Values are coderefs: ($n) → category string.  Languages absent from this
 1815: # table fall back to the standard one/other rule inside plural_category().
 1816: my %PLURAL_RULES = (
 1817: 
 1818: 	# ── No plural distinction (always 'other') ────────────────────────────
 1819: 	(map { $_ => sub { 'other' } }
 1820: 		qw(az bm bo dz id ig ii in ja jbo jv jw kde kea km ko lkt lo ms
 1821: 		   my nqo root sah ses sg th to vi wo yo zh)),
 1822: 
 1823: 	# ── Standard: n == 1 → 'one', else 'other' ───────────────────────────
 1824: 	(map { $_ => sub { int($_[0]) == 1 ? 'one' : 'other' } }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1825: 		qw(af an ast bg bn brx ca cgg da de el en eo es et eu fi
 1826: 		   gl gsw gu ha haw hu ia it kcg kk kl lb lg mas ml mn mr
 1827: 		   nb nd ne nl nn nyn om or pa pap rm rof rwk saq seh sn so
 1828: 		   sq ss ssy st sv sw ta te teo tig tk tl tn ts ur wae xh xog)),
 1829: 
 1830: 	# ── French / Portuguese-BR: n ≤ 1 → 'one' ────────────────────────────
 1831: 	(map { $_ => sub { int($_[0]) <= 1 ? 'one' : 'other' } } qw(fr pt_BR)),

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1831_32_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1831_32_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1831_32_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1832: 
 1833: 	# ── Arabic: zero/one/two/few/many/other ───────────────────────────────
 1834: 	ar => sub {
 1835: 		my $n    = int($_[0]);
 1836: 		my $m100 = $n % 100;
 1837: 		return 'zero'  if $n == 0;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 1838: 		return 'one'   if $n == 1;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 1839: 		return 'two'   if $n == 2;
  Mutants (Total: 3, Killed: 3, Survived: 0)
 1840: 		return 'few'   if $m100 >= 3  && $m100 <= 10;

					

					
Mutants (Total: 8, Killed: 2, Survived: 6)
					

				
NUM_BOUNDARY_1840_27_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1840_27_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1840_27_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1840_42_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1840_42_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1840_42_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1841: 		return 'many'  if $m100 >= 11 && $m100 <= 99;

					

					
Mutants (Total: 8, Killed: 2, Survived: 6)
					

				
NUM_BOUNDARY_1841_27_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1841_27_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1841_27_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1841_42_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1841_42_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1841_42_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1842: 		return 'other';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1843: 	},
 1844: 
 1845: 	# ── Hebrew: one/two/many/other ────────────────────────────────────────
 1846: 	he => sub {
 1847: 		my $n = int($_[0]);
 1848: 		return 'one'  if $n == 1;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1848_23_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1848_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1848_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1849: 		return 'two'  if $n == 2;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1849_23_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1849_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1849_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1850: 		return 'many' if $n != 0 && $n % 10 == 0;

					

					
Mutants (Total: 4, Killed: 0, Survived: 4)
					

				
NUM_BOUNDARY_1850_39_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1850_23_==: Numeric boundary flip != to ==
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1850_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1850_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1851: 		return 'other';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1851_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1851_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1852: 	},
 1853: 
 1854: 	# ── Russian / Ukrainian / Belarusian: one/few/many ────────────────────
 1855: 	(map { $_ => sub {
 1856: 		my $n    = int($_[0]);
 1857: 		my $m10  = $n % 10;
 1858: 		my $m100 = $n % 100;
 1859: 		return 'one' if $m10 == 1 && $m100 != 11;
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1860: 		return 'few' if $m10 >= 2 && $m10 <= 4 && ($m100 < 10 || $m100 >= 20);

					

					
Mutants (Total: 11, Killed: 8, Survived: 3)
					

				
NUM_BOUNDARY_1860_37_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1860_37_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1860_37_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1861: 		return 'many';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1862: 	} } qw(ru uk be)),
 1863: 
 1864: 	# ── Polish: one/few/many ──────────────────────────────────────────────
 1865: 	pl => sub {
 1866: 		my $n    = int($_[0]);
 1867: 		my $m10  = $n % 10;
 1868: 		my $m100 = $n % 100;
 1869: 		return 'one' if $n == 1;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1869_22_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1869_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1869_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1870: 		return 'few' if $m10 >= 2 && $m10 <= 4 && ($m100 < 10 || $m100 >= 20);

					

					
Mutants (Total: 11, Killed: 0, Survived: 11)
					

				
NUM_BOUNDARY_1870_52_>: Numeric boundary flip < to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1870_52_<=: Numeric boundary flip < to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1870_52_>=: Numeric boundary flip < to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1870_37_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1870_37_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1870_37_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1870_24_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1870_24_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1870_24_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1870_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1870_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1871: 		return 'many';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1871_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1871_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1872: 	},
 1873: 
 1874: 	# ── Czech / Slovak: one/few/other ────────────────────────────────────
 1875: 	(map { $_ => sub {
 1876: 		my $n = int($_[0]);
 1877: 		return 'one' if $n == 1;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1877_22_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1877_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1877_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1878: 		return 'few' if $n >= 2 && $n <= 4;

					

					
Mutants (Total: 8, Killed: 0, Survived: 8)
					

				
NUM_BOUNDARY_1878_33_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1878_33_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1878_33_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1878_22_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1878_22_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1878_22_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1878_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1878_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1879: 		return 'other';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1879_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1879_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1880: 	} } qw(cs sk)),
 1881: 
 1882: 	# ── Romanian: one/few/other ───────────────────────────────────────────
 1883: 	ro => sub {
 1884: 		my $n    = int($_[0]);
 1885: 		my $m100 = $n % 100;
 1886: 		return 'one' if $n == 1;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1886_22_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1886_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1886_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1887: 		return 'few' if $n == 0 || ($m100 >= 1 && $m100 <= 19);

					

					
Mutants (Total: 9, Killed: 0, Survived: 9)
					

				
NUM_BOUNDARY_1887_37_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1887_37_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1887_37_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1887_22_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1887_51_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1887_51_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1887_51_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1887_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1887_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1888: 		return 'other';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1888_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1888_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1889: 	},
 1890: 
 1891: 	# ── Latvian: zero/one/other ───────────────────────────────────────────
 1892: 	lv => sub {
 1893: 		my $n    = int($_[0]);
 1894: 		my $m10  = $n % 10;
 1895: 		my $m100 = $n % 100;
 1896: 		return 'zero'  if $m10 == 0 || ($m100 >= 11 && $m100 <= 19);

					

					
Mutants (Total: 9, Killed: 0, Survived: 9)
					

				
NUM_BOUNDARY_1896_41_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1896_41_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1896_41_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1896_26_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1896_56_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1896_56_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1896_56_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1896_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1896_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1897: 		return 'one'   if $m10 == 1 && $m100 != 11;

					

					
Mutants (Total: 4, Killed: 0, Survived: 4)
					

				
NUM_BOUNDARY_1897_40_==: Numeric boundary flip != to ==
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1897_26_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1897_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1897_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1898: 		return 'other';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1898_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1898_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1899: 	},
 1900: 
 1901: 	# ── Lithuanian: one/few/other ─────────────────────────────────────────
 1902: 	lt => sub {
 1903: 		my $n    = int($_[0]);
 1904: 		my $m10  = $n % 10;
 1905: 		my $m100 = $n % 100;
 1906: 		return 'one' if $m10 == 1 && ($m100 < 10 || $m100 >= 20);

					

					
Mutants (Total: 9, Killed: 0, Survived: 9)
					

				
NUM_BOUNDARY_1906_24_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1906_53_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1906_53_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1906_53_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1906_39_>: Numeric boundary flip < to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1906_39_<=: Numeric boundary flip < to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1906_39_>=: Numeric boundary flip < to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1906_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1906_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1907: 		return 'few' if $m10 >= 2 && ($m100 < 10 || $m100 >= 20);

					

					
Mutants (Total: 8, Killed: 0, Survived: 8)
					

				
NUM_BOUNDARY_1907_39_>: Numeric boundary flip < to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1907_39_<=: Numeric boundary flip < to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1907_39_>=: Numeric boundary flip < to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1907_24_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1907_24_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1907_24_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1907_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1907_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1908: 		return 'other';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1908_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1908_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1909: 	},
 1910: 
 1911: 	# ── Slovenian: one/two/few/other ──────────────────────────────────────
 1912: 	sl => sub {
 1913: 		my $m100 = int($_[0]) % 100;
 1914: 		return 'one'   if $m100 == 1;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1914_27_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1914_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1914_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1915: 		return 'two'   if $m100 == 2;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1915_27_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1915_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1915_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1916: 		return 'few'   if $m100 == 3 || $m100 == 4;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1916_27_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1916_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1916_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1917: 		return 'other';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1917_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1917_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1918: 	},
 1919: 
 1920: 	# ── Welsh: zero/one/two/few/many/other ───────────────────────────────
 1921: 	cy => sub {
 1922: 		my $n = int($_[0]);
 1923: 		return 'zero'  if $n == 0;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1923_24_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1923_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1923_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1924: 		return 'one'   if $n == 1;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1924_24_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1924_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1924_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1925: 		return 'two'   if $n == 2;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1925_24_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1925_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1925_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1926: 		return 'few'   if $n == 3;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1926_24_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1926_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1926_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1927: 		return 'many'  if $n == 6;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1927_24_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1927_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1927_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1928: 		return 'other';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1928_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1928_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1929: 	},
 1930: 
 1931: 	# ── Irish: one/two/few/many/other ────────────────────────────────────
 1932: 	ga => sub {
 1933: 		my $n = int($_[0]);
 1934: 		return 'one'  if $n == 1;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1934_23_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1934_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1934_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1935: 		return 'two'  if $n == 2;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1935_23_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1935_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1935_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1936: 		return 'few'  if $n >= 3 && $n <= 6;

					

					
Mutants (Total: 8, Killed: 0, Survived: 8)
					

				
NUM_BOUNDARY_1936_34_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1936_34_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1936_34_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1936_23_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1936_23_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1936_23_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1936_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1936_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1937: 		return 'many' if $n >= 7 && $n <= 10;

					

					
Mutants (Total: 8, Killed: 0, Survived: 8)
					

				
NUM_BOUNDARY_1937_34_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1937_34_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1937_34_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1937_23_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1937_23_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1937_23_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1937_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1937_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1938: 		return 'other';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1938_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1938_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1939: 	},
 1940: 
 1941: 	# ── Maltese: one/two/few/many/other ──────────────────────────────────
 1942: 	mt => sub {
 1943: 		my $n    = int($_[0]);
 1944: 		my $m100 = $n % 100;
 1945: 		return 'one'  if $n == 1;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1945_23_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1945_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1945_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1946: 		return 'two'  if $n == 2;

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_1946_23_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1946_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1946_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1947: 		return 'few'  if $n == 0 || ($m100 >= 3  && $m100 <= 10);

					

					
Mutants (Total: 9, Killed: 0, Survived: 9)
					

				
NUM_BOUNDARY_1947_23_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1947_38_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1947_38_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1947_38_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1947_53_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1947_53_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1947_53_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1947_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1947_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1948: 		return 'many' if $m100 >= 11 && $m100 <= 19;

					

					
Mutants (Total: 8, Killed: 0, Survived: 8)
					

				
NUM_BOUNDARY_1948_26_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1948_26_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1948_26_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1948_41_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1948_41_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_1948_41_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
BOOL_NEGATE_1948_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1948_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1949: 		return 'other';

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1949_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1949_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1950: 	},
 1951: );
 1952: 
 1953: sub plural_category
 1954: {
 1955: 	my ($self, $n) = @_;
 1956: 	croak('plural_category: $n must be defined') unless defined $n;
 1957: 	my $code = $self->language_code_alpha2() // return 'other';
 1958: 	my $rule = $PLURAL_RULES{$code} // sub { int($_[0]) == 1 ? 'one' : 'other' };

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
NUM_BOUNDARY_1958_54_!=: Numeric boundary flip == to !=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
 1959: 	return $rule->($n);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1960: }
 1961: 
 1962: =head2 translation_file
 1963: 
 1964: Returns the filesystem path to the best matching translation file for the
 1965: negotiated language in the given directory.
 1966: 
 1967: The lookup tries (in order):
 1968: 
 1969: =over 4
 1970: 
 1971: =item 1. C<$dir/$lang-$sublang.$ext>  (e.g. C<en-gb.json>)
 1972: 
 1973: =item 2. C<$dir/$lang.$ext>           (e.g. C<en.json>)
 1974: 
 1975: =back
 1976: 
 1977: Returns C<undef> if no matching file exists.
 1978: 
 1979: =head3 API SPECIFICATION
 1980: 
 1981:     Input:
 1982:       $dir - Str   path to the directory containing translation files
 1983:       $ext - Str   file extension without leading dot (default: 'json')
 1984:     Returns: Str (absolute or relative path) | undef
 1985: 
 1986: =head3 EXAMPLE
 1987: 
 1988:     local $ENV{HTTP_ACCEPT_LANGUAGE} = 'en-gb';
 1989:     my $l = CGI::Lingua->new(supported => ['en-gb', 'en']);
 1990:     my $path = $l->translation_file('/var/www/i18n');
 1991:     # Returns '/var/www/i18n/en-gb.json' if it exists,
 1992:     # then '/var/www/i18n/en.json', or undef.
 1993: 
 1994:     # Custom extension:
 1995:     my $path = $l->translation_file('/var/www/i18n', 'po');
 1996: 
 1997: =head3 MESSAGES
 1998: 
 1999:     (none - returns undef silently when no file is found)
 2000: 
 2001: =cut
 2002: 
 2003: sub translation_file
 2004: {
●2005 → 2012 → 2017 2005: 	my ($self, $dir, $ext) = @_;
 2006: 	return unless defined $dir;
 2007: 
 2008: 	# Reject traversal attempts in the directory argument.  A real translation
 2009: 	# directory never needs '..', null bytes, or other shell metacharacters.
 2010: 	# The caller is responsible for not passing user-controlled data as $dir,
 2011: 	# but we guard here as a defence-in-depth measure.
 2012: 	if($dir =~ /\.\./ || $dir =~ /\x00/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2013: 		$self->_warn({ warning => "translation_file: unsafe directory '$dir' rejected" });
 2014: 		return;
 2015: 	}
 2016: 
●2017 → 2022 → 2027 2017: 	$ext //= 'json';
 2018: 	$ext =~ s/^\.//;    # accept '.json' or 'json'
 2019: 
 2020: 	# Reject extensions containing path-traversal sequences or shell metacharacters.
 2021: 	# Valid extensions are word characters and hyphens only (e.g. 'json', 'po', 'yml').
 2022: 	unless($ext =~ /^[A-Za-z0-9\-]+$/) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2023: 		$self->_warn({ warning => "translation_file: unsafe extension '$ext' rejected" });
 2024: 		return;
 2025: 	}
 2026: 
●2027 → 2028 → 2031 2027: 	my @candidates;
 2028: 	if(my $sub = $self->sublanguage_code_alpha2()) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2028_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2029: 		push @candidates, $self->language_code_alpha2() . '-' . $sub;
 2030: 	}
●2031 → 2034 → 2038 2031: 	push @candidates, $self->language_code_alpha2()
 2032: 		if defined $self->language_code_alpha2();
 2033: 
 2034: 	for my $code (@candidates) {
 2035: 		my $path = "$dir/$code.$ext";
 2036: 		return $path if -e $path;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2037: 	}
 2038: 	return;
 2039: }
 2040: 
 2041: # ── _code2language ────────────────────────────────────────────────────────
 2042: # Purpose:      Translate a 2-char language code to its English name, with
 2043: #               optional CHI caching.
 2044: # Entry:        $code — 2-char ISO 639-1 code; must be defined and non-empty.
 2045: # Exit:         Human-readable language name string, or undef.
 2046: # Side Effects: Reads/writes cache.
 2047: sub _code2language
 2048: {
●2049 → 2052 → 2058 2049: 	my ($self, $code) = @_;
 2050: 
 2051: 	return unless $code;
 2052: 	if(defined($self->{_country})) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2052_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2053: 		$self->_debug("_code2language $code, country ", $self->{_country});
 2054: 	} else {
 2055: 		$self->_debug("_code2language $code");
 2056: 	}
 2057: 
●2058 → 2058 → 2062 2058: 	unless($self->{_cache}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2059: 		return Locale::Language::code2language($code);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2060: 	}
 2061: 
●2062 → 2062 → 2069 2062: 	if(my $from_cache = $self->{_cache}->get($CACHE_NS . "code2language:$code")) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2063: 		$self->_trace("_code2language found in cache $from_cache");
 2064: 		return $from_cache;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2065: 	}
 2066: 
 2067: 	# Compute, cache, then return the value separately —
 2068: 	# CHI->set() is not guaranteed to return the stored value across all drivers
●2069 → 2071 → 2074 2069: 	$self->_trace('_code2language not in cache, storing');
 2070: 	my $name = Locale::Language::code2language($code);
 2071: 	if(defined $name) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2072: 		$self->{_cache}->set($CACHE_NS . "code2language:$code", $name, $CACHE_TTL_LONG);
 2073: 	}
 2074: 	return $name;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2075: }
 2076: 
 2077: # ── _code2country ─────────────────────────────────────────────────────────
 2078: # Purpose:      Translate a 2-char country code to a Locale::Object::Country
 2079: #               object, suppressing the expected "No result found" warning.
 2080: # Entry:        $code — 2-char ISO 3166-1 alpha-2 code (any case).
 2081: # Exit:         Locale::Object::Country object, or undef.
 2082: # Side Effects: None beyond the Locale::Object::Country look-up.
 2083: sub _code2country
 2084: {
●2085 → 2088 → 2094 2085: 	my ($self, $code) = @_;
 2086: 
 2087: 	return unless $code;
 2088: 	if($self->{_country}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_2088_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 2089: 		$self->_trace(">_code2country $code, country ", $self->{_country});
 2090: 	} else {
 2091: 		$self->_trace(">_code2country $code");
 2092: 	}
 2093: 
 2094: 	my $rc;
 2095: 	{
 2096: 		# Scope the signal handler tightly — only suppress the one known-harmless warning
 2097: 		local $SIG{__WARN__} = sub {
 2098: 			warn $_[0] unless $_[0] =~ /No result found in country table/;
 2099: 		};
 2100: 		$rc = Locale::Object::Country->new(code_alpha2 => $code);
 2101: 	}
 2102: 	$self->_trace('<_code2country ', $code || 'undef');
 2103: 	return $rc;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2104: }
 2105: 
 2106: # ── _code2countryname ─────────────────────────────────────────────────────
 2107: # Purpose:      Translate a 2-char country code to its English name string,
 2108: #               with optional CHI caching.
 2109: # Entry:        $code — 2-char ISO 3166-1 alpha-2 code.
 2110: # Exit:         Country name string, or undef.
 2111: # Side Effects: Reads/writes cache.
 2112: sub _code2countryname
 2113: {
●2114 → 2119 → 2124 2114: 	my ($self, $code) = @_;
 2115: 
 2116: 	return unless $code;
 2117: 	$self->_trace(">_code2countryname $code");
 2118: 
 2119: 	unless($self->{_cache}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2120: 		my $country = $self->_code2country($code);
 2121: 		return defined($country) ? $country->name : undef;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2122: 	}
 2123: 
●2124 → 2124 → 2129 2124: 	if(my $from_cache = $self->{_cache}->get($CACHE_NS . "code2countryname:$code")) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2125: 		$self->_trace("_code2countryname found in cache $from_cache");
 2126: 		return $from_cache;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2127: 	}
 2128: 
●2129 → 2129 → 2137 2129: 	if(my $country = $self->_code2country($code)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2130: 		$self->_debug('_code2countryname not in cache, storing');
 2131: 		my $name = $country->name();
 2132: 		$self->_trace('<_code2countryname ', $name);
 2133: 		# Store then return explicitly — don't rely on set() return value
 2134: 		$self->{_cache}->set($CACHE_NS . "code2countryname:$code", $name, $CACHE_TTL_LONG);
 2135: 		return $name;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 2136: 	}
 2137: 	$self->_trace('<_code2countryname undef');
 2138: 	return;
 2139: }
 2140: 
 2141: # ── _log ──────────────────────────────────────────────────────────────────
 2142: # Purpose:      Append a message to $self->{messages} and forward to the
 2143: #               optional logger object.
 2144: # Entry:        $level — log level string (debug/info/notice/warn/trace/error);
 2145: #               @messages — one or more strings to concatenate.
 2146: # Exit:         void
 2147: # Side Effects: Mutates $self->{messages}; calls logger method if set.
 2148: sub _log
 2149: {
●2150 → 2158 → 0 2150: 	my ($self, $level, @messages) = @_;
 2151: 
 2152: 	return unless ref($self) && scalar(@messages);
 2153: 
 2154: 	my $text = join('', grep defined, @messages);
 2155: 	return unless length($text);
 2156: 	push @{$self->{'messages'}}, { level => $level, message => $text };
 2157: 
 2158: 	if(my $logger = $self->{'logger'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2159: 		$logger->$level($text);
 2160: 	}
 2161: }
 2162: 
 2163: sub _debug  { my $self = shift; $self->_log('debug',  @_) }
 2164: sub _info   { my $self = shift; $self->_log('info',   @_) }
 2165: sub _notice { my $self = shift; $self->_log('notice', @_) }
 2166: sub _trace  { my $self = shift; $self->_log('trace',  @_) }
 2167: 
 2168: # ── _warn ─────────────────────────────────────────────────────────────────
 2169: # Purpose:      Emit a warning through the logger (if set) or via Carp::carp.
 2170: # Entry:        A single hashref argument: { warning => 'message text' }.
 2171: #               All callers MUST use this structured form — plain-string calls
 2172: #               silently lose the message when no logger is configured.
 2173: # Exit:         void
 2174: # Side Effects: Calls logger->warn() or carp().
 2175: sub _warn
 2176: {
●2177 → 2183 → 0 2177: 	my $self = shift;
 2178: 
 2179: 	# Parse once; both branches need the same $msg.
 2180: 	my $params = Params::Get::get_params('warning', @_);
 2181: 	my $msg    = (ref($params) ? $params->{'warning'} : undef) // join('', grep defined, @_);
 2182: 
 2183: 	if(defined($self->{'logger'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 2184: 		$self->{'logger'}->warn($msg);
 2185: 	} else {
 2186: 		$self->_log('warn', $msg);
 2187: 		carp($msg);
 2188: 	}
 2189: }
 2190: 
 2191: =head1 LIMITATIONS
 2192: 
 2193: =over 4
 2194: 
 2195: =item * B<is_rtl() covers primary-script RTL languages only>
 2196: 
 2197: C<is_rtl()> returns true for the 10 ISO 639-1 codes whose overwhelmingly
 2198: dominant script is right-to-left.  Languages with script variants (e.g.
 2199: Azerbaijani C<az>, which uses Latin in modern Azerbaijan but Arabic in Iran)
 2200: are treated as LTR.  If you serve content in multiple scripts of the same
 2201: language, inspect the sublanguage or Accept-Language header directly.
 2202: 
 2203: =item * B<plural_category() uses embedded CLDR rules, not Locale::CLDR>
 2204: 
 2205: The embedded rules cover ~70 languages and truncate fractional C<$n> to an
 2206: integer.  For full CLDR v42 accuracy (including fractional forms and
 2207: languages not in the table) install and use C<Locale::CLDR> directly.
 2208: 
 2209: =item * B<Logger must be a blessed object>
 2210: 
 2211: The C<logger> parameter is documented as accepting a code ref, array ref, or
 2212: filename, but the current implementation calls C<< $logger->$level() >> and will
 2213: die on non-blessed values.  Wrap alternative logger types in a
 2214: C<Log::Abstraction> instance before passing them to C<new()>.
 2215: 
 2216: =item * B<es-419 sublanguage returns undef>
 2217: 
 2218: Three-part regional codes such as C<es-419> (Latin American Spanish) do not
 2219: resolve to a C<sublanguage()> value because ISO 3166-1 does not define '419'.
 2220: This is a known limitation of the Locale::Object layer.
 2221: 
 2222: =item * B<Whois lookups are slow and unreliable>
 2223: 
 2224: Without C<IP::Country>, C<Geo::IP>, or C<Geo::IPfree> installed, C<country()>
 2225: falls back to Whois queries against live RIPE/ARIN/IANA servers.  These can
 2226: time out under load.  Install at least one local geo-database module and enable
 2227: the CHI cache to avoid this.
 2228: 
 2229: =item * B<Private methods are accessible from outside the package>
 2230: 
 2231: The C<_*> methods use the naming convention for privacy but Perl does not enforce
 2232: it.  C<Sub::Private> or C<Sub::Protected> should be added once all white-box
 2233: tests (C<t/function.t>, C<t/extended_tests.t>) are updated to use the public API
 2234: exclusively.
 2235: 
 2236: =item * B<IPv4-mapped IPv6 addresses are normalised to IPv4>
 2237: 
 2238: C<REMOTE_ADDR> values in the form C<::ffff:a.b.c.d> (RFC 4291 section 2.5.5)
 2239: are silently rewritten to the embedded C<a.b.c.d> IPv4 address before any
 2240: geo-lookup.  This is correct for country detection purposes but means the raw
 2241: address string is not preserved in cache keys or log messages.
 2242: 
 2243: =item * B<EU country code is irresolvable (with one exception)>
 2244: 
 2245: IP addresses that Whois reports as country C<EU> are mapped to C<'Unknown'>
 2246: unless they fall within Baidu's known subnet (RT-86809).  There is no ISO
 2247: 3166-1 country code for the European Union.
 2248: 
 2249: =item * B<country() does not cache undef results>
 2250: 
 2251: When C<country()> cannot determine a country (private IPs, loopback,
 2252: unresolvable addresses), it returns C<undef> without storing the result.  A
 2253: second call on the same object repeats the full validation pipeline.  This is
 2254: intentional: C<country()> reads C<REMOTE_ADDR> at call time rather than at
 2255: construction time, so caching C<undef> would return a wrong answer if
 2256: C<REMOTE_ADDR> changes between calls.  In practice this is rarely a problem
 2257: because C<country()> is called once per request and CGI applications typically
 2258: create a fresh object per request.
 2259: 
 2260: =back
 2261: 
 2262: =head1 AUTHOR
 2263: 
 2264: Nigel Horne, C<< <njh at nigelhorne.com> >>
 2265: 
 2266: =head1 BUGS
 2267: 
 2268: Please report any bugs or feature requests to the author.
 2269: 
 2270: If C<HTTP_ACCEPT_LANGUAGE> contains a sub-tag with a 3-digit UN M.49 region
 2271: code (e.g. C<es-419> for Latin American Spanish), C<sublanguage()> returns
 2272: C<undef> because ISO 3166-1 does not define numeric codes.
 2273: 
 2274: Please report any bugs or feature requests to C<bug-cgi-lingua at rt.cpan.org>,
 2275: or through the web interface at
 2276: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Lingua>.
 2277: I will be notified, and then you'll
 2278: automatically be notified of progress on your bug as I make changes.
 2279: 
 2280: Uses L<I18N::AcceptLanguage> to find the highest priority accepted language.
 2281: This means that if you support languages at a lower priority, it may be missed.
 2282: 
 2283: =head1 SEE ALSO
 2284: 
 2285: =over 4
 2286: 
 2287: =item * L<Configure an Object at Runtime|Object::Configure>
 2288: 
 2289: =item * L<Test Dashboard|https://nigelhorne.github.io/CGI-Lingua/coverage/>
 2290: 
 2291: =item * VWF - Versatile Web Framework L<https://github.com/nigelhorne/vwf>
 2292: 
 2293: =item * L<HTTP::BrowserDetect>
 2294: 
 2295: =item * L<I18N::AcceptLanguage>
 2296: 
 2297: =item * L<Locale::Country>
 2298: 
 2299: =back
 2300: 
 2301: =head1 SUPPORT
 2302: 
 2303: This module is provided as-is without any warranty.
 2304: 
 2305: You can find documentation for this module with the perldoc command.
 2306: 
 2307:     perldoc CGI::Lingua
 2308: 
 2309: You can also look for information at:
 2310: 
 2311: =over 4
 2312: 
 2313: =item * MetaCPAN
 2314: 
 2315: L<https://metacpan.org/release/CGI-Lingua>
 2316: 
 2317: =item * RT: CPAN's request tracker
 2318: 
 2319: L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=CGI-Lingua>
 2320: 
 2321: =item * CPANTS
 2322: 
 2323: L<http://cpants.cpanauthors.org/dist/CGI-Lingua>
 2324: 
 2325: =item * CPAN Testers' Matrix
 2326: 
 2327: L<http://matrix.cpantesters.org/?dist=CGI-Lingua>
 2328: 
 2329: =item * CPAN Testers Dependencies
 2330: 
 2331: L<http://deps.cpantesters.org/?module=CGI::Lingua>
 2332: 
 2333: =back
 2334: 
 2335: =encoding utf-8
 2336: 
 2337: =head1 FORMAL SPECIFICATION
 2338: 
 2339: =head2 new
 2340: 
 2341:     new : Class × Params → CGI::Lingua
 2342:     ∀ p : Params • p.supported ≠ ∅ ⟹ result.language ∈ (p.supported ∪ {'Unknown'})
 2343: 
 2344: =head2 language
 2345: 
 2346:     language : CGI::Lingua → Str
 2347:     result ∈ {name(l) | l ∈ supported} ∪ {'Unknown'}
 2348: 
 2349: =head2 sublanguage
 2350: 
 2351:     sublanguage : CGI::Lingua -> Str | undef
 2352:     result = country_name(sublanguage_code_alpha2(self))
 2353:              when sublanguage_code_alpha2(self) is defined,
 2354:              undef otherwise
 2355: 
 2356: =head2 language_code_alpha2
 2357: 
 2358:     language_code_alpha2 : CGI::Lingua -> Str(2) | undef
 2359:     result = base_code(matched_supported_entry)
 2360:              when a supported language was matched, undef otherwise
 2361: 
 2362: =head2 sublanguage_code_alpha2
 2363: 
 2364:     sublanguage_code_alpha2 : CGI::Lingua -> Str(2) | undef
 2365:     result = variety_code(matched_supported_entry) | undef
 2366: 
 2367: =head2 requested_language
 2368: 
 2369:     requested_language : CGI::Lingua -> Str
 2370:     result = name(base) + " (" + name(variety) + ")"
 2371:              when variety is known,
 2372:            = name(base)   when no variety,
 2373:            = 'Unknown'    when no language detected
 2374: 
 2375: =head2 country
 2376: 
 2377:     country : CGI::Lingua -> Str(2,lowercase) | undef
 2378:     -- 'Unknown' returned only in the EU/Baidu special case
 2379:     result = lc(code) where code satisfies ISO 3166-1 alpha-2
 2380:              | undef when IP is private, loopback, or unresolvable
 2381: 
 2382: =head2 locale
 2383: 
 2384:     locale : CGI::Lingua -> Locale::Object::Country | undef
 2385:     -- Best-guess detection; not guaranteed accurate.
 2386:     result = first defined value from:
 2387:         1. UA parenthetical language tag
 2388:         2. HTTP::BrowserDetect country
 2389:         3. country() IP lookup
 2390:         4. GEOIP_COUNTRY_CODE env var
 2391: 
 2392: =head2 time_zone
 2393: 
 2394:     time_zone : CGI::Lingua -> Str | undef
 2395:     result is an IANA timezone name (e.g. 'Europe/London') or undef
 2396: 
 2397: =head2 is_rtl
 2398: 
 2399:     is_rtl : CGI::Lingua → Bool
 2400:     is_rtl(s) ≙ language_code_alpha2(s) ∈ RTL_LANGS
 2401: 
 2402: =head2 text_direction
 2403: 
 2404:     text_direction : CGI::Lingua → {'rtl', 'ltr'}
 2405:     text_direction(s) ≙ is_rtl(s) ? 'rtl' : 'ltr'
 2406: 
 2407: =head2 plural_category
 2408: 
 2409:     plural_category : CGI::Lingua x N -> PluralCategory
 2410:     plural_category(s, n) = PLURAL_RULES[language_code_alpha2(s)](trunc(n))
 2411:     -- Falls back to English rule (n=1 -> 'one'; else 'other')
 2412:     -- when language_code_alpha2(s) is undef or not in the rules table.
 2413: 
 2414: =head2 translation_file
 2415: 
 2416:     translation_file : CGI::Lingua × Path × Ext → Path | undef
 2417:     translation_file(s, d, e) ≙
 2418:       first p ∈ candidates(s) • ∃ file d/p.e
 2419:       where candidates(s) = [lang(s)-sublang(s), lang(s)] \ {undef}
 2420: 
 2421: =head1 ACKNOWLEDGEMENTS
 2422: 
 2423: =head1 LICENSE AND COPYRIGHT
 2424: 
 2425: Copyright 2010-2026 Nigel Horne.
 2426: 
 2427: Usage is subject to the GPL2 licence terms.
 2428: If you use it,
 2429: please let me know.
 2430: 
 2431: =cut
 2432: 
 2433: 1; # End of CGI::Lingua