CGI-Info

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

	- Set status to 501 when attempting to upload to a place that doesn't take uploads
	- Log the invalid method type
	- Clone path now validates logger and croaks on deprecated expect argument, matching the normal construction path
	- Clone path deletes cached paramref so a new allow schema is applied on the first params() call
	- Upgrade t/40-more.t from Test::MockModule to Test::Mockingbird; fix three pre-existing test bugs now exposed
	- Add use autodie qw(:all) and Readonly constants ($MAX_UPLOAD_SIZE_DEFAULT, $CACHE_TTL_ROBOT, $CACHE_TTL_SEARCH) to eliminate magic numbers
	- Fix UNIVERSAL::isa() deprecation warning in _find_paths(): replaced with proper ->isa() call
	- Remove dead commented-out expect and interactive debug blocks from params()
	- Fix reversed referrer logic in is_robot(): now correctly checks if the HTTP_REFERER starts with a known crawler URL
	- Add API SPECIFICATION, MESSAGES and FORMAL SPECIFICATION sections to param() POD
	- Add t/locales.t: tests system-locale (POSIX LC_ALL) error-path invariance under en_US.UTF-8, de_DE.UTF-8, and zh_CN.UTF-8; geographic GeoIP subtests skipped unless IP::Country::Fast is installed
	- Rewrite t/function.t: Test::Most, Test::Returns, Test::Memory::Cycle, Readonly constants, white-box tests for _log/_warn/_error/_get_env/_create_file_name/_untaint_filename, $_ clobbering tests
	- Use Sub::Protected
	- Remove subroutine prototype from _sanitise_input forward declaration and definition
	- Replace explicit return undef with return in _get_env
	- Rename FIXME in _log to a Note
	- Fix spelling of overridden in POD comments
	- Add Readonly to PREREQ_PM in Makefile.PL
	- Refactor bin/info.pl to use cookie() instead of deprecated get_cookie() and improve cookie parsing split regex

	[ Bug fixes]

MANIFEST  view on Meta::CPAN

t/gv.t
t/integration.t
t/is_ai.t
t/is_mobile.t
t/is_robot.t
t/is_search.t
t/is_tablet.t
t/json.t
t/kwalitee.t
t/lib/MyLogger.pm
t/locales.t
t/logdir.t
t/logger.t
t/manifest.t
t/metrics.t
t/minimum.t
t/modules-used.t
t/namespaces.t
t/no404s.t
t/noopentickets.t
t/noplan.t

azure-pipelines.yml  view on Meta::CPAN

    parameters:
      debug: true

  - template: templates/helpers/linux.yml@ci-perl-helpers
    parameters:
      coverage: codecov
      debug: true
      test_xt: true
      use_default_perls: true
      apt:
        - locales
      pre_test_steps:
        # This is needed for the spelling test to pass. If run with LANG=C
        # (the default absent an explicit setting), the test seems to read the
        # <DATA> handle or the pod files incorrectly.
        - bash: |
            sudo locale-gen en_US.UTF-8
            echo "##vso[task.setvariable variable=LANG]en_US.UTF-8"
            echo "##vso[task.setvariable variable=LANGUAGE]en"
            echo "##vso[task.setvariable variable=LC_ALL]en_US.UTF-8"
          displayName: Set locale env vars

  - template: templates/helpers/macos.yml@ci-perl-helpers
    parameters:
      debug: true
      use_default_perls: true

  - template: templates/helpers/windows.yml@ci-perl-helpers
    parameters:
      debug: true
      use_default_perls: true

t/locales.t  view on Meta::CPAN

#!/usr/bin/env perl

# Test CGI::Info behaviour under different system locales (POSIX LC_ALL) and,
# if IP::Country::Fast is available, under geographic locale (GeoIP).
#
# Two dimensions of "locale" are covered:
#   1. System locale  - POSIX LC_ALL / LANG settings
#   2. Geographic locale - GeoIP country-code detection (optional)

use strict;
use warnings;

use Test::Most;
use Test::Needs;
use Errno qw(ENOENT);
use POSIX qw(locale_h);

BEGIN { use_ok('CGI::Info') or BAIL_OUT('CGI::Info failed to load') }

# ---------------------------------------------------------------------------
# Helpers
# ---------------------------------------------------------------------------

# Return the OS error string for ENOENT under the caller's current locale.
# Using $! (not POSIX::strerror) so we get the same string Perl embeds in
# thrown exceptions.
sub enoent_string {
	local $! = ENOENT;
	return "$!";
}

# Run $code with LC_ALL set to $locale; restore afterwards.
sub with_locale (&$) {
	my ($code, $locale) = @_;
	local $ENV{LC_ALL}   = $locale;
	local $ENV{LANG} = $locale;
	# setlocale so that $! is also translated
	my $old = POSIX::setlocale(LC_ALL);
	POSIX::setlocale(LC_ALL, $locale);
	my @rv = eval { $code->() };
	my $err = $@;
	POSIX::setlocale(LC_ALL, $old);
	die $err if $err;
	return wantarray ? @rv : $rv[0];
}

