CGI
view release on metacpan or search on metacpan
- ->url returns a string in all cases (GH #263, thanks to Sketch6307)
4.62 2024-03-01
[ FIX ]
- ->url now returns the correct thing for ipv6 brackets (GH #259, thanks to eserte)
4.61 2024-01-08
[ ENHANCEMENT ]
- Support Paritioned cookies in CGI::Cookie (GH #262, thanks to dakkar)
4.60 2023-11-01
[ TESTING ]
- move t/changes.t to xt/ as is now broken by the recent rewrite of Test::CPAN::Changes (GH #260)
4.59 2023-10-02
[ FIX ]
- Bring VERSION values inline
- Update cookie expires date format (GH #258 , thanks to robbiebow)
4.57 2023-05-01
[ DOCUMENTATION ]
- Documentation tweaks around uploadInfo() and hooks (GH #256, thanks to rlauer6)
4.56 2023-03-01
[ TESTING ]
- add new cookie field 'Priority' to CGI::Cookie code (GH #253, thanks to Pavel)
4.55 2023-01-03
[ TESTING ]
- remove dependency on Test::Deep (GH #254)
4.54 2022-02-03
[ FIX ]
- fix use of cache when calling ->cookie (GH #252)
- thanks to Sergey Panteleev for the PR
4.53 2021-06-03
[ FIX ]
- fix typo in passing of max-age to CGI::Cookie (GH #247)
4.52 2021-05-04
[ FIX ]
- sort hash keys for deterministic behaviour (GH #245, GH #246)
4.51 2020-10-01
[ DOCUMENTATION ]
- Document support for SameSite=None cookies in CGI::Cookie (GH #244)
4.50 2020-06-22
[ ENHANCEMENT ]
- Add APPEND_QUERY_STRING option (GH #243, thanks to stevenh)
4.49 2020-06-08
[ FIX ]
- remove deprecation warning as no longer in core (GH #221)
4.48 2020-06-02
[ FIX ]
- fix CGI::Cookie->bake() doesn't work with mod_perl redirects (GH #240)
- thanks to sherrardb for the PR (GH #241)
4.47 2020-05-01
[ FIX / TESTING ]
- fix typo in variable name (GH #239)
4.46 2020-02-03
[ DOCUMENTATION ]
4.37 2017-11-01
[ FIX ]
- Fix incorrect quoting of ? in ->url (GH #112, GH #222, with
thanks to Reuben Thomas)
4.36 2017-03-29
[ ENHANCEMENT ]
- Support PATCH HTTP method (thanks to GovtGeek for the... patch)
- pass through max_age and samesite to CGI::Cookie->new in the call
in CGI->cookie (GH #220)
[ FIX ]
- skip t/command_line.t on windows as it doesn't work
4.35 2016-10-13
[ FIX ]
- revert changes from 4.34 as they broke stuff
- make perldoc CGI object consistent (GH #205)
- clarify reason for absolute URLs (GH #206)
[ INTERNALS ]
- tweak dependency defs in Makefile.PL (GH #207, GH #208)
- (thanks to karenetheridge and kentfredric)
4.31 2016-06-14
[ FEATURES ]
- Add SameSite support to Cookie handling (thanks to pangyre)
[ INTERNALS ]
- The MultipartBuffer package has been renamed to CGI::MultipartBuffer.
This has been done in a way to ensure any $MultipartBuffer package
variables are still set correctly in CGI::MultipartBuffer. if you are
explicitly using MultipartBuffer in a form such as:
MultipartBuffer->new
your code will break. you should be calling:
4.03 2014-07-02
[ REMOVED / DEPRECATIONS ]
- the -multiple option to popup_menu is now IGNORED as this did not
function correctly. If you require a menu with multiple selections
use the scrolling_list method. (RT #30057)
[ SPEC / BUG FIXES ]
- support redirects in mod_perl2, or fall back to using env variable
for up to 5 redirects, when getting the query string (RT #36312)
- CGI::Cookie now correctly supports the -max-age argument, previously
if this was passed the value of the -expires argument would be used
meaning there was no way to supply *only* this argument (RT #50576)
- make :all actually import all methods, except for :cgi-lib, and add
:ssl to the :standard import (RT #70337)
[ DOCUMENTATION ]
- clarify documentation regarding query_string method (RT #48370)
- links fixed in some perldoc (Thanks to Michiel Beijen)
[ TESTING ]
[INTERNALS]
- Avoiding warning about "unitialized value" in when calling user_agent() in some cases. (RT#72882, perl@max-maurer.de)
- Update minimum required version in Makefile.PL to 5.8.1. It had already been
updated to 5.8.1 in the CGI.pm module in 3.53.
- Fix POD errors reported by newer pod2man (Thanks to jmdh)
- Typo fixes, (dsteinbrunner).
- use deprecate.pm on perls 5.19.0 and later. (rjbs).
[DOCUMENTATION]
- Update CGI::Cookie docs to reflect that HttpOnly is widely supported now.
Version 3.63 Nov 12, 2012
[SECURITY]
- CR escaping for Set-Cookie and P3P headers was improved. There was potential
for newline injection in these headers.
(Thanks to anazawa, https://github.com/markstos/CGI.pm/pull/23)
Version 3.62, Nov 9th, 2012
[INTERNALS]
- Changed how the deprecated endform function was defined for compatibility
with the development version of Perl.
- Fix failures in t/tmpdir.t when run as root
https://github.com/markstos/CGI.pm/issues/22, RT#80659)
- Fixed logic bug in t/multipart_init.t (RT#64261, Niko Tyni)
Version 3.51, Jan 5, 2011
[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)
7. Fixed overlap of attribute and parameter space described in http://rt.perl.org/rt3//Ticket/Display.html?id=24294
Version 3.37, Apr 22, 2008
1. Fix pragmas so that they persist over modperl invocations (e.g. RT 34761)
2. Fixed handling of chunked multipart uploads; thanks to Michael Bernhardt
who reported and fixed the problem.
Version 3.36
1. Fix CGI::Cookie to support cookies that are separated by "," instead of ";".
Version 3.35, Mar 27, 2008
1. Resync with bleadperl, primarily fixing a bug in parsing semicolons in uploaded filenames.
Version 3.34, Mar 18, 2008
1. Handle Unicode %uXXXX escapes properly -- patch from DANKOGAI@cpan.org
2. Fix url() method to not choke on path names that contain regex characters.
Version 3.29, Apr 16, 2007
1. The position of file handles is now reset to zero when CGI->new is called.
(Mark Stosberg)
2. uploadInfo() now works across multiple object instances. Also, the first
tests for uploadInfo() were added as part of the fix. (CPAN bug 11895, with
contributions from drfrench and Mark Stosberg).
Version 3.28, Mar 29, 2007
1. Applied patch from Allen Day that makes Cookie parsing RFC2109 compliant
(attribute/values can be separated by commas as well as semicolons).
2. Applied patch from Stephan Struckmann that allows script_name() to be set correctly.
3. Fixed problem with url(-full) in which port number appears twice.
Version 3.27, Feb 27, 2007
1. Applied patch from Steve Taylor that allows checkbox_groups to be
disabled with a new -disabled=> option.
Version 3.26
Version 3.21, Aug 21, 2006
1. Don't try to read data at all when POST > $POST_MAX.
2. Fixed bug that caused $cgi->param('name',undef,'value') to unset param('name') entirely.
3. Fixed bug in which upload() sometimes returns empty. (CPAN bug #12694).
4. Incorporated patch from BURAK@cpan.org to support HTTPcookies (CPAN bug 21019).
Version 3.20
1. Patch from David Wheeler for CGI::Cookie->bake(). Uses mod_perl headers_out->add()
rather than headers_out->set().
2. Fixed problem identified by Andrei Voronkov in which start_form() output was screwed
up when initial argument begins with a dash and subsequent arguments do not.
3. Quashed uninitialized variable warnings coming from script_name(), url() and other
functions that require access to the PATH_INFO environment variable.
Version 3.19
1. Added patch from Stephen Frost that allows one to suppress use of the temp file that is
created during uploads.
4. Removed "hack to fix broken PATH_INFO in MSII".
Version 3.18
1. Doc typo fixes.
2. Patch from Steve Peters to default the document type to match the charset.
3. Fixed param() so that param(-name=>'foo',-values=>[]) sets the parameter to empty list.
Version 3.17, Feb 24, 2006
1. Added patch from Mike Hanafey which caused 0 arguments to CGI::Cookie->new() to
be treated as empty.
2. Patch to CGI::Carp from Peter Whaite to fix the unfixable problem of CGI::Carp
not behaving correctly in an eval() context.
3. CGI::Fast->new() calls CGI->_reset_globals to avoid contamination of one session
with another's variables.
4. Fixed upload failure on files that contain semicolons in their names.
Version 3.16, Feb 8, 2006
1. header() -charset option now works even when the MIME type is not "text".
2. Fixed documentation for cookie() function and fastCGI.
3. Upload filehandles now only closed automatically on Windows systems.
4. Apache::Cookie compatibility fix from David Wheeler
5. CGI::Carp->fatalsToBrowser() does not work correctly with
mod_perl 2. No workaround is known.
6. Fixed text status code associated with 302 redirects. Should be "Found"
but was "Moved".
7. Fixed charset in start_html() and header() to be in synch.
Version 3.15, Dec 7, 2005
1. Remove extraneous "?" from self_url() when URI contains a ? but no query string.
mod_rewrite. Be advised that path_info() may give you confusing results
when mod_rewrite is active because Apache calculates the path info *after*
rewriting. This is mostly worked around in url() and self_url(), but you
may notice some anomalies.
8. Removed empty (and non-validating) <div> from code emitted by end_form().
9. Fixed CGI::Carp to work correctly with Mod_perl 1.29 in an Apache 2 environment.
10. Setting $CGI::TMPDIRECTORY should now be effective.
Version 3.11, Aug 3, 2005
1. Killed warning in CGI::Cookie about MOD_PERL_API_VERSION
2. Fixed append() so that it works in function mode.
3. Workaround for a bug that appears in Apache2 versions through 2.0.54
in which SCRIPT_NAME and PATH_INFO are incorrect if the additional path_info
contains a double slash. This workaround will handle the common case of
http://mysite.com/cgi-bin/log.cgi/http://www.some.other.site/args, but will
not handle the uncommon case of a ScriptAlias directive that adds additional
path information to the end of the translated URI.
Version 3.10, May 13, 2005
Version 3.07, Mar 14, 2005
1. Fixed typo in mod_perl detection.
Version 3.06, Mar 09, 2005
1. Fixed bare call to script() in start_html
2. Moved Fh::DESTROY out of autoloaded functions so as to avoid
clobbering $@ when CGI functions are executed in an eval{}
context.
3. mod_perl 2.0 version detection patch in CGI::Cookie provided by
Allen Day.
4. autoEscape() flag is now respected when generating extra
attributes.
5. Tests for *tag start/end generation from Shlomi Fish.
6. Support for can() method provided by Ron Savage.
7. Fix for lang='' when outputting XHTML.
8. Added support for chunked transfer encoding, as suggested by
Hakan Ardo
9. Fixed clobbering of row and column headers in tableized radio
and checkbox groups, as reported by Nicolas Thierry-Mieg.
autoEscape().
2. Fixed endofrm() syntax error introduced by Ben Edgington's patch.
Version 2.90
1. Fixed bug in redirect header handling.
2. Added P3P option to header().
3. Patches from Alexey Mahotkin to make CGI::Carp work correctly with
object-oriented exceptions.
4. Removed inaccurate description of how to set multiple cookies from
CGI::Cookie pod file.
5. Patch from Kevin Mahony to prevent running out of filehandles when
uploading lots of files.
6. Documentation enhancement from Mark Fisher to note that the
import_names() method transforms the parameter names into valid
Perl names.
7. Patch from Dan Harkless to suppress lang attribute in <html> tag
if specified as a null string.
8. Patch from Ben Edgington to fix broken XHTML-transitional 1.0
validation on endform().
9. Custom html header fix from Steffen Beyer (first letter correctly
postings, most arguments were being untainted silently. Returned
arguments are now tainted correctly. This may cause some scripts
to fail that used to work (thanks to Nick Cleaton for pointing
this out and persisting until it was fixed).
2. Update for mod_perl 2.0.
3. Pragmas such as -no_xhtml are now respected in mod_perl
environment.
Version 2.86
1. Fixes for broken CGI::Cookie expiration dates introduced in 2.84.
Version 2.85
1. Fix for broken autoEscape function introduced in 2.84.
Version 2.84
1. Fix for failed file uploads on Cygwin platforms.
2. HTML escaping code now replaced 0x8b and 0x9b with unicode
references < and *#8250;
Version 2.83
1. Fixed autoEscape() documentation inconsistencies.
2. Patch from Ville Skytt� to fix a number of XHTML inconsistencies.
3. Added Max-Age to list of CGI::Cookie headers.
Version 2.82
1. Patch from Rudolf Troller to add attribute setting and option
groups to form fields.
2. Patch from Simon Perreault for silent crashes when using CGI::Carp
under mod_perl.
3. Patch from Scott Gifford allows you to set the program name for
CGI::Carp.
Version 2.75
1. Fixed bug in server push boundary strings (CGI.pm and CGI::Push).
2. Fixed bug that occurs when uploading files with funny characters
in the name
3. Fixed non-XHTML-compliant attributes produced by textfield()
4. Added EPOC support, courtesy Olaf Flebbe
5. Fixed minor XHTML bugs.
6. Made escape() and unescape() symmetric with respect to EBCDIC,
courtesy Roca, Ignasi <ignasi.roca@fujitsu.siemens.es>
7. Removed uninitialized variable warning from CGI::Cookie, provided
by Atipat Rojnuckarin <rojnuca@yahoo.com>
8. Fixed bug in CGI::Pretty that causes it to print partial end tags
when the $INDENT global is changed.
9. Single quotes are changed to character entity ' for compatibility
with URLs.
Version 2.74
September 13, 2000
1. Quashed one-character bug that caused CGI.pm to fail on file
to variables passed in query strings like 'name1=&name2'
Version 2.62
1. Fixed broken ReadParse() function, and added regression tests
2. Fixed broken CGI::Pretty, and added regression tests
Version 2.61
1. Moved more functions from CGI.pm proper into CGI/Util.pm.
CGI/Cookie should now be standalone.
2. Disabled per-user temporary directories, which were causing grief.
Version 2.60
1. Fixed junk appearing in autogenerated HTML functions when using
object-oriented mode.
Version 2.59
1. autoescape functionality breaks too much existing code, removed
nasty Windows characters (thanks to Tom Christiansen).
5. Handle REDIRECT_QUERY_STRING correctly.
6. Removed use_named_parameters() because of dependency problems and
general lameness.
7. Fixed problems with bad HREF links generated by url(-relative=>1)
when the url is like /people/.
8. Silenced a warning on upload (patch provided by Jonas Liljegren)
9. Fixed race condition in CGI::Carp when errors occur during parsing
(patch provided by Maurice Aubrey).
10. Fixed failure of url(-path_info=>1) when path contains % signs.
11. Fixed warning from CGI::Cookie when receiving foreign cookies that
don't use name=value format.
12. Fixed incompatibilities with file uploading on VMS systems.
Version 2.56
1. Fixed bugs in file upload introduced in version 2.55
2. Fixed long-standing bug that prevented two files with identical
names from being uploaded.
Version 2.55
Version 2.38
I finally got tired of all the 2.37 betas and released 2.38. The main
difference between this version and the last 2.37 beta (2.37b30) are
some fixes for VMS. This should allow file upload to work properly on
all VMS Web servers.
Version 2.37, various beta versions
1. Added a CGI::Cookie::parse() method for lucky mod_perl users.
2. No longer need separate -values and -labels arguments for
multi-valued form elements.
3. Added better interface to raw cookies (fix courtesy Ken Fox,
kfox@ford.com)
4. Added param_fetch() function for direct access to parameter list.
5. Fix to checkbox() to allow for multi-valued single checkboxes
(weird problem).
6. Added a compile() method for those who want to compile without
importing.
7. Documented the import pragmas a little better.
globals.
41. <LAYER> and <ILAYER> added to :html3 functions.
42. Fixed problems with private tempfiles and NT/IIS systems.
43. No longer prints the DTD by default (I bet no one will complain).
44. Allow underscores to replace internal hyphens in parameter names.
45. CGI::Push supports heterogeneous MIME types and adjustable delays
between pages.
46. url_param() method added for retrieving URL parameters even when a
fill-out form is POSTed.
47. Got rid of warnings when radio_group() is called.
48. Cookies now moved to their very own module.
49. Fixed documentation bug in CGI::Fast.
50. Added a :no_debug pragma to the import list.
Version 2.36
1. Expanded JavaScript functionality
2. Preliminary support for cascading stylesheets
3. Security fixes for file uploads:
+ Module will bail out if its temporary file already exists
+ Temporary files can now be made completely private to avoid
peeking by other users or CGI scripts.
4. use CGI qw/:nph/ wasn't working correctly. Now it is.
5. Cookie and HTTP date formats didn't meet spec. Thanks to Mark
Fisher (fisherm@indy.tce.com) for catching and fixing this.
p
Version 2.35
1. Robustified multipart file upload against incorrect syntax in
POST.
2. Fixed more problems with mod_perl.
3. Added -noScript parameter to start_html().
examples/cookie.cgi
examples/crash.cgi
examples/file_upload.cgi
examples/mojo_proxy.pl
examples/wikipedia_example.cgi
examples/wilogo.gif
lib/CGI.pm
lib/CGI.pod
lib/Fh.pm
lib/CGI/Carp.pm
lib/CGI/Cookie.pm
lib/CGI/Pretty.pm
lib/CGI/Push.pm
lib/CGI/Util.pm
lib/CGI/File/Temp.pm
lib/CGI/HTML/Functions.pm
lib/CGI/HTML/Functions.pod
LICENSE
Makefile.PL
MANIFEST This list of files
README.md
);
print $q->header( -cookie => [ $cookie1,$cookie2 ] );
To retrieve a cookie, request it by name by calling cookie() method without the
**-value** parameter. This example uses the object-oriented form:
my $riddle = $q->cookie('riddle_name');
my %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 namespaces are separate. If you have a parameter named
'answers' and a cookie named 'answers', the values retrieved by param() and
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
my $c = cookie( -name => 'answers',-value => [$q->param('answers')] );
# vice-versa
method a single argument corresponding to a MIME type, as in
Accept('text/html'), it will return a floating point value corresponding to the
browser's preference for this type from 0.0 (don't want) to 1.0. Glob types
(e.g. text/\*) in the browser's accept list are handled correctly.
Note that the capitalization changed between version 2.43 and 2.44 in order to
avoid conflict with perl's accept() function.
- **raw\_cookie()**
Returns the HTTP\_COOKIE variable. Cookies have a special format, and this
method call just returns the raw form (?cookie dough). See cookie() for ways
of setting and retrieving cooked cookies.
Called with no parameters, 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 **unescaped**
form of the cookie. You can use the regular cookie() method to get the names,
or use the raw\_fetch() method from the CGI::Cookie module.
- **env\_query\_string()**
Returns the QUERY\_STRING variable, note that this is the original value as set
in the environment by the webserver and (possibly) not the same value as
returned by query\_string(), which represents the object state
- **user\_agent()**
Returns the HTTP\_USER\_AGENT variable. If you give this method a single
my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) =
rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'],
'STATUS',['COOKIE','COOKIES','SET-COOKIE'],'TARGET',
'EXPIRES','NPH','CHARSET',
'ATTACHMENT','P3P'],@p);
# Since $cookie and $p3p may be array references,
# we must stringify them before CR escaping is done.
my @cookie;
for (ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie) {
my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_;
push(@cookie,$cs) if defined $cs and $cs ne '';
}
$p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY';
# CR escaping for values, per RFC 822
for my $header ($type,$status,@cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
if (defined $header) {
# From RFC 822:
# Unfolding is accomplished by regarding CRLF immediately
# followed by a LWSP-char as equivalent to the LWSP-char.
# Maybe future compatibility. Maybe not.
my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph;
push(@header,"Server: " . &server_software()) if $nph;
push(@header,"Status: $status") if $status;
push(@header,"Window-Target: $target") if $target;
push(@header,"P3P: policyref=\"/w3c/p3p.xml\", CP=\"$p3p\"") if $p3p;
# push all the cookies -- there may be several
push(@header,map {"Set-Cookie: $_"} @cookie);
# if the user indicates an expiration time, then we need
# both an Expires and a Date header (so that the browser is
# uses OUR clock)
push(@header,"Expires: " . expires($expires))
if $expires;
push(@header,"Date: " . expires(0)) if $expires || $cookie || $nph;
push(@header,"Pragma: no-cache") if $self->cache();
push(@header,"Content-Disposition: attachment; filename=\"$attachment\"") if $attachment;
push(@header,map {ucfirst $_} @other);
push(@header,"Content-Type: $type") if $type ne '';
$url ||= $self->self_url;
my(@o);
for (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
unshift(@o,
'-Status' => $status,
'-Location'=> $url,
'-nph' => $nph);
unshift(@o,'-Target'=>$target) if $target;
unshift(@o,'-Type'=>'');
my @unescaped;
unshift(@unescaped,'-Cookie'=>$cookie) if $cookie;
return $self->header((map {$self->unescapeHTML($_)} @o),@unescaped);
}
#### Method: start_html
# Canned HTML header
#
# Parameters:
# $title -> (optional) The title for this HTML document (-title)
# $author -> (optional) e-mail address of the author (-author)
# $base -> (optional) if set to true, will enter the BASE address of this document
$url .= $path if $path_info and defined $path;
$url .= "?$query_str" if $query and $query_str ne '';
$url ||= '';
$url = URI->new( $url )->canonical->as_string;
return $url
}
#### Method: cookie
# Set or read a cookie from the specified name.
# Cookie can then be passed to header().
# Usual rules apply to the stickiness of -value.
# Parameters:
# -name -> name for this cookie (optional)
# -value -> value of this cookie (scalar, array or hash)
# -path -> paths for which this cookie is valid (optional)
# -domain -> internet domain in which this cookie is valid (optional)
# -secure -> if true, cookie only passed through secure channel (optional)
# -expires -> expiry date in format Wdy, DD Mon YYYY HH:MM:SS GMT (optional)
####
sub cookie {
my($self,@p) = self_or_default(@_);
my($name,$value,$path,$domain,$secure,$expires,$httponly,$max_age,$samesite,$priority) =
rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY,'MAX-AGE',SAMESITE,PRIORITY],@p);
require CGI::Cookie;
# if no value is supplied, then we retrieve the
# value of the cookie, if any. For efficiency, we cache the parsed
# cookies in our state variables.
unless ( defined($value) ) {
$self->{'.cookies'} = CGI::Cookie->fetch unless $COOKIE_CACHE && exists $self->{'.cookies'};
# If no name is supplied, then retrieve the names of all our cookies.
return () unless $self->{'.cookies'};
return keys %{$self->{'.cookies'}} unless $name;
return () unless $self->{'.cookies'}->{$name};
return $self->{'.cookies'}->{$name}->value if defined($name) && $name ne '';
}
# If we get here, we're creating a new cookie
return undef unless defined($name) && $name ne ''; # this is an error
push(@param,'-value'=>$value);
push(@param,'-domain'=>$domain) if $domain;
push(@param,'-path'=>$path) if $path;
push(@param,'-expires'=>$expires) if $expires;
push(@param,'-secure'=>$secure) if $secure;
push(@param,'-httponly'=>$httponly) if $httponly;
push(@param,'-max-age'=>$max_age) if $max_age;
push(@param,'-samesite'=>$samesite) if $samesite;
push(@param,'-priority'=>$priority) if $priority;
return CGI::Cookie->new(@param);
}
sub parse_keywordlist {
my($self,$tosplit) = @_;
$tosplit = unescape($tosplit); # unescape the keywords
$tosplit=~tr/+/ /; # pluses to spaces
my(@keywords) = split(/\s+/,$tosplit);
return @keywords;
}
# Returns the magic cookies for the session.
# The cookies are not parsed or altered in any way, i.e.
# cookies are returned exactly as given in the HTTP
# headers. If a cookie name is given, only that cookie's
# value is returned, otherwise the entire raw cookie
# is returned.
####
sub raw_cookie {
my($self,$key) = self_or_CGI(@_);
require CGI::Cookie;
if (defined($key)) {
$self->{'.raw_cookies'} = CGI::Cookie->raw_fetch
unless $self->{'.raw_cookies'};
return () unless $self->{'.raw_cookies'};
return () unless $self->{'.raw_cookies'}->{$key};
return $self->{'.raw_cookies'}->{$key};
}
return $self->http('cookie') || $ENV{'COOKIE'} || '';
}
#### Method: virtual_host
lib/CGI.pod view on Meta::CPAN
);
print $q->header( -cookie => [ $cookie1,$cookie2 ] );
To retrieve a cookie, request it by name by calling cookie() method without the
B<-value> parameter. This example uses the object-oriented form:
my $riddle = $q->cookie('riddle_name');
my %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 namespaces are separate. If you have a parameter named
'answers' and a cookie named 'answers', the values retrieved by param() and
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
my $c = cookie( -name => 'answers',-value => [$q->param('answers')] );
# vice-versa
lib/CGI.pod view on Meta::CPAN
method a single argument corresponding to a MIME type, as in
Accept('text/html'), it will return a floating point value corresponding to the
browser's preference for this type from 0.0 (don't want) to 1.0. Glob types
(e.g. text/*) in the browser's accept list are handled correctly.
Note that the capitalization changed between version 2.43 and 2.44 in order to
avoid conflict with perl's accept() function.
=item B<raw_cookie()>
Returns the HTTP_COOKIE variable. Cookies have a special format, and this
method call just returns the raw form (?cookie dough). See cookie() for ways
of setting and retrieving cooked cookies.
Called with no parameters, 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 cookie() method to get the names,
or use the raw_fetch() method from the CGI::Cookie module.
=item B<env_query_string()>
Returns the QUERY_STRING variable, note that this is the original value as set
in the environment by the webserver and (possibly) not the same value as
returned by query_string(), which represents the object state
=item B<user_agent()>
Returns the HTTP_USER_AGENT variable. If you give this method a single
lib/CGI/Cookie.pm view on Meta::CPAN
package CGI::Cookie;
use strict;
use warnings;
our $VERSION='4.59';
use CGI::Util qw(rearrange unescape escape);
use overload '""' => \&as_string, 'cmp' => \&compare, 'fallback' => 1;
my $PERLEX = 0;
lib/CGI/Cookie.pm view on Meta::CPAN
}
return wantarray ? %results : \%results;
}
sub get_raw_cookie {
my $r = shift;
$r ||= eval { $MOD_PERL == 2 ?
Apache2::RequestUtil->request() :
Apache->request } if $MOD_PERL;
return $r->headers_in->{'Cookie'} if $r;
die "Run $r->subprocess_env; before calling fetch()"
if $MOD_PERL and !exists $ENV{REQUEST_METHOD};
return $ENV{HTTP_COOKIE} || $ENV{COOKIE};
}
sub parse {
my ($self,$raw_cookie) = @_;
lib/CGI/Cookie.pm view on Meta::CPAN
# A bug in Netscape can cause several cookies with same name to
# appear. The FIRST one in HTTP_COOKIE is the most recent version.
$results{$key} ||= $self->new(-name=>$key,-value=>\@values);
}
return wantarray ? %results : \%results;
}
sub new {
my ( $class, @params ) = @_;
$class = ref( $class ) || $class;
# Ignore mod_perl request object--compatibility with Apache::Cookie.
shift if ref $params[0]
&& eval { $params[0]->isa('Apache::Request::Req') || $params[0]->isa('Apache') };
my ( $name, $value, $path, $domain, $secure, $expires, $max_age, $httponly, $samesite, $priority, $partitioned )
= rearrange(
[
'NAME', [ 'VALUE', 'VALUES' ],
'PATH', 'DOMAIN',
'SECURE', 'EXPIRES',
'MAX-AGE','HTTPONLY','SAMESITE',
'PRIORITY', 'PARTITIONED',
lib/CGI/Cookie.pm view on Meta::CPAN
sub bake {
my ($self, $r) = @_;
$r ||= eval {
$MOD_PERL == 2
? Apache2::RequestUtil->request()
: Apache->request
} if $MOD_PERL;
if ($r) {
$r->err_headers_out->add('Set-Cookie' => $self->as_string);
} else {
require CGI;
print CGI::header(-cookie => $self);
}
}
# accessors
sub name {
my ( $self, $name ) = @_;
lib/CGI/Cookie.pm view on Meta::CPAN
if ($priority && $_legal_priority{$priority}) {
$self->{'priority'} = $priority;
}
return $self->{'priority'};
}
1;
=head1 NAME
CGI::Cookie - Interface to HTTP Cookies
=head1 SYNOPSIS
use CGI qw/:standard/;
use CGI::Cookie;
# Create new cookies and send them
$cookie1 = CGI::Cookie->new(-name=>'ID',-value=>123456);
$cookie2 = CGI::Cookie->new(-name=>'preferences',
-value=>{ font => Helvetica,
size => 12 }
);
print header(-cookie=>[$cookie1,$cookie2]);
# fetch existing cookies
%cookies = CGI::Cookie->fetch;
$id = $cookies{'ID'}->value;
# create cookies returned from an external source
%cookies = CGI::Cookie->parse($ENV{COOKIE});
=head1 DESCRIPTION
CGI::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::Cookie is
intended to be used in conjunction with CGI.pm (and is in fact used by
it internally), you can use this module independently.
For full information on cookies see
https://tools.ietf.org/html/rfc6265
=head1 USING CGI::Cookie
CGI::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/Cookie.pm view on Meta::CPAN
L<https://tools.ietf.org/html/draft-west-first-party-cookies-07>
=item B<7. priority flag>
Allowed settings are C<Low>, C<Medium> and C<High>.
Support is limited to recent releases of Chrome.
=back
=head2 Creating New Cookies
my $c = CGI::Cookie->new(-name => 'foo',
-value => 'bar',
-expires => '+3M',
'-max-age' => '+3M',
-domain => '.capricorn.com',
-path => '/cgi-bin/database',
-secure => 1,
-samesite=> "Lax",
-priority=> "High",
);
lib/CGI/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.
For compatibility with Apache::Cookie, you may optionally pass in
a mod_perl request object as the first argument to C<new()>. It will
simply be ignored:
my $c = CGI::Cookie->new($r,
-name => 'foo',
-value => ['bar','baz']);
=head2 Sending the Cookie to the Browser
The simplest way to send a cookie to the browser is by calling the bake()
method:
$c->bake;
This will print the Set-Cookie HTTP header to STDOUT using CGI.pm. CGI.pm
will be loaded for this purpose if it is not already. Otherwise CGI.pm is not
required or used by this module.
Under mod_perl, pass in an Apache request object:
$c->bake($r);
If you want to set the cookie yourself, 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:
my $c = CGI::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.
If you are using CGI.pm, 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->err_headers_out->add('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::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::Cookie->fetch;
for (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.pm 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::Cookie->parse($COOKIES);
If you are in a mod_perl environment, you can save some overhead by
passing the request object to fetch() like this:
CGI::Cookie->fetch($r);
If the value passed to parse() is undefined, an empty array will returned in list
context, and an empty hashref will be returned in scalar context.
=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:
lib/CGI/Push.pm view on Meta::CPAN
my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,$nph,@other) = rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
$type = 'text/html' unless $type;
$callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
$delay = 1 unless defined($delay);
$self->push_delay($delay);
$nph = 1 unless defined($nph);
my(@o);
foreach (@other) { push(@o,split("=")); }
push(@o,'-Target'=>$target) if defined($target);
push(@o,'-Cookie'=>$cookie) if defined($cookie);
push(@o,'-Type'=>"multipart/x-mixed-replace;boundary=\"$boundary\"");
push(@o,'-Server'=>"CGI.pm Push Module") if $nph;
push(@o,'-Status'=>'200 OK');
push(@o,'-nph'=>1) if $nph;
print $self->header(@o);
$boundary = "$CGI::CRLF--$boundary";
print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.${boundary}$CGI::CRLF";
# 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
#-----------------------------------------------------------------------------
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',
'foo=a%20phrase, bar=yes%2C%20a%20phrase; baz=%5Ewibble; qux=%27; expires=Mon, 07 Apr 2025 21:32:31 GMT;',
);
#-----------------------------------------------------------------------------
# Test parse
#-----------------------------------------------------------------------------
{
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");
%result = CGI::Cookie->parse( $test_cookie[4] );
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" );
is( $result{expires}->value, 'Mon, 07 Apr 2025 21:32:31 GMT', "expires 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)");
@array = CGI::Cookie->parse(undef);
$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)");
}
#-----------------------------------------------------------------------------
# Test fetch
#-----------------------------------------------------------------------------
{
# make sure there are no cookies in the environment
delete $ENV{HTTP_COOKIE};
delete $ENV{COOKIE};
my %result = CGI::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::Cookie->fetch();
ok(eq_set([keys %result], [qw(foo bar baz qux)]),
"expected cookies extracted");
is(ref($result{foo}), 'CGI::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::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::Cookie->fetch();
ok(eq_set([keys %result], [qw(foo bar baz qux)]),
"expected cookies extracted");
is(ref($result{foo}), 'CGI::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::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::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::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::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");
$ENV{COOKIE} = '$Version=1; foo; $Path="/test"';
%result = CGI::Cookie->raw_fetch();
is($result{foo}, '', 'no value translates to empty string');
}
#-----------------------------------------------------------------------------
# Test new
#-----------------------------------------------------------------------------
{
# 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,
-httponly=> 1,
-samesite=> 'Lax',
-priority=> 'High',
-partitioned=> 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');
like($c->expires, '/^[a-z]{3},\s*\d{2}\s[a-z]{3}\s\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::Cookie->new(-name => 'baz',
-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');
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 set');
ok( !defined $c->httponly, 'httponly attribute is not set' );
ok( !$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::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
#-----------------------------------------------------------------------------
{
my $c = CGI::Cookie->new(-name => 'Jam',
-value => 'Hamster',
-expires => '+3M',
'-max-age' => '+3M',
-domain => '.pie-shop.com',
-path => '/',
-secure => 1,
-httponly=> 1,
-samesite=> 'strict',
-priority=> 'high',
-partitioned=> 1,
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::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");
ok($c->as_string !~ /expires/, "Stringified cookie has no expires field");
ok( $c->as_string !~ /Partitioned/,
"Stringified cookie does not contain Partitioned" );
}
#-----------------------------------------------------------------------------
# Test compare
#-----------------------------------------------------------------------------
{
my $c1 = CGI::Cookie->new(-name => 'Jam',
-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
);
# 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", "$c2", "Cookies are identical");
$c1 = CGI::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::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::Cookie->new(-name => 'Jam',
-value => 'Hamster',
-expires => '+3M',
-domain => '.pie-shop.com',
-path => '/',
-secure => 1,
-samesite=> "strict",
-priority=> "low"
);
is($c->name, 'Jam', 'name is correct');
is($c->priority('Bad'), 'Medium', 'Priority unknown values ignored');
is($c->priority, 'Medium', 'Priority returns previous value');
}
#----------------------------------------------------------------------------
# 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', 'expires is correct';
is $cookie->max_age => undef, 'max-age is undefined when setting expires';
$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';
$cookie = CGI::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' );
$cookie = CGI::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' );
}
#----------------------------------------------------------------------------
# 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.
#-----------------------------------------------------------------------------
APACHEREQ: {
my $r = Apache::Faker->new;
isa_ok $r, 'Apache';
ok my $c = CGI::Cookie->new(
$r,
-name => 'Foo',
-value => 'Bar',
), 'Pass an Apache object to the CGI::Cookie constructor';
isa_ok $c, 'CGI::Cookie';
ok $c->bake($r), 'Bake the cookie';
ok eq_array( $r->{check}, [ 'Set-Cookie', $c->as_string ]),
'bake() should call err_headers_out->add()';
$r = Apache2::Faker->new;
isa_ok $r, 'Apache2::RequestReq';
ok $c = CGI::Cookie->new(
$r,
-name => 'Foo',
-value => 'Bar',
), 'Pass an Apache::RequestReq object to the CGI::Cookie constructor';
isa_ok $c, 'CGI::Cookie';
ok $c->bake($r), 'Bake the cookie';
ok eq_array( $r->{check}, [ 'Set-Cookie', $c->as_string ]),
'bake() should call err_headers_out->add()';
}
package Apache::Faker;
sub new { bless {}, shift }
sub isa {
my ($self, $pkg) = @_;
return $pkg eq 'Apache';
}
t/headers.t view on Meta::CPAN
eval { $cgi->header( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
like($@,qr/contains a newline/,'invalid header blows up');
like $cgi->header( -type => "text/html".$CGI::CRLF." evil: stuff " ),
qr#Content-Type: text/html evil: stuff#, 'known header, with leading and trailing whitespace on the continuation line';
eval { $cgi->header( -p3p => ["foo".$CGI::CRLF."bar"] ) };
like($@,qr/contains a newline/,'P3P header with CRLF embedded blows up');
eval { $cgi->header( -cookie => ["foo".$CGI::CRLF."bar"] ) };
like($@,qr/contains a newline/,'Set-Cookie header with CRLF embedded blows up');
eval { $cgi->header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up');
eval { $cgi->header( -foobar => $CGI::CRLF."Content-type: evil/header" ) };
like($@,qr/contains a newline/, 'unknown header with leading newlines blows up');
eval { $cgi->redirect( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
like($@,qr/contains a newline/,'redirect with known header with CRLF embedded blows up');
t/headers/cookie.t view on Meta::CPAN
use strict;
use CGI;
use Test::More;
{
my $cgi = CGI->new;
my $got = $cgi->header( -cookie => 'foo' );
my $expected = "^Set-Cookie: foo$CGI::CRLF"
. "Date: [^$CGI::CRLF]+$CGI::CRLF"
. 'Content-Type: text/html; charset=ISO-8859-1'
. $CGI::CRLF x 2;
like $got, qr($expected), 'cookie';
}
{
my $cgi = CGI->new;
my $got = $cgi->header( -cookie => [ 'foo', 'bar' ] );
my $expected = "^Set-Cookie: foo$CGI::CRLF"
. "Set-Cookie: bar$CGI::CRLF"
. "Date: [^$CGI::CRLF]+$CGI::CRLF"
. 'Content-Type: text/html; charset=ISO-8859-1'
. $CGI::CRLF x 2;
like $got, qr($expected), 'cookie arrayref';
}
{
my $cgi = CGI->new;
my $got = $cgi->header( -cookie => q{} );
my $expected = 'Content-Type: text/html; charset=ISO-8859-1'
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
</head>
<body>
END
my $cookie =
cookie( -name => 'fred', -value => [ 'chocolate', 'chip' ], -path => '/' );
is $cookie, 'fred=chocolate&chip; path=/', "cookie()";
my $h = header( -Cookie => $cookie );
like $h,
qr!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s,
"header(-cookie)";
$h = header( '-set-cookie' => $cookie );
like $h,
qr!^Set-[Cc]ookie: fred=chocolate&chip\; path=/${CRLF}(Date:.*${CRLF})?Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s,
"header(-set-cookie)";
my $cookie2 =
cookie( -name => 'ginger', -value => 'snap' , -path => '/' );
is $cookie2, 'ginger=snap; path=/', "cookie2()";
$h = header( -cookie => [ $cookie, $cookie2 ] );
like $h,
qr!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Set-Cookie: ginger=snap\; path=/${CRLF}(Date:.*${CRLF})?Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s,
"header(-cookie=>[cookies])";
$h = header( '-set-cookie' => [ $cookie, $cookie2 ] );
like $h,
qr!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Set-Cookie: ginger=snap\; path=/${CRLF}(Date:.*${CRLF})?Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s,
"header(-set-cookie=>[cookies])";
$h = redirect('http://elsewhere.org/');
like $h,
qr!Status: 302 Found${CRLF}Location: http://elsewhere.org/!s,
"redirect";
$h = redirect(-url=>'http://elsewhere.org/', -cookie=>[$cookie,$cookie2]);
like $h,
qr!Status: 302 Found${CRLF}Set-[Cc]ookie: \Q$cookie\E${CRLF}Set-[Cc]ookie: \Q$cookie2\E${CRLF}(Date:.*${CRLF})?Location: http://elsewhere.org/!s,
( run in 2.098 seconds using v1.01-cache-2.11-cpan-e9199f4ba4c )