CGI-Simple
view release on metacpan or search on metacpan
Revision history for Perl extension CGI::Simple.
1.281 2024-01-31 MANWAR
- RT-151161 Add CGI::Cookie partitioned support, PR #14, thanks @ldevantier-doseme.
1.280 2022-01-11 MANWAR
- Changed the version format from N.nn to N.nnn as requested.
1.27 2022-01-06 MANWAR
- Removed unneeded Build.PL #11, thanks @haarg.
- Moved prereqs to correct phase #12, thanks @haarg.
1.26 2022-01-02 MANWAR
- Dropped IO::Scalar prereq as suggested in PR #10, thanks @haarg.
1.20 2018-10-05 MANWAR
- Merge pull request #4 from jjatria/302-found, changing the
name of 302 statuses from Moved to Found.
1.19 2018-10-04 MANWAR
- Merged pull request #3 from jjatria/max-age, which sets max-age
attribute correctly from constructor.
1.18 2018-10-03 MANWAR
- Merged pull request #2 from jjatria/samesite, adding
SameSite support to Cookie handling.
1.17 2018-10-02 MANWAR
- Merged pull request #7 from asb-capfan/master, should fix
CPAN Testers fail report on some windows box.
1.16 2018-07-25 MANWAR
- Made t/manifest.t AUTHOR only (RT #125383).
- Removed +x bits from test scripts.
1.15 2018-03-04 MANWAR
1.111 2009-05-28
- Implemented Michael Nachbaur fixes for multipart form data handling.
1.110 2009-05-24
- Added missing test to manifest / distro.
- Added a test to ensure the manifest is consistent.
- Migrated to git.
1.109 2009-04-16
- Added support for HttpOnly to CGI::Simple::Cookie. Thanks to Scott Thomson for the patch.
1.108 2009-03-13
- Remove bogus references to Selfloader in documenation. No functional changes.
1.107 2009-03-07
- CGI::Simple::Cookie, fixed bug when cookie had both leading and
trailing white space (RT#34314, Ron Savage and Mark Stosberg)
- Accept a comma as well as semi-colon as a cookie separator. This
is consistent with CGI.pm as well as RFC 2965, which states: "A
server SHOULD also accept comma (,) as the separator between cookie-
values for future compatibility." (Mark Stosberg)
- Support cookies which have an equals sign in the value. Ported
from CGI.pm (Mark Stosberg)
- Support cookies in which one of multiple values is empty. Ported
from CGI.pm (Mark Stosberg)
- Fixed bug when calling unescapeHTML on HTML that wasn't
1.104 2008-05-13
- Switched from sysread to read. Fixes #35844: sysread used in
CGI::Simple blocks on re-directed STDIO reads. Thanks to Damjan Pelemis.
1.103 2007-07-31
- Version number chaos continues. One tends to forget that there
is a strange universe in which 1.1 > 1.1.2.
1.1.2 2007-07-31
- Fixed module names in POD for CGI::Simple::Cookie,
CGI::Simple::Util [#27597]. Thanks to BRICAS for reporting it.
1.1.1 2007-07-31
- Removed nasty global trap of __DIE__ in CGI::Standard. Thanks to Jeremy Morton for reporting it.
1.1 2007-07-13
- Added support for Set-Cookie as per CGI.pm patch 15065. Thanks to Patrick M. Jordan for the suggestion.
1.0 2007-05-24
- Another big version jump. I think we're about ready for 1.0.
- Fixed skip count under Win32 in t/40.request.t [27257]. Thanks to ISHIGAKI for the patch.
0.83 2007-05-22
- Big version jump to move version past badly formatted version in Cookie, Util.
0.082 2007-05-22
- Added REST support. Thanks to Mike Barry for the patch.
0.081 2007-05-20
- Fix for sysread under mod_perl. Thanks to Joshua N Pritikin for the patch.
0.080 2007-03-30
- Fixed problem parsing query args containing '='. Thanks to Ewan Edwards for the patch.
0.07 Sat Aug 2 2003
- i admit to abject slackness, but anyway finally allocated a few hours
to apply a number of bug fixes which are (in no particular order)
- mod_perl compliant, patched by Mathew Albright
- still need to comment out use Selfloader and __DATA__ token
- still thinking about other solutions to this
- Blessed globs now possible in the constructor thanks to chromatic
- Unicode error 0xfe | ($c >> 30) -> 0xfc | ($c >>30 ) fixed thanks to
Thomas L. Shinnick
- s/$value ||= 0/$value = defined $value ? $value : ''/ in raw_fetch() method
in Cookie.pm to allow value 0.
- Added missing $VERSION to Util.pm
- Added P3P support as suggested by Marc Bauer (parallels CGI.pm)
- updated header() and redirect() methods in Simple.pm
0.06 Fri Nov 8 2002
- finally found someone with a solaris box to work out reason for
unexpected test failures. Thanks to John D. Robinson and Jeroen Latour
Details available at: http://www.perlmonks.org/index.pl?node_id=211401
- Removed another new bug relating to test scripts rather than core code
thanks to the combined effors of Perlmonks tommyw, grinder, Jaap, vek,
.travis.yml
Changes
lib/CGI/Simple.pm
lib/CGI/Simple/Cookie.pm
lib/CGI/Simple/Standard.pm
lib/CGI/Simple/Util.pm
Makefile.PL
MANIFEST This list of files
README
t/000.load.t
t/020.cookie.t
t/030.function.t
t/040.request.t
t/041.multipart.t
lib/CGI/Simple.pm view on Meta::CPAN
sub put {
my $self = shift;
$self->print( @_ );
} # send output to browser
sub print {
shift;
CORE::print( @_ );
} # print to standard output (for overriding in mod_perl)
################# Cookie Methods ################
sub cookie {
my ( $self, @params ) = @_;
require CGI::Simple::Cookie;
require CGI::Simple::Util;
my ( $name, $value, $path, $domain, $secure, $expires, $httponly, $samesite )
= CGI::Simple::Util::rearrange(
[
'NAME', [ 'VALUE', 'VALUES' ],
'PATH', 'DOMAIN',
'SECURE', 'EXPIRES',
'HTTPONLY', 'SAMESITE'
],
@params
);
# retrieve the value of the cookie, if no value is supplied
unless ( defined( $value ) ) {
$self->{'.cookies'} = CGI::Simple::Cookie->fetch
unless $self->{'.cookies'};
return () unless $self->{'.cookies'};
# if no name is supplied, then retrieve the names of all our cookies.
return keys %{ $self->{'.cookies'} } unless $name;
# return the value of the cookie
return
exists $self->{'.cookies'}->{$name}
? $self->{'.cookies'}->{$name}->value
lib/CGI/Simple.pm view on Meta::CPAN
return undef unless $name; # this is an error
@params = ();
push @params, '-name' => $name;
push @params, '-value' => $value;
push @params, '-domain' => $domain if $domain;
push @params, '-path' => $path if $path;
push @params, '-expires' => $expires if $expires;
push @params, '-secure' => $secure if $secure;
push @params, '-httponly' => $httponly if $httponly;
push @params, '-samesite' => $samesite if $samesite;
return CGI::Simple::Cookie->new( @params );
}
sub raw_cookie {
my ( $self, $key ) = @_;
if ( defined $key ) {
unless ( $self->{'.raw_cookies'} ) {
require CGI::Simple::Cookie;
$self->{'.raw_cookies'} = CGI::Simple::Cookie->raw_fetch;
}
return $self->{'.raw_cookies'}->{$key} || ();
}
return $ENV{'HTTP_COOKIE'} || $ENV{'COOKIE'} || '';
}
################# Header Methods ################
sub header {
my ( $self, @params ) = @_;
lib/CGI/Simple.pm view on Meta::CPAN
if ( $p3p ) {
$p3p = join ' ', @$p3p if ref( $p3p ) eq 'ARRAY';
push( @header, qq(P3P: policyref="/w3c/p3p.xml", CP="$p3p") );
}
# push all the cookies -- there may be several
if ( $cookie ) {
my @cookie = ref $cookie eq 'ARRAY' ? @{$cookie} : $cookie;
for my $cookie ( @cookie ) {
my $cs
= ref $cookie eq 'CGI::Simple::Cookie'
? $cookie->as_string
: $cookie;
push @header, "Set-Cookie: $cs" if $cs;
}
}
# if the user indicates an expiration time, then we need both an Expires
# and a Date header (so that the browser is using OUR clock)
$expires = 'now'
if $self->no_cache; # encourage no caching via expires now
push @header,
"Expires: " . CGI::Simple::Util::expires( $expires, 'http' )
if $expires;
lib/CGI/Simple.pm view on Meta::CPAN
@params
);
$url ||= $self->self_url;
my @o;
for ( @other ) { tr/\"//d; push @o, split "=", $_, 2; }
unshift @o,
'-Status' => '302 Found',
'-Location' => $url,
'-nph' => $nph;
unshift @o, '-Target' => $target if $target;
unshift @o, '-Cookie' => $cookie if $cookie;
unshift @o, '-Type' => '';
my @unescaped;
unshift( @unescaped, '-Cookie' => $cookie ) if $cookie;
return $self->header( ( map { $self->unescapeHTML( $_ ) } @o ),
@unescaped );
}
################# Server Push Methods #################
# Return a Content-Type: style header for server-push
# This has to be NPH, and it is advisable to set $| = 1
# Credit to Ed Jordan <ed@fidalgo.net> and
# Andrew Benham <adsb@bigfoot.com> for this section
lib/CGI/Simple.pm view on Meta::CPAN
=head2 put() Send output to browser
CGI.pm alias for print. $q->put('Hello World!') will print the usual
=head2 print() Send output to browser
CGI.pm alias for print. $q->print('Hello World!') will print the usual
=cut
################# Cookie Methods ################
=head1 HTTP COOKIES
CGI.pm has several methods that support cookies.
A cookie is a name=value pair much like the named parameters in a CGI
query string. CGI scripts create one or more cookies and send
them to the browser in the HTTP header. The browser maintains a list
of cookies that belong to a particular Web server, and returns them
to the CGI script during subsequent interactions.
lib/CGI/Simple.pm view on Meta::CPAN
print $q->header( -cookie => [ $cookie1, $cookie2 ] );
To retrieve a cookie, request it by name by calling B<cookie()> method
without the B<-value> parameter:
use CGI::Simple;
$q = CGI::Simple->new;
$riddle = $q->cookie('riddle_name');
%answers = $q->cookie('answers');
Cookies created with a single scalar value, such as the "riddle_name"
cookie, will be returned in that form. Cookies with array and hash
values can also be retrieved.
The cookie and CGI::Simple namespaces are separate. If you have a parameter
named 'answers' and a cookie named 'answers', the values retrieved by
B<param()> and B<cookie()> are independent of each other. However, it's
simple to turn a CGI parameter into a cookie, and vice-versa:
# turn a CGI parameter into a cookie
$c = $q->cookie( -name=>'answers', -value=>[$q->param('answers')] );
# vice-versa
$q->param( -name=>'answers', -value=>[$q->cookie('answers')] );
=head2 raw_cookie()
Returns the HTTP_COOKIE variable. Cookies have a special format, and
this method call just returns the raw form (?cookie dough). See
B<cookie()> for ways of setting and retrieving cooked cookies.
Called with no parameters, B<raw_cookie()> returns the packed cookie
structure. You can separate it into individual cookies by splitting
on the character sequence "; ". Called with the name of a cookie,
retrieves the B<unescaped> form of the cookie. You can use the
regular B<cookie()> method to get the names, or use the raw_fetch()
method from the CGI::Simmple::Cookie module.
=cut
################# Header Methods ################
=head1 CREATING HTTP HEADERS
Normally the first thing you will do in any CGI script is print out an
HTTP header. This tells the browser what type of document to expect,
and gives other optional information, such as the language, expiration
lib/CGI/Simple.pm view on Meta::CPAN
3165: Problem:'fillBuffer' $self->fillBuffer($FILLUNIT);
....
=head1 DIFFERENCES FROM CGI.pm
CGI::Simple is strict and warnings compliant.
There are 4 modules in this distribution:
CGI/Simple.pm supplies all the core code.
CGI/Simple/Cookie.pm supplies the cookie handling functions.
CGI/Simple/Util.pm supplies a variety of utility functions
CGI/Simple/Standard.pm supplies a functional interface for Simple.pm
Simple.pm is the core module that provide all the essential functionality.
Cookie.pm is a shortened rehash of the CGI.pm module of the same name
which supplies the required cookie functionality. Util.pm has been recoded to
use an internal object for data storage and supplies rarely needed non core
functions and/or functions needed for the HTML side of things. Standard.pm is
a wrapper module that supplies a complete functional interface to the OO
back end supplied by CGI::Simple.
Although a serious attempt has been made to keep the interface identical,
some minor changes and tweaks have been made. They will likely be
insignificant to most users but here are the gory details.
lib/CGI/Simple.pm view on Meta::CPAN
=head2 Miscellaneous Methods
url_decode
url_encode
escapeHTML
unescapeHTML
put
print
=head2 Cookie Methods
cookie
raw_cookie
=head2 Header Methods
header
cache
no_cache
redirect
lib/CGI/Simple.pm view on Meta::CPAN
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2007, Andy Armstrong C<< <andy@hexten.net> >>. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
=head1 SEE ALSO
B<CGI>, L<CGI::Simple::Standard>, L<CGI::Simple::Cookie>,
L<CGI::Simple::Util>, L<CGI::Minimal>
=cut
lib/CGI/Simple/Cookie.pm view on Meta::CPAN
package CGI::Simple::Cookie;
# Original version Copyright 1995-1999, Lincoln D. Stein. All rights reserved.
# It may be used and modified freely, but I do request that this copyright
# notice remain attached to the file. You may modify this module as you
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
# This version Copyright 2001, Dr James Freeman. All rights reserved.
# Renamed, strictified, and generally hacked code. Now 30% shorter.
# Interface remains identical and passes all original CGI::Cookie tests
use strict;
use warnings;
use vars '$VERSION';
$VERSION = '1.281';
use CGI::Simple::Util qw(rearrange unescape escape);
use overload '""' => \&as_string, 'cmp' => \&compare, 'fallback' => 1;
# fetch a list of cookies from the environment and return as a hash.
# the cookies are parsed as normal escaped URL data.
lib/CGI/Simple/Cookie.pm view on Meta::CPAN
}
return $self->{'priority'};
}
1;
__END__
=head1 NAME
CGI::Simple::Cookie - Interface to HTTP cookies
=head1 SYNOPSIS
use CGI::Simple::Standard qw(header);
use CGI::Simple::Cookie;
# Create new cookies and send them
$cookie1 = CGI::Simple::Cookie->new( -name=>'ID', -value=>123456 );
$cookie2 = CGI::Simple::Cookie->new( -name=>'preferences',
-value=>{ font => Helvetica,
size => 12 }
);
print header( -cookie=>[$cookie1,$cookie2] );
# fetch existing cookies
%cookies = CGI::Simple::Cookie->fetch;
$id = $cookies{'ID'}->value;
# create cookies returned from an external source
%cookies = CGI::Simple::Cookie->parse($ENV{COOKIE});
=head1 DESCRIPTION
CGI::Simple::Cookie is an interface to HTTP/1.1 cookies, a mechanism
that allows Web servers to store persistent information on the browser's
side of the connection. Although CGI::Simple::Cookie is intended to be
used in conjunction with CGI::Simple (and is in fact used by it
internally), you can use this module independently.
For full information on cookies see:
http://tools.ietf.org/html/rfc2109
http://tools.ietf.org/html/rfc2965
https://dcthetall.github.io/CHIPS-spec/draft-cutler-httpbis-partitioned-cookies.html
=head1 USING CGI::Simple::Cookie
CGI::Simple::Cookie is object oriented. Each cookie object has a name
and a value. The name is any scalar value. The value is any scalar or
array value (associative arrays are also allowed). Cookies also have
several optional attributes, including:
=over 4
=item B<1. expiration date>
The expiration date tells the browser how long to hang on to the
cookie. If the cookie specifies an expiration date in the future, the
browser will store the cookie information in a disk file and return it
to the server every time the user reconnects (until the expiration
lib/CGI/Simple/Cookie.pm view on Meta::CPAN
If the "partitioned" attribute is set, the cookie is restricted to the
contexts in which a cookie is available to only those whose top-level
document is same-site with the top-level document that initiated the
request that created the cookie.
L<https://dcthetall.github.io/CHIPS-spec/draft-cutler-httpbis-partitioned-cookies.html>
=back
=head2 Creating New Cookies
$c = CGI::Simple::Cookie->new( -name => 'foo',
-value => 'bar',
-expires => '+3M',
-max-age => '+3M',
-domain => '.capricorn.com',
-path => '/cgi-bin/database',
-secure => 1,
-samesite => 'Lax',
);
Create cookies from scratch with the B<new> method. The B<-name> and
lib/CGI/Simple/Cookie.pm view on Meta::CPAN
B<-secure> if set to a true value instructs the browser to return the
cookie only when a cryptographic protocol is in use.
B<-httponly> if set to a true value, the cookie will not be accessible
via JavaScript.
B<-samesite> may be C<Lax>, C<Strict> or C<None> and is an evolving part of the
standards for cookies. Please refer to current documentation regarding it.
=head2 Sending the Cookie to the Browser
Within a CGI script you can send a cookie to the browser by creating
one or more Set-Cookie: fields in the HTTP header. Here is a typical
sequence:
$c = CGI::Simple::Cookie->new( -name => 'foo',
-value => ['bar','baz'],
-expires => '+3M'
);
print "Set-Cookie: $c\n";
print "Content-Type: text/html\n\n";
To send more than one cookie, create several Set-Cookie: fields.
Alternatively, you may concatenate the cookies together with "; " and
send them in one field.
If you are using CGI::Simple, you send cookies by providing a -cookie
argument to the header() method:
print header( -cookie=>$c );
Mod_perl users can set cookies using the request object's header_out()
method:
$r->header_out('Set-Cookie',$c);
Internally, Cookie overloads the "" operator to call its as_string()
method when incorporated into the HTTP header. as_string() turns the
Cookie's internal representation into an RFC-compliant text
representation. You may call as_string() yourself if you prefer:
print "Set-Cookie: ",$c->as_string,"\n";
=head2 Recovering Previous Cookies
%cookies = CGI::Simple::Cookie->fetch;
B<fetch> returns an associative array consisting of all cookies
returned by the browser. The keys of the array are the cookie names. You
can iterate through the cookies this way:
%cookies = CGI::Simple::Cookie->fetch;
foreach (keys %cookies) {
do_something($cookies{$_});
}
In a scalar context, fetch() returns a hash reference, which may be more
efficient if you are manipulating multiple cookies.
CGI::Simple uses the URL escaping methods to save and restore reserved
characters in its cookies. If you are trying to retrieve a cookie set by
a foreign server, this escaping method may trip you up. Use raw_fetch()
instead, which has the same semantics as fetch(), but performs no unescaping.
You may also retrieve cookies that were stored in some external
form using the parse() class method:
$COOKIES = `cat /usr/tmp/Cookie_stash`;
%cookies = CGI::Simple::Cookie->parse($COOKIES);
=head2 Manipulating Cookies
Cookie objects have a series of accessor methods to get and set cookie
attributes. Each accessor has a similar syntax. Called without
arguments, the accessor returns the current value of the attribute.
Called with an argument, the accessor changes the attribute and
returns its new value.
=over 4
=item B<name()>
Get or set the cookie's name. Example:
t/020.cookie.t view on Meta::CPAN
# This was forked from the original cookie.t file distributed with CGI.pm 2.78
# Originally, only modification is to change CGI::Cookie to CGI::Simple::Cookie
# whenever it appeared. Since then the tests suites for CGI.pm and CGI::Simple
# have not been kept in sync.
# to have a consistent baseline, we nail the current time
# to 100 seconds after the epoch
BEGIN {
*CORE::GLOBAL::time = sub { 100 };
}
use strict;
t/020.cookie.t view on Meta::CPAN
use Test::NoWarnings;
use CGI::Simple::Util qw(escape unescape);
use POSIX qw(strftime);
#-----------------------------------------------------------------------------
# make sure module loaded
#-----------------------------------------------------------------------------
BEGIN {
use_ok( 'CGI::Simple::Cookie' );
}
my @test_cookie = (
'foo=123, bar=qwerty; baz=wib=ble ; qux=1&2&',
'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
#-----------------------------------------------------------------------------
{
my $result = CGI::Simple::Cookie->parse( $test_cookie[0] );
is( ref( $result ), 'HASH', "Hash ref returned in scalar context" );
my @result = CGI::Simple::Cookie->parse( $test_cookie[0] );
is( @result, 8, "returns correct number of fields" );
@result = CGI::Simple::Cookie->parse( $test_cookie[1] );
is( @result, 6, "returns correct number of fields" );
my %result = CGI::Simple::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, 'wib=ble', "cookie baz is correct" );
my @values = $result{qux}->value;
is_deeply(
\@values,
[ 1, 2, '' ],
"multiple values are supported including empty values."
);
t/020.cookie.t view on Meta::CPAN
#-----------------------------------------------------------------------------
# Test fetch
#-----------------------------------------------------------------------------
{
# make sure there are no cookies in the environment
delete $ENV{HTTP_COOKIE};
delete $ENV{COOKIE};
my %result = CGI::Simple::Cookie->fetch();
ok( keys %result == 0,
"No cookies in environment, returns empty list" );
# now set a cookie in the environment and try again
$ENV{HTTP_COOKIE} = $test_cookie[2];
%result = CGI::Simple::Cookie->fetch();
ok( eq_set( [ keys %result ], [qw(foo bar baz qux)] ),
"expected cookies extracted" );
is( ref( $result{foo} ),
'CGI::Simple::Cookie', 'Type of objects returned is correct' );
is( $result{foo}->value, 'vixen', "cookie foo is correct" );
is( $result{bar}->value, 'cow', "cookie bar is correct" );
is( $result{baz}->value, 'bitch', "cookie baz is correct" );
is( $result{qux}->value, 'politician', "cookie qux is correct" );
# Delete that and make sure it goes away
delete $ENV{HTTP_COOKIE};
%result = CGI::Simple::Cookie->fetch();
ok( keys %result == 0,
"No cookies in environment, returns empty list" );
# try another cookie in the other environment variable thats supposed to work
$ENV{COOKIE} = $test_cookie[3];
%result = CGI::Simple::Cookie->fetch();
ok( eq_set( [ keys %result ], [qw(foo bar baz qux)] ),
"expected cookies extracted" );
is( ref( $result{foo} ),
'CGI::Simple::Cookie', 'Type of objects returned is correct' );
is( $result{foo}->value, 'a phrase', "cookie foo is correct" );
is( $result{bar}->value, 'yes, a phrase', "cookie bar is correct" );
is( $result{baz}->value, '^wibble', "cookie baz is correct" );
is( $result{qux}->value, "'", "cookie qux is correct" );
}
#-----------------------------------------------------------------------------
# Test raw_fetch
#-----------------------------------------------------------------------------
{
# make sure there are no cookies in the environment
delete $ENV{HTTP_COOKIE};
delete $ENV{COOKIE};
my %result = CGI::Simple::Cookie->raw_fetch();
ok( keys %result == 0,
"No cookies in environment, returns empty list" );
# now set a cookie in the environment and try again
$ENV{HTTP_COOKIE} = $test_cookie[2];
%result = CGI::Simple::Cookie->raw_fetch();
ok( eq_set( [ keys %result ], [qw(foo bar baz qux)] ),
"expected cookies extracted" );
is( ref( $result{foo} ), '', 'Plain scalar returned' );
is( $result{foo}, 'vixen', "cookie foo is correct" );
is( $result{bar}, 'cow', "cookie bar is correct" );
is( $result{baz}, 'bitch', "cookie baz is correct" );
is( $result{qux}, 'politician', "cookie qux is correct" );
# Delete that and make sure it goes away
delete $ENV{HTTP_COOKIE};
%result = CGI::Simple::Cookie->raw_fetch();
ok( keys %result == 0,
"No cookies in environment, returns empty list" );
# try another cookie in the other environment variable thats supposed to work
$ENV{COOKIE} = $test_cookie[3];
%result = CGI::Simple::Cookie->raw_fetch();
ok( eq_set( [ keys %result ], [qw(foo bar baz qux)] ),
"expected cookies extracted" );
is( ref( $result{foo} ), '', 'Plain scalar returned' );
is( $result{foo}, 'a%20phrase', "cookie foo is correct" );
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" );
}
#-----------------------------------------------------------------------------
# Test new
#-----------------------------------------------------------------------------
{
# Try new with full information provided
my $c = CGI::Simple::Cookie->new(
-name => 'foo',
-value => 'bar',
-expires => '+3M',
-domain => '.capricorn.com',
-path => '/cgi-bin/database',
-secure => 1,
-httponly => 1,
-samesite => 'Lax',
-priority => 'High',
-partitioned => 1
);
is( ref( $c ), 'CGI::Simple::Cookie',
'new returns objects of correct type' );
is( $c->name, 'foo', 'name is correct' );
is( $c->value, 'bar', 'value is correct' );
like(
$c->expires,
'/^[a-z]{3},\s*\d{2}-[a-z]{3}-\d{4}/i',
'expires in correct format'
);
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' );
is( $c->samesite, 'Lax', 'samesite attribute is correct' );
is( $c->priority, 'High', 'priority attribute is correct' );
is( $c->partitioned, 1, 'partitioned attribute is correct' );
# now try it with the only two manditory values (should also set the default path)
$c = CGI::Simple::Cookie->new(
-name => 'baz',
-value => 'qux',
);
is( ref( $c ), 'CGI::Simple::Cookie',
'new returns objects of correct type' );
is( $c->name, 'baz', 'name is correct' );
is( $c->value, 'qux', 'value is correct' );
ok( !defined $c->expires, 'expires is not set' );
ok( !defined $c->max_age, 'max_age 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 not set' );
ok( !defined $c->httponly, 'httponly attribute is not set' );
ok( !defined $c->samesite, 'samesite attribute is not set' );
ok( !$c->partitioned, 'partitioned 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
# 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::Simple::Cookie->new(-name => 'baz' );
#
# is(ref($c), 'CGI::Simple::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
#-----------------------------------------------------------------------------
{
my $c = CGI::Simple::Cookie->new(
-name => 'Jam',
-value => 'Hamster',
-expires => '+3M',
'-max-age' => '+3M',
-domain => '.pie-shop.com',
-path => '/',
-secure => 1,
-httponly => 1,
-samesite => 'strict',
-priority => 'high',
t/020.cookie.t view on Meta::CPAN
like( $c->as_string, '/SameSite=Strict/',
"Stringified cookie contains normalized SameSite" );
like( $c->as_string, '/Priority=High/',
"Stringified cookie contains normalized Priority" );
like( $c->as_string, '/Partitioned/',
"Stringified cookie contains Partitioned" );
$c = CGI::Simple::Cookie->new(
-name => 'Hamster-Jam',
-value => 'Tulip',
);
$name = $c->name;
like( $c->as_string, "/$name/", "Stringified cookie contains name" );
$value = $c->value;
like( $c->as_string, "/$value/",
"Stringified cookie contains value" );
t/020.cookie.t view on Meta::CPAN
ok( $c->as_string !~ /Partitioned/,
"Stringified cookie does not contain Partitioned" );
}
#-----------------------------------------------------------------------------
# Test compare
#-----------------------------------------------------------------------------
{
my $c1 = CGI::Simple::Cookie->new(
-name => 'Jam',
-value => 'Hamster',
-expires => '+3M',
-domain => '.pie-shop.com',
-path => '/',
-secure => 1,
-httponly => 1
);
# have to use $c1->expires because the time will occasionally be
# different between the two creates causing spurious failures.
my $c2 = CGI::Simple::Cookie->new(
-name => 'Jam',
-value => 'Hamster',
-expires => $c1->expires,
-domain => '.pie-shop.com',
-path => '/',
-secure => 1,
-httponly => 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" );
$c1 = CGI::Simple::Cookie->new(
-name => 'Jam',
-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::Simple::Cookie->new(
-name => 'Jam',
-value => 'Hamster',
);
# This looks titally whacked, but it does the -1, 0, 1 comparison
# thing so 0 (i.e. false) means they match
is( $c1->compare( "$c1" ), 0, "Cookies are identical" );
ok( $c1->compare( "$c2" ), "Cookies are not identical" );
$c2->domain( '.foo.bar.com' );
is( $c1->compare( "$c2" ), 0, "Cookies are identical" );
}
#-----------------------------------------------------------------------------
# Test name, value, domain, secure, expires and path
#-----------------------------------------------------------------------------
{
my $c = CGI::Simple::Cookie->new(
-name => 'Jam',
-value => 'Hamster',
-expires => '+3M',
-domain => '.pie-shop.com',
-path => '/',
-secure => 1,
-httponly => 1,
-samesite => 'strict'
);
t/020.cookie.t view on Meta::CPAN
is( $c->samesite( 'None' ), 'None', 'SameSite is set correctly' );
is( $c->samesite, 'None', 'SameSite now returns updated value' );
}
#----------------------------------------------------------------------------
# Max-age
#----------------------------------------------------------------------------
MAX_AGE: {
{
my $cookie = CGI::Simple::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::Simple::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';
}
{
my $cookie
= CGI::Simple::Cookie->new( -name=>'a', value=>'b', '-max-age' => '+3d');
is( $cookie->max_age,3*24*60*60,'-max-age in constructor' );
ok( !$cookie->expires,' ... lack of expires' );
}
{
my $cookie = CGI::Simple::Cookie->new(
-name => 'a',
value => 'b',
-expires => 'now',
'-max-age' => '+3d'
);
is( $cookie->max_age,3*24*60*60,'-max-age in constructor' );
ok( $cookie->expires,'-expires in constructor' );
}
}
t/050.simple.t view on Meta::CPAN
$sv,
'Jack & Jill went up the hill; to get a pail of water',
'unescapeHTML(), 3 '
);
# put()
is( $q->put( '' ), 1, 'put(), 1' );
# print()
is( $q->print( '' ), 1, 'print(), 1' );
################# Cookie Methods ################
$q = CGI::Simple->new;
# raw_cookie() - scalar and array context, void argument
$sv = $q->raw_cookie();
@av = $q->raw_cookie();
is(
$sv,
'foo=a%20phrase; bar=yes%2C%20a%20phrase&I%20say;',
'raw_cookie(), 1'
t/050.simple.t view on Meta::CPAN
-attachment => 'foo.gif',
-Cost => '$2.00'
);
# header() - scalar context, complex header
$sv = $q->header( @vals );
my $header = <<'HEADER';
HTTP/1.0 402 Payment required
Server: Apache - accept no substitutes
Status: 402 Payment required
Set-Cookie: Password=superuser&god&open%20sesame&mydog%20woofie; domain=.nowhere.com; path=/cgi-bin/database; expires=Mon, 11-Nov-2018 11:00:00 GMT; secure; HttpOnly
Expires: Mon, 11-Nov-2018 11:00:00 GMT
Date: Tue, 11-Nov-2018 11:00:00 GMT
Content-Disposition: attachment; filename="foo.gif"
Cost: $2.00
Content-Type: image/gif
HEADER
$sv =~ s/[\012\015]//g;
$header =~ s/[\012\015]//g;
$sv =~ s/(?:Expires|Date).*?GMT//g; # strip the time elements
$header =~ s/(?:Expires|Date).*?GMT//g; # strip the time elements
t/070.standard.t view on Meta::CPAN
is( $sv, "<>&\"\012\015<>&\"\012\015", 'unescapeHTML(), 2' );
# put()
is( put( '' ), 1, 'put(), 1' );
# print()
is( print( '' ), 1, 'print(), 1' );
################# Cookie Methods ################
restore_parameters();
# raw_cookie() - scalar and array context, void argument
$sv = raw_cookie();
@av = raw_cookie();
is(
$sv,
'foo=a%20phrase; bar=yes%2C%20a%20phrase&I%20say;',
t/070.standard.t view on Meta::CPAN
-Cost => '$2.00'
);
# header() - scalar context, complex header
$sv = header( @vals );
my $header = <<'HEADER';
HTTP/1.0 402 Payment required
Server: Apache - accept no substitutes
Status: 402 Payment required
Set-Cookie: Password=superuser&god&open%20sesame&mydog%20woofie; domain=.nowhere.com; path=/cgi-bin/database; expires=Mon, 11-Nov-2018 11:00:00 GMT; secure; HttpOnly
Expires: Mon, 11-Nov-2018 11:00:00 GMT
Date: Tue, 11-Nov-2018 11:00:00 GMT
Content-Disposition: attachment; filename="foo.gif"
Cost: $2.00
Content-Type: image/gif
HEADER
$sv =~ s/[\012\015]//g;
$header =~ s/[\012\015]//g;
$sv =~ s/(?:Expires|Date).*?GMT//g; # strip the time elements
$header =~ s/(?:Expires|Date).*?GMT//g; # strip the time elements
t/100.set-cookie.t view on Meta::CPAN
use Test::More tests => 1;
use CGI::Simple;
my $cgi = CGI::Simple->new;
like(
$cgi->header(
'-content-type', 'foo/fum', '-set-cookie', [ 'a=b', 'b=c' ]
),
qr/Set-cookie: a=b\s+Set-cookie: b=c/si,
'Set-Cookie'
);
( run in 0.544 second using v1.01-cache-2.11-cpan-e9199f4ba4c )