From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

use strict;
use warnings FATAL => 'all';
use Apache::TestRequest qw(GET_BODY GET_HEAD);
plan tests => 6, need_lwp;
require HTTP::Cookies;
my $location = "/apreq_cookie_test";
{
my $test = 'netscape';
my $key = 'apache';
my $value = 'ok';
my $cookie = qq{$key=$value};
ok t_cmp(GET_BODY("$location?test=$test&key=$key", Cookie => $cookie),
$value,
$test);
}
{
my $test = 'rfc';
my $key = 'apache';
my $value = 'ok';
my $cookie = qq{\$Version="1"; $key="$value"; \$Path="$location"};
ok t_cmp(GET_BODY("$location?test=$test&key=$key", Cookie => $cookie),
qq{"$value"},
$test);
}
{
my $test = 'encoded value with space';
my $key = 'apache';
my $value = 'okie dokie';
my $cookie = "$key=" . join '',
map {/ / ? '+' : sprintf '%%%.2X', ord} split //, $value;
ok t_cmp(GET_BODY("$location?test=$test&key=$key", Cookie => $cookie),
$value,
$test);
}
{
my $test = 'bake';
my $key = 'apache';
my $value = 'ok';
my $cookie = "$key=$value";
my ($header) = GET_HEAD("$location?test=$test&key=$key",
Cookie => $cookie) =~ /^#Set-Cookie:\s+(.+)/m;
ok t_cmp($header, $cookie, $test);
}
{
my $test = 'bake2';
my $key = 'apache';
my $value = 'ok';
my $cookie = qq{\$Version="1"; $key="$value"; \$Path="$location"};
my ($header) = GET_HEAD("$location?test=$test&key=$key",
Cookie => $cookie) =~ /^#Set-Cookie2:\s+(.+)/m;
ok t_cmp($header, qq{$key="$value"; Version=1; path="$location"}, $test);
}
{
my $test = 'httponly';
my $key = 'apache';
my $value = 'ok';
my $cookie = "$key=$value; HttpOnly";
my ($header) = GET_HEAD("$location?test=$test&key=$key",
Cookie => $cookie) =~ /^#Set-Cookie:\s+(.+)/m;
ok t_cmp($header, $cookie, $test);
}