view release on metacpan or  search on metacpan

t/30-basics.t  view on Meta::CPAN

			is $info->{max_upload_size}, 100, 'Config file loaded correctly';
			unlink $config_file;
		};

		# Expect is deprecated
		# subtest 'should reject non-ARRAY expect parameter' => sub {
			# throws_ok { CGI::Info->new(expect => {}) } qr/expect must be a reference/, 'Rejects non-array expect';
		# };
		subtest 'expect has been deprecated' => sub {
			throws_ok { CGI::Info->new(expect => {}) } qr/expect has been deprecated/, 'Rejects non-array expect';
		};
	};

	subtest 'script_name, script_path, script_dir' => sub {
		subtest 'should handle CLI environment' => sub {
			mock_env({}, sub {
				my $info = CGI::Info->new();
				like $info->script_name, qr/\w+\.t/, "Script name from \$0 in CLI";
				ok -e $info->script_path, 'Script path exists';
				ok -d $info->script_dir, 'Script directory exists';
			});
		};

		subtest 'should handle CGI environment' => sub {
			mock_env({ SCRIPT_NAME => '/cgi-bin/test.cgi', DOCUMENT_ROOT => '/var/www' }, sub {
				my $info = CGI::Info->new();
				is($info->script_name(), 'test.cgi', 'Correct script name from SCRIPT_NAME');
				if($^O eq 'MSWin32') {
					like($info->script_path(), qr/\\var\\www\\cgi-bin\\test\.cgi/, 'Script path constructed correctly');
				} else {
					# http://www.cpantesters.org/cpan/report/00f6f172-6d25-1014-9d67-b345cf55203a
					like($info->script_path(), qr/\/var\/www\/cgi-bin\/test\.cgi/, 'Script path constructed correctly');
				}
			});
		};
	};

	subtest 'params method' => sub {
		subtest 'should handle GET requests' => sub {
			mock_env({
		GATEWAY_INTERFACE => 'CGI/1.1',
				REQUEST_METHOD => 'GET',
				QUERY_STRING => 'name=John&age=30'
			}, sub {
				my $info = CGI::Info->new();
				my $params = $info->params();
				is $params->{name}, 'John', "GET param 'name' correct";
				is $params->{age}, '30', "GET param 'age' correct";
			});
		};

		subtest 'should block SQL injection attempts' => sub {
			mock_env({
				GATEWAY_INTERFACE => 'CGI/1.1',
				REQUEST_METHOD => 'GET',
				QUERY_STRING => 'id=1%27%20OR%201=1--'
			}, sub {
				my $info = CGI::Info->new(allow => { id => qr/^\d+$/ });
				my $params = $info->params();
				is $info->status, 422, 'Status 422 on SQL injection';
				ok !defined $params->{id}, 'Blocked malicious parameter';
			});
		};

		subtest 'should handle multipart form uploads' => sub {
			mock_env({
				GATEWAY_INTERFACE => 'CGI/1.1',
				REQUEST_METHOD => 'POST',
				CONTENT_TYPE	=> 'multipart/form-data; boundary=----boundary',
				CONTENT_LENGTH => 1000
			}, sub {
				local *STDIN;
				open STDIN, '<', \"------boundary\nContent-Disposition: form-data; name=\"file\"; filename=\"test.txt\"\n\ncontent\n------boundary--";
				my $info = CGI::Info->new(upload_dir => File::Spec->tmpdir());
				my $params = $info->params();
				like($params->{file}, qr/test\.txt/, 'File upload handled');
				unlink $params->{'file'}
			});
		};

		subtest 'should reject oversized uploads' => sub {
			mock_env({
				GATEWAY_INTERFACE => 'CGI/1.1',
				REQUEST_METHOD => 'POST',
				CONTENT_TYPE => 'application/x-www-form-urlencoded',
				CONTENT_LENGTH => 600 * 1024	# 600KB
			}, sub {
				my $info = CGI::Info->new(max_upload => 500);	# 500KB limit
				my $params = $info->params;
				is $info->status, 413, 'Status 413 on oversized upload';
				ok !defined $params, 'No params returned';
			});
		};
	};

	subtest 'Security Checks' => sub {
		subtest 'should block XSS attempts' => sub {
			mock_env({
				GATEWAY_INTERFACE => 'CGI/1.1',
				REQUEST_METHOD => 'GET',
				QUERY_STRING => 'comment=<script>alert(1)</script>'
			}, sub {
				my $info = CGI::Info->new();
				my $params = $info->params;
				unlike $params->{comment}, qr/<script>/, 'XSS attempt sanitized';
			});
		};

		subtest 'should prevent directory traversal' => sub {
			mock_env({
				GATEWAY_INTERFACE => 'CGI/1.1',
				REQUEST_METHOD => 'GET',
				QUERY_STRING => 'file=../../etc/passwd'
			}, sub {
				my $info = new_ok('CGI::Info');
				my $params = $info->params();
				is($info->status(), 403, 'Status 403 on traversal attempt');
			});
		};
	};