view release on metacpan or  search on metacpan

t/40-more.t  view on Meta::CPAN

		allow => {
			even => sub {
				my ($key, $value, $info_obj) = @_;
				return $value % 2 == 0;
			},
			odd => sub {
				my ($key, $value, $info_obj) = @_;
				return $value % 2 == 0;  # Should fail for odd numbers
			},
			negative => sub {
				my ($key, $value, $info_obj) = @_;
				return $value >= 0;  # Should fail for negative
			}
		}
	);

	is($params->{even}, '4', 'Custom validation passed for even number');
	ok(!exists($params->{odd}), 'Custom validation failed for odd number');
	ok(!exists($params->{negative}), 'Custom validation failed for negative');
};

# Test Params::Validate::Strict integration
subtest 'Strict validation rules' => sub {
	test_needs 'Params::Validate::Strict';

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

	local @ARGV = ('age=25', 'invalid_age=200');

	my $params = $info->params(
		allow => {
			age => {
				type => 'integer',
				min => 0,
				max => 150
			},
			invalid_age => {
				type => 'integer',
				min => 0,
				max => 150
			}
		}
	);

	is($params->{age}, 25, 'Strict validation passed for valid age');
	ok(!exists($params->{invalid_age}), 'Strict validation failed for invalid age');
	ok(scalar(grep { $_->{message} =~ /invalid_age/ } @{$info->messages() // []}), 'Message logged for invalid parameter');
};

# Test security features - SQL injection detection
subtest 'SQL injection detection' => sub {
	setup_mock_env(
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'GET',
		QUERY_STRING => "search=' OR 1=1--"
	);

	my $info = new_ok('CGI::Info');
	my $params = $info->params();

	is($info->{status}, 403, 'SQL injection blocked with 403 status');
	ok(!defined($params), 'No parameters returned for SQL injection');

	restore_env();
};

# Test XSS injection detection
subtest 'XSS injection detection' => sub {
	setup_mock_env(
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'GET',
		QUERY_STRING => 'comment=<script>alert("xss")</script>'
	);

	# Mock STDIN data so that we don't hang on reading
	$CGI::Info::stdin_data = 'username=test&password=secret';

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

	is($info->{status}, 403, 'XSS injection blocked');
	ok(!defined($params), 'No parameters returned for XSS injection');

	restore_env();
	$CGI::Info::stdin_data = undef;
};

# Test directory traversal detection
subtest 'Directory traversal detection' => sub {
	setup_mock_env(
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'GET',
		QUERY_STRING => 'file=../../../etc/passwd'
	);

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

	is($info->{status}, 403, 'Directory traversal blocked');
	ok(!defined($params), 'No parameters returned for directory traversal');

	restore_env();
};

# Test User-Agent SQL injection detection
subtest 'User-Agent SQL injection detection' => sub {
	setup_mock_env(
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'GET',
		QUERY_STRING => 'q=test',
		HTTP_USER_AGENT => "Mozilla' AND 1=1 ORDER BY 1--"
	);

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

	is($info->{status}, 403, 'User-Agent SQL injection blocked');
	ok(!defined($params), 'No parameters returned for malicious User-Agent');

	restore_env();
};

# Test file upload validation
subtest 'File upload validation' => sub {
	my $temp_dir = tempdir(CLEANUP => 1);

	setup_mock_env(
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'POST',
		CONTENT_TYPE => 'multipart/form-data; boundary=test123',
		CONTENT_LENGTH => '100'
	);

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

	# Test without upload_dir
	$CGI::Info::stdin_data = '{}';
	my $params = $info->params();
	ok(!defined($params), 'Upload rejected without upload_dir');

	# Test with invalid upload_dir
	$params = $info->params(upload_dir => '/invalid/path');
	is($info->{status}, 500, 'Invalid upload directory rejected');

	# Test with valid upload_dir in temp area
	$params = $info->params(upload_dir => $temp_dir);
	# Should pass validation (actual multipart parsing would need more setup)

	restore_env();
	$CGI::Info::stdin_data = undef;
};

# Test parameter caching
subtest 'Parameter caching' => sub {
	delete $ENV{'GATEWAY_INTERFACE'};
	delete $ENV{'REQUEST_METHOD'};
	delete $ENV{'QUERY_STRING'};
	my $info = CGI::Info->new();

	local @ARGV = ('cached=value');

	my $params1 = $info->params();
	my $params2 = $info->params();

	is($params1, $params2, 'Parameters are cached on repeat calls');
	is($params1->{cached}, 'value', 'Cached parameters retain values');
};

# Test param() method
subtest 'param() method' => sub {
	my $info = CGI::Info->new();

	local @ARGV = ('name=John', 'age=30');

	is($info->param('name'), 'John', 'Single parameter retrieval');
	is($info->param('age'), '30', 'Numeric parameter as string');
	is($info->param('missing'), undef, 'Missing parameter returns undef');