diff options
author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2011-01-05 23:35:15 +0000 |
---|---|---|
committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2011-01-05 23:35:15 +0000 |
commit | 2a1594f630b57637ddd7a38daaa1e17f66da396a (patch) | |
tree | 62a9f16cef549dcd9994838e14e178b4dbc5c3b7 /cpan/CGI/t/cookie.t | |
parent | b220e8cd5bb9b66ed60b059f802b49aabb4b520e (diff) | |
download | perl-2a1594f630b57637ddd7a38daaa1e17f66da396a.tar.gz |
Update CGI to CPAN version 3.51
[DELTA]
Version 3.51
[NEW FEATURES]
- A new option to set $CGI::Carp::TO_BROWSER = 0, allows you to explicitly
exclude a particular scope from triggering printing to the browser when
fatatlsToBrowser is set. (RT#62783, Thanks to papowell)
- The <script> tag now supports the "charset" attribute.
(RT#62907, Thanks to Fabrice Metge)
- In CGI::Cookie, "Max-Age" is now supported for better spec compliance.
(Mark Stosberg)
[BUG FIXES]
- Setting charset() now works for all content types, not just "text/*".
(RT#57945, Thanks to Yanick and Gerv.)
- support for user temporary directories ($HOME/tmp) was commented out
in 2.61 but the documentation wasn't updated (Peter Gervai, Niko Tyni)
- setting $CGITempFile::TMPDIRECTORY before loading CGI.pm has been
working but undocumented since 3.12 (which listed it in Changes as
$CGI::TMPDIRECTORY) (Peter Gervai, Niko Tyni)
- unfortunately the previous change broke the runtime check for looking
for a new temporary directory if the current one suddenly became
unwritable (Peter Gervai, Niko Tyni)
- A bug was fixed in CGI::Carp triggered by certain death cases in
the BEGIN phase of parent classes.
(RT#57224, Thanks to UNERA, Yanick Champoux, Mark Stosberg)
- CGI::Cookie->new() now follows the documentation and returns undef
if the -name and -value args aren't provided. This new behavior is also
consistent with the docs and code of CGI::Simple::Cookie. (Mark Stosberg)
- CGI::Cookie->parse() now trims leading and trailing whitespace from cookie
elements as intended. The change also makes this part of the parsing
identical to CGI::Simple::Cookie (Mark Stosberg)
- Temp file handling was improved (RT#62762)
[SECURITY]
- Further improvements have been made to guard against newline injections
in headers. (Thanks to Max Kanat-Alexander, Yanick Champoux, Mark Stosberg)
[PERFORMANCE]
- Make EBCDIC a compile-time constant so there's zero overhead (and less
compiled code) in subroutines that test for it. (Tim Bunce)
- If you just want to use CGI::Cookie, CGI.pm will no longer be loaded
unless you call the bake() method, which requires it. (Mark Stosberg)
[DOCUMENTATION]
- quit referring to the <link> tag as being "rarely used". (Victor Sanders)
- typo and whitespace fixes (RT#62785, thanks to scop@cpan.org)
- The -dtd argument to start_html() is now documented
(RT#60473, Thanks to giecrilj and steve@fisharerojo.org)
- CGI::Carp doc are updated to reflect that it can work with mod_perl 2.0.
- when creating a temporary file in the directory fails, the error message
could indicate the root of the problem better (Peter Gervai, Niko Tyni)
[INTERNALS]
- Re-fixing https test in http.t. (RT#54768, thanks to SPROUT)
- param_fetch no longer triggers a warning when called with no arguments (ysth, Mark Stosberg)
Diffstat (limited to 'cpan/CGI/t/cookie.t')
-rw-r--r-- | cpan/CGI/t/cookie.t | 162 |
1 files changed, 109 insertions, 53 deletions
diff --git a/cpan/CGI/t/cookie.t b/cpan/CGI/t/cookie.t index f5afc18596..8249f0798e 100644 --- a/cpan/CGI/t/cookie.t +++ b/cpan/CGI/t/cookie.t @@ -1,23 +1,29 @@ -#!/usr/local/bin/perl -w +#!perl -w use strict; -use Test::More tests => 96; +# to have a consistent baseline, we nail the current time +# to 100 seconds after the epoch +BEGIN { + *CORE::GLOBAL::time = sub { 100 }; +} + +use Test::More 'no_plan'; use CGI::Util qw(escape unescape); use POSIX qw(strftime); +use CGI::Cookie; #----------------------------------------------------------------------------- # make sure module loaded #----------------------------------------------------------------------------- -BEGIN {use_ok('CGI::Cookie');} - my @test_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', - ); + # 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 @@ -25,23 +31,29 @@ my @test_cookie = ( { my $result = CGI::Cookie->parse($test_cookie[0]); - is(ref($result), 'HASH', "Hash ref returned in scalar context"); my @result = CGI::Cookie->parse($test_cookie[0]); - is(@result, 8, "returns correct number of fields"); @result = CGI::Cookie->parse($test_cookie[1]); - is(@result, 6, "returns correct number of fields"); my %result = CGI::Cookie->parse($test_cookie[0]); - is($result{foo}->value, '123', "cookie foo is correct"); is($result{bar}->value, 'qwerty', "cookie bar is correct"); is($result{baz}->value, 'wibble', "cookie baz is correct"); is($result{qux}->value, 'a1', "cookie qux is correct"); + + my @array = CGI::Cookie->parse(''); + my $scalar = CGI::Cookie->parse(''); + is_deeply(\@array, [], " parse('') returns an empty array in list context (undocumented)"); + is_deeply($scalar, {}, " parse('') returns an empty hashref in scalar context (undocumented)"); + + my @array = CGI::Cookie->parse(undef); + my $scalar = CGI::Cookie->parse(undef); + is_deeply(\@array, [], " parse(undef) returns an empty array in list context (undocumented)"); + is_deeply($scalar, {}, " parse(undef) returns an empty hashref in scalar context (undocumented)"); } #----------------------------------------------------------------------------- @@ -126,6 +138,10 @@ my @test_cookie = ( is($result{bar}, 'yes%2C%20a%20phrase', "cookie bar is correct"); is($result{baz}, '%5Ewibble', "cookie baz is correct"); is($result{qux}, '%27', "cookie qux is correct"); + + $ENV{COOKIE} = '$Version=1; foo; $Path="/test"'; + %result = CGI::Cookie->raw_fetch(); + is($result{foo}, '', 'no value translates to empty string'); } #----------------------------------------------------------------------------- @@ -135,12 +151,13 @@ my @test_cookie = ( { # Try new with full information provided my $c = CGI::Cookie->new(-name => 'foo', - -value => 'bar', - -expires => '+3M', - -domain => '.capricorn.com', - -path => '/cgi-bin/database', - -secure => 1 - ); + -value => 'bar', + -expires => '+3M', + -domain => '.capricorn.com', + -path => '/cgi-bin/database', + -secure => 1, + -httponly=> 1 + ); is(ref($c), 'CGI::Cookie', 'new returns objects of correct type'); is($c->name , 'foo', 'name is correct'); is($c->value , 'bar', 'value is correct'); @@ -148,11 +165,12 @@ my @test_cookie = ( is($c->domain , '.capricorn.com', 'domain is correct'); is($c->path , '/cgi-bin/database', 'path is correct'); ok($c->secure , 'secure attribute is set'); + ok( $c->httponly, 'httponly attribute is set' ); # now try it with the only two manditory values (should also set the default path) $c = CGI::Cookie->new(-name => 'baz', - -value => 'qux', - ); + -value => 'qux', + ); is(ref($c), 'CGI::Cookie', 'new returns objects of correct type'); is($c->name , 'baz', 'name is correct'); is($c->value , 'qux', 'value is correct'); @@ -160,6 +178,7 @@ my @test_cookie = ( 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'); + ok( !defined $c->httponly, 'httponly attribute is not set' ); # I'm really not happy about the restults of this section. You pass # the new method invalid arguments and it just merilly creates a @@ -186,12 +205,13 @@ my @test_cookie = ( { my $c = CGI::Cookie->new(-name => 'Jam', - -value => 'Hamster', - -expires => '+3M', - -domain => '.pie-shop.com', - -path => '/', - -secure => 1 - ); + -value => 'Hamster', + -expires => '+3M', + -domain => '.pie-shop.com', + -path => '/', + -secure => 1, + -httponly=> 1 + ); my $name = $c->name; like($c->as_string, "/$name/", "Stringified cookie contains name"); @@ -210,9 +230,12 @@ my @test_cookie = ( like($c->as_string, '/secure/', "Stringified cookie contains secure"); + like( $c->as_string, '/HttpOnly/', + "Stringified cookie contains HttpOnly" ); + $c = CGI::Cookie->new(-name => 'Hamster-Jam', - -value => 'Tulip', - ); + -value => 'Tulip', + ); $name = $c->name; like($c->as_string, "/$name/", "Stringified cookie contains name"); @@ -228,6 +251,9 @@ my @test_cookie = ( like($c->as_string, "/$path/", "Stringified cookie contains path"); ok($c->as_string !~ /secure/, "Stringified cookie does not contain secure"); + + ok( $c->as_string !~ /HttpOnly/, + "Stringified cookie does not contain HttpOnly" ); } #----------------------------------------------------------------------------- @@ -236,38 +262,38 @@ my @test_cookie = ( { my $c1 = CGI::Cookie->new(-name => 'Jam', - -value => 'Hamster', - -expires => '+3M', - -domain => '.pie-shop.com', - -path => '/', - -secure => 1 - ); + -value => 'Hamster', + -expires => '+3M', + -domain => '.pie-shop.com', + -path => '/', + -secure => 1 + ); # have to use $c1->expires because the time will occasionally be # different between the two creates causing spurious failures. my $c2 = CGI::Cookie->new(-name => 'Jam', - -value => 'Hamster', - -expires => $c1->expires, - -domain => '.pie-shop.com', - -path => '/', - -secure => 1 - ); + -value => 'Hamster', + -expires => $c1->expires, + -domain => '.pie-shop.com', + -path => '/', + -secure => 1 + ); # This looks titally whacked, but it does the -1, 0, 1 comparison # thing so 0 means they match is($c1->compare("$c1"), 0, "Cookies are identical"); - is($c1->compare("$c2"), 0, "Cookies are identical"); + is( "$c1", "$c2", "Cookies are identical"); $c1 = CGI::Cookie->new(-name => 'Jam', - -value => 'Hamster', - -domain => '.foo.bar.com' - ); + -value => 'Hamster', + -domain => '.foo.bar.com' + ); # have to use $c1->expires because the time will occasionally be # different between the two creates causing spurious failures. $c2 = CGI::Cookie->new(-name => 'Jam', - -value => 'Hamster', - ); + -value => 'Hamster', + ); # This looks titally whacked, but it does the -1, 0, 1 comparison # thing so 0 (i.e. false) means they match @@ -284,12 +310,12 @@ my @test_cookie = ( { my $c = CGI::Cookie->new(-name => 'Jam', - -value => 'Hamster', - -expires => '+3M', - -domain => '.pie-shop.com', - -path => '/', - -secure => 1 - ); + -value => 'Hamster', + -expires => '+3M', + -domain => '.pie-shop.com', + -path => '/', + -secure => 1 + ); is($c->name, 'Jam', 'name is correct'); is($c->name('Clash'), 'Clash', 'name is set correctly'); @@ -321,6 +347,36 @@ my @test_cookie = ( ok(!$c->secure, 'secure attribute is cleared'); } +#---------------------------------------------------------------------------- +# Max-age +#---------------------------------------------------------------------------- + +MAX_AGE: { + my $cookie = CGI::Cookie->new( -name=>'a', value=>'b', '-expires' => 'now',); + is $cookie->expires, 'Thu, 01-Jan-1970 00:01:40 GMT'; + is $cookie->max_age => undef, 'max-age is undefined when setting expires'; + + my $cookie = CGI::Cookie->new( -name=>'a', 'value'=>'b' ); + $cookie->max_age( '+4d' ); + + is $cookie->expires, undef, 'expires is undef when setting max_age'; + is $cookie->max_age => 4*24*60*60, 'setting via max-age'; + + $cookie->max_age( '113' ); + is $cookie->max_age => 13, 'max_age(num) as delta'; +} + + +#---------------------------------------------------------------------------- +# bake +#---------------------------------------------------------------------------- + +BAKE: { + my $cookie = CGI::Cookie->new( -name=>'a', value=>'b', '-expires' => 'now',); + eval { $cookie->bake }; + is($@,'', "calling bake() without mod_perl should survive"); +} + #----------------------------------------------------------------------------- # Apache2?::Cookie compatibility. #----------------------------------------------------------------------------- |