#!perl -w
use strict;
# to have a consistent baseline, we nail the current time
# to 100 seconds after the epoch
BEGIN {
}
#-----------------------------------------------------------------------------
# make sure module loaded
#-----------------------------------------------------------------------------
my @test_cookie = (
# including leading and trailing whitespace in first cookie
' foo=123 ; bar=qwerty; baz=wibble; qux=a1',
'foo=123; bar=qwerty; baz=wibble;',
'foo=vixen; bar=cow; baz=bitch; qux=politician',
'foo=a%20phrase; bar=yes%2C%20a%20phrase; baz=%5Ewibble; qux=%27',
);
#-----------------------------------------------------------------------------
# Test parse
#-----------------------------------------------------------------------------
{
}
#-----------------------------------------------------------------------------
# Test fetch
#-----------------------------------------------------------------------------
{
# make sure there are no cookies in the environment
# now set a cookie in the environment and try again
$ENV{HTTP_COOKIE} = $test_cookie[2];
"expected cookies extracted");
# Delete that and make sure it goes away
# try another cookie in the other environment variable thats supposed to work
$ENV{COOKIE} = $test_cookie[3];
"expected cookies extracted");
}
#-----------------------------------------------------------------------------
# Test raw_fetch
#-----------------------------------------------------------------------------
{
# make sure there are no cookies in the environment
# now set a cookie in the environment and try again
$ENV{HTTP_COOKIE} = $test_cookie[2];
"expected cookies extracted");
# Delete that and make sure it goes away
# try another cookie in the other environment variable thats supposed to work
$ENV{COOKIE} = $test_cookie[3];
"expected cookies extracted");
}
#-----------------------------------------------------------------------------
# Test new
#-----------------------------------------------------------------------------
{
# Try new with full information provided
-secure => 1,
-httponly=> 1
);
# now try it with the only two manditory values (should also set the default path)
);
# I'm really not happy about the restults of this section. You pass
# the new method invalid arguments and it just merilly creates a
# broken object :-)
# I've commented them out because they currently pass but I don't
# think they should. I think this is testing broken behaviour :-(
# # This shouldn't work
# $c = CGI::Cookie->new(-name => 'baz' );
#
# is(ref($c), 'CGI::Cookie', 'new returns objects of correct type');
# is($c->name , 'baz', 'name is correct');
# ok(!defined $c->value, "Value is undefined ");
# ok(!defined $c->expires, 'expires is not set');
# ok(!defined $c->domain , 'domain attributeis not set');
# is($c->path , '/', 'path atribute is set to default');
# ok(!defined $c->secure , 'secure attribute is set');
}
#-----------------------------------------------------------------------------
# Test as_string
#-----------------------------------------------------------------------------
{
-secure => 1,
-httponly=> 1
);
"Stringified cookie contains HttpOnly" );
);
"Stringified cookie does not contain HttpOnly" );
}
#-----------------------------------------------------------------------------
# Test compare
#-----------------------------------------------------------------------------
{
-secure => 1
);
# have to use $c1->expires because the time will occasionally be
# different between the two creates causing spurious failures.
-secure => 1
);
# This looks titally whacked, but it does the -1, 0, 1 comparison
# thing so 0 means they match
-domain => '.foo.bar.com'
);
# have to use $c1->expires because the time will occasionally be
# different between the two creates causing spurious failures.
);
# This looks titally whacked, but it does the -1, 0, 1 comparison
# thing so 0 (i.e. false) means they match
}
#-----------------------------------------------------------------------------
# Test name, value, domain, secure, expires and path
#-----------------------------------------------------------------------------
{
-secure => 1
);
# this is insane! it returns a simple scalar but can't accept one as
# an argument, you have to give it an arrary ref. It's totally
# inconsitent with these other methods :-(
}
#----------------------------------------------------------------------------
# Max-age
#----------------------------------------------------------------------------
MAX_AGE: {
}
#----------------------------------------------------------------------------
# bake
#----------------------------------------------------------------------------
BAKE: {
# Older Perl may be confused while evaluating test results with cookie
# dump. To avoid this we will make sure that cookie is print on STDERR
# and not STDOUT.
}
#-----------------------------------------------------------------------------
# Apache2?::Cookie compatibility.
#-----------------------------------------------------------------------------
APACHEREQ: {
$r,
), 'Pass an Apache object to the CGI::Cookie constructor';
'bake() should call headers_out->set()';
$r,
), 'Pass an Apache::RequestReq object to the CGI::Cookie constructor';
'bake() should call headers_out->set()';
}
sub isa {
}
sub headers_out { shift }
sub isa {
}
sub headers_out { shift }