view release on metacpan or  search on metacpan

bin/info.pl  view on Meta::CPAN

if($info->params()) {
	my %FORM = %{$info->params()};
	foreach (keys(%FORM)) {
		print "$_ => $FORM{$_}\n";
	}
}

if($ENV{'HTTP_COOKIE'}) {
	print 'HTTP_COOKIE: ', $ENV{'HTTP_COOKIE'}, "\n",
		"Cookies:\n";

	foreach my $cookie(split (/; /, $ENV{'HTTP_COOKIE'})) {
		my ($key, $value) = split(/=/, $cookie);

		print "Cookie $key:\n";
		my $c = $info->get_cookie(cookie_name => $key);
		if(!defined($c)) {
			print "ERROR: Expected $value, got undef\n";
		} elsif($c eq $value) {
			print "$c\n";
		} else {
			print "ERROR: Expected $value, got $c\n";
		}
	}
}

t/cookies.t  view on Meta::CPAN

		$i->get_cookie();
	};
	ok($@ =~ /^Usage: /);

	$ENV{'HTTP_COOKIE'} = 'phpbb3_ljj67_k=3dba1f0d50e51f76; style_cookie=printonly; __utma=249501332.293603655.1368565227.1380805951.1380808408.13; __utmz=249501332.1368565227.1.1.utmccn=(direct)|utmcsr=(direct)|utmcmd=(none); phpbb3_ljj67_u=2; phpbb3_l...
	$i = new_ok('CGI::Info');
	ok($i->get_cookie(cookie_name => 'cart') eq 'tubabb:1');
	ok($i->cookie('cart') eq 'tubabb:1');
}

# Cookie not set, should warn about missing field
{
	local $ENV{'HTTP_COOKIE'} = 'user=JohnDoe; session=abc123';  # Example cookie
	my $obj = new_ok('CGI::Info');

	# Check for missing field
	diag('Ignore message about what cookie would you like');
	is($obj->cookie(), undef, 'undef if no cookie field is provided');
}

# Cookie jar is populated correctly with valid cookies
{
	local $ENV{'HTTP_COOKIE'} = 'user=JohnDoe; session=abc123';  # Example cookie
	my $obj = new_ok('CGI::Info');

	# Test retrieving cookies from jar
	is($obj->cookie('user'), 'JohnDoe', 'Correctly retrieves "user" cookie');
	is($obj->cookie('session'), 'abc123', 'Correctly retrieves "session" cookie');
}

# Cookie field not found in the jar
{
	local $ENV{'HTTP_COOKIE'} = 'user=JohnDoe; session=abc123';  # Example cookie
	my $obj = new_ok('CGI::Info');

	# Test non-existent cookie field
	is($obj->cookie('nonexistent'), undef, 'Returns undef for non-existent cookie');
}

# Cookie field provided but no cookies in the header (edge case)
{
	local $ENV{'HTTP_COOKIE'} = '';  # No cookies set
	my $obj = new_ok('CGI::Info');

	# Test with no cookies available
	is($obj->cookie('user'), undef, 'Returns undef when no cookies are available');
}

# Ensure loading of the cookie jar
{