view release on metacpan or  search on metacpan

t/locales.t  view on Meta::CPAN

	is(denied_at($acl, $config{IP_DE}, lingua => lingua_for($config{IP_DE})), 1, 'DE denied on Mandarin-only site');
};

# ── Locale scenario: European multilingual site ───────────────────────────────
# Purpose: allow clients from GB, FR, and DE; deny US and CN
subtest 'European multilingual site: allow GB+FR+DE, deny US+CN' => sub {
	my $acl = CGI::ACL->new()
		->deny_country($config{WILDCARD})
		->allow_country($config{CC_GB})
		->allow_country($config{CC_FR})
		->allow_country($config{CC_DE});

	diag "EU site: allow_countries=" . join(',', sort keys %{$acl->{allow_countries}}) if $ENV{TEST_VERBOSE};

	# European clients must be allowed
	is(denied_at($acl, $config{IP_GB}, lingua => lingua_for($config{IP_GB})), 0, 'GB allowed on EU site');
	is(denied_at($acl, $config{IP_FR}, lingua => lingua_for($config{IP_FR})), 0, 'FR allowed on EU site');
	is(denied_at($acl, $config{IP_DE}, lingua => lingua_for($config{IP_DE})), 0, 'DE allowed on EU site');

	# Non-European clients must be denied
	is(denied_at($acl, $config{IP_US}, lingua => lingua_for($config{IP_US})), 1, 'US denied on EU site');
	is(denied_at($acl, $config{IP_CN}, lingua => lingua_for($config{IP_CN})), 1, 'CN denied on EU site');
};

# ── Locale scenario: globally-available multilingual site ────────────────────
# Purpose: allow all four language regions; only deny would come from deny_country
subtest 'Multilingual site: all four locales allowed' => sub {
	# Deny all by default, then explicitly permit the four target regions
	my $acl = CGI::ACL->new()
		->deny_country($config{WILDCARD})
		->allow_country($config{CC_GB})
		->allow_country($config{CC_US})
		->allow_country($config{CC_FR})
		->allow_country($config{CC_DE})
		->allow_country($config{CC_CN});

	diag "Multilingual: allow_countries=" . join(',', sort keys %{$acl->{allow_countries}}) if $ENV{TEST_VERBOSE};

	# All four language regions must be allowed
	is(denied_at($acl, $config{IP_GB}, lingua => lingua_for($config{IP_GB})), 0, 'GB allowed on multilingual site');
	is(denied_at($acl, $config{IP_US}, lingua => lingua_for($config{IP_US})), 0, 'US allowed on multilingual site');
	is(denied_at($acl, $config{IP_FR}, lingua => lingua_for($config{IP_FR})), 0, 'FR allowed on multilingual site');
	is(denied_at($acl, $config{IP_DE}, lingua => lingua_for($config{IP_DE})), 0, 'DE allowed on multilingual site');
	is(denied_at($acl, $config{IP_CN}, lingua => lingua_for($config{IP_CN})), 0, 'CN allowed on multilingual site');

	# Russian IP (not in the permit list) must still be denied
	is(denied_at($acl, '87.226.159.0', lingua => lingua_for('87.226.159.0')),
		1, 'RU denied on multilingual site (not in permit list)');
};

# ── Locale scenario: explicit deny by language region ───────────────────────
# Purpose: test deny-listing specific countries without wildcard (default-allow)
subtest 'Explicit deny: block FR and CN, allow others by default' => sub {
	# Default-allow mode: deny only the listed countries
	my $acl = CGI::ACL->new()
		->deny_country($config{CC_FR})
		->deny_country($config{CC_CN});

	diag "Explicit deny: deny_countries=" . join(',', sort keys %{$acl->{deny_countries}}) if $ENV{TEST_VERBOSE};

	# Denied countries must be blocked
	is(denied_at($acl, $config{IP_FR}, lingua => lingua_for($config{IP_FR})), 1, 'FR denied (explicit deny list)');
	is(denied_at($acl, $config{IP_CN}, lingua => lingua_for($config{IP_CN})), 1, 'CN denied (explicit deny list)');

	# All other countries must be allowed (default-allow)
	is(denied_at($acl, $config{IP_GB}, lingua => lingua_for($config{IP_GB})), 0, 'GB allowed (default-allow, not in deny list)');
	is(denied_at($acl, $config{IP_US}, lingua => lingua_for($config{IP_US})), 0, 'US allowed (default-allow, not in deny list)');
	is(denied_at($acl, $config{IP_DE}, lingua => lingua_for($config{IP_DE})), 0, 'DE allowed (default-allow, not in deny list)');
};