# ---------------------------------------------------------------------------
# 1. System-locale subtests
#    Every error path in CGI::Info that produces a die/croak with an OS
#    error string must be exercised under several LC_ALL values.
# ---------------------------------------------------------------------------

my @LOCALES = ('en_US.UTF-8', 'de_DE.UTF-8', 'zh_CN.UTF-8');

# Filter to only locales actually installed on this system.
my @available_locales;
for my $loc (@LOCALES) {
	my $old = POSIX::setlocale(LC_ALL);
	my $result = POSIX::setlocale(LC_ALL, $loc);
	POSIX::setlocale(LC_ALL, $old);
	push @available_locales, $loc if defined $result;
}

subtest 'System locale - invalid logdir croak' => sub {
	plan skip_all => 'no POSIX locales available on this system'
		unless @available_locales;
	plan tests => scalar(@available_locales) * 2;

	for my $locale (@available_locales) {
		my $nonexistent = '/nonexistent/path/' . $$;

		my ($croaked, $msg);
		with_locale {
			eval {
				local $ENV{GATEWAY_INTERFACE} = undef;
				my $info = CGI::Info->new();
				$info->logdir($nonexistent);
			};
			$croaked = $@ // '';
			$msg = enoent_string();
		} $locale;

		ok(length($croaked), "logdir croak fires under $locale");
		like($croaked, qr/Invalid logdir/, "logdir croak message under $locale");
	}
};

subtest 'System locale - cookie croak with no name' => sub {
	plan skip_all => 'no POSIX locales available on this system'
		unless @available_locales;
	plan tests => scalar(@available_locales) * 2;

	for my $locale (@available_locales) {
		my $croaked;
		with_locale {
			eval {
				local $ENV{GATEWAY_INTERFACE} = undef;
				local $ENV{HTTP_COOKIE}       = 'foo=bar';
				my $info = CGI::Info->new();
				$info->cookie();   # no name arg => croak from Params::Get
			};
			$croaked = $@ // '';
		} $locale;

		ok(length($croaked), "cookie() croak fires under $locale");
		# Params::Get enforces the cookie_name argument before CGI::Info's own
		# guard; match on the generated Usage message which names the parameter.
		like($croaked, qr/cookie_name/i, "cookie croak names the missing arg under $locale");
	}
};

subtest 'System locale - param() allow-list warning is locale-independent' => sub {
	plan skip_all => 'no POSIX locales available on this system'
		unless @available_locales;
	plan tests => scalar(@available_locales) * 2;

	for my $locale (@available_locales) {
		with_locale {
			local $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
			local $ENV{REQUEST_METHOD}    = 'GET';
			local $ENV{QUERY_STRING}      = 'foo=1&bar=2';
			my $info   = CGI::Info->new();
			my $allowed = { foo => qr/\d+/ };
			$info->params(allow => $allowed);
			my $val = $info->param('bar');   # not in allow list

			is($val, undef, "forbidden param returns undef under $locale");
			my @warns = grep { $_->{message} =~ /isn.t in the allow list/ }
				@{ $info->messages() // [] };
			ok(scalar(@warns), "allow-list warning recorded under $locale");
		} $locale;
	}
};

subtest 'System locale - expect deprecation croak is locale-independent' => sub {
	plan skip_all => 'no POSIX locales available on this system'
		unless @available_locales;
	plan tests => scalar(@available_locales) * 2;

	for my $locale (@available_locales) {
		my $croaked;
		with_locale {
			eval {
				local $ENV{GATEWAY_INTERFACE} = undef;
				CGI::Info->new(expect => [qw(foo)]);
			};
			$croaked = $@ // '';
		} $locale;

		ok(length($croaked), "expect deprecation croak fires under $locale");
		like($croaked, qr/deprecated/, "expect croak message under $locale");
	}
};

# ---------------------------------------------------------------------------
# 2. Geographic locale subtests (require IP::Country::Fast)
# ---------------------------------------------------------------------------

subtest 'Geographic locale - GeoIP country detection' => sub {
	Test::Needs->import('IP::Country::Fast');

	# Known IP -> country mappings.  BAIL_OUT on any mismatch to expose GeoIP
	# database drift fast and obviously.
	# This can happen because of sites using vPOP e.g. cloudflare
	my %ip_to_country = (
		'212.58.244.22'  => 'GB',   # BBC (UK)
		'8.8.8.8'        => 'US',   # Google DNS (US)
		'212.27.60.19' => 'FR',   # free.fr (France)
		'195.243.1.1' => 'DE',	# Deutsche Telekom (Germany)



( run in 0.936 second using v1.01-cache-2.11-cpan-a5162978ef8 )