# ── Locale scenario: arrayref country list ───────────────────────────────────
# Purpose: verify that passing multiple countries as an arrayref works correctly
subtest 'Arrayref country list: deny FR+CN in single call' => sub {
	# Pass both denied countries as an arrayref in one call
	my $acl = CGI::ACL->new()
		->deny_country(country => [$config{CC_FR}, $config{CC_CN}]);

	diag "Arrayref deny: deny_countries=" . join(',', sort keys %{$acl->{deny_countries}}) if $ENV{TEST_VERBOSE};

	# Both countries in the arrayref must be denied
	is(denied_at($acl, $config{IP_FR}, lingua => lingua_for($config{IP_FR})), 1, 'FR denied via arrayref');
	is(denied_at($acl, $config{IP_CN}, lingua => lingua_for($config{IP_CN})), 1, 'CN denied via arrayref');

	# Countries not in the arrayref must be allowed
	is(denied_at($acl, $config{IP_GB}, lingua => lingua_for($config{IP_GB})), 0, 'GB allowed (not in arrayref)');
	is(denied_at($acl, $config{IP_DE}, lingua => lingua_for($config{IP_DE})), 0, 'DE allowed (not in arrayref)');
};

# ── Locale scenario: case-insensitive country codes ──────────────────────────
# Purpose: verify that country codes are matched case-insensitively
subtest 'Case-insensitive country codes: upper and mixed case are accepted' => sub {
	# Use uppercase country codes in the ACL (should be normalised to lowercase)
	my $acl = CGI::ACL->new()
		->deny_country($config{WILDCARD})
		->allow_country('GB')    # uppercase
		->allow_country('Fr')    # mixed case
		->allow_country('DE');   # uppercase

	diag "Case insensitive: allow_countries=" . join(',', sort keys %{$acl->{allow_countries}}) if $ENV{TEST_VERBOSE};

	# CGI::Lingua returns lowercase; the ACL normalises codes so case must not matter
	is(denied_at($acl, $config{IP_GB}, lingua => lingua_for($config{IP_GB})), 0, 'GB (uppercase in ACL) matched case-insensitively');
	is(denied_at($acl, $config{IP_FR}, lingua => lingua_for($config{IP_FR})), 0, 'FR (mixed case in ACL) matched case-insensitively');
	is(denied_at($acl, $config{IP_DE}, lingua => lingua_for($config{IP_DE})), 0, 'DE (uppercase in ACL) matched case-insensitively');

	# Countries not in the allow list must still be denied
	is(denied_at($acl, $config{IP_US}, lingua => lingua_for($config{IP_US})), 1, 'US denied (not in allow list)');
	is(denied_at($acl, $config{IP_CN}, lingua => lingua_for($config{IP_CN})), 1, 'CN denied (not in allow list)');
};

# ── Locale scenario: concurrent locale-specific ACLs ─────────────────────────
# Purpose: two ACL objects for different regions must not interfere with each other
subtest 'Concurrent locale ACLs: French site and German site are independent' => sub {
	# ACL A: French-only
	my $acl_fr = CGI::ACL->new()
		->deny_country($config{WILDCARD})
		->allow_country($config{CC_FR});

	# ACL B: German-only (created separately, must not share state with ACL A)
	my $acl_de = CGI::ACL->new()
		->deny_country($config{WILDCARD})