Close of build 10.
diff -Naur perl-5.12.4/cpan/CGI/Changes CGI.pm-3.59/cpan/CGI/Changes
--- perl-5.12.4/cpan/CGI/Changes 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/Changes 2011-12-30 05:28:52.000000000 -0800
@@ -1,10 +1,184 @@
-Version 3.49
+Version 3.59 Dec 29th, 2011
+
+ [BUG FIXES]
+ - We no longer read from STDIN when the Content-Length is not set, preventing
+ requests with no Content-Length from freezing in some cases. This is consistent
+ with the CGI RFC 3875, and is also consistent with CGI::Simple. However, the old
+ behavior may have been expected by some command-line uses of CGI.pm.
+ Thanks to Philip Potter and Yanick Champoux. See RT#52469 for details:
+ https://rt.cpan.org/Public/Bug/Display.html?id=52469
+
+ [INTERNALS]
+ - remove tmpdirs more aggressively. Thanks to rjbs (RT#73288)
+ - use Text::ParseWords instead of ancient shellwords.pl. Thanks to AlexBio.
+ - remove use of define(@arr). Thanks to rjbs.
+ - spelling fixes. Thanks to Gregor Herrmann and Alessandro Ghedini.
+ - fix test count and warning in t/fast.t. Thanks to Yanick.
+
+Version 3.58 Nov 11th, 2011
+
+ [DOCUMENTATION]
+ - Clarify that using query_string() only has defined behavior when using the GET method. (RT#60813)
+
+Version 3.57 Nov 9th, 2011
+ [INTERNALS]
+ - test failure in t/fast.t introduced in 3.56 is fixed. (Thanks to zefram and chansen).
+ - Test::More requirement has been bumped to 0.98
+
+Version 3.56 Nov 8th, 2011
+
+ [SECURITY]
+ Use public and documented FCGI.pm API in CGI::Fast
+ CGI::Fast was using an FCGI API that was deprecated and removed from
+ documentation more than ten years ago. Usage of this deprecated API with
+ FCGI >= 0.70 or FCGI <= 0.73 introduces a security issue.
+ <https://rt.cpan.org/Public/Bug/Display.html?id=68380>
+ <http://web.nvd.nist.gov/view/vuln/detail?vulnId=CVE-2011-2766>
+ (Thanks to chansen)
+
+ [INTERNALS]
+ - tmp files are now cleaned up on VMS ( RT#69210, thanks to [email protected] )
+ - Fixed test failure: done_testing() added to url.t (Thanks to Ryan Jendoubi)
+ - Clarify preferred bug submission location in docs, and note that Mark Stosberg
+ is the current maintainer.
+
+Version 3.55 June 3rd, 2011
+
+ [THINGS THAT MAY BREAK YOUR CODE]
+ url() was fixed to return "PATH_INFO" when it is explicitly requested
+ with either the path=>1 or path_info=>1 flag.
+
+ If your code is running under mod_rewrite (or compatible) and you are calling self_url() or
+ you are calling url() and passing path_info=>1, These methods will actually be
+ returning PATH_INFO now, as you have explicitly requested, or has self_url()
+ has requested on your behalf.
+
+ The PATH_INFO has been omitted in such URLs since the issue was introduced
+ in the 3.12 release in December, 2005.
+
+ This bug is so old your application may have come to depend on it or
+ workaround it. Check for application before upgrading to this release.
+
+ Examples of affected method calls:
+
+ $q->url(-absolute => 1, -query => 1, -path_info => 1 )
+ $q->url(-path=>1)
+ $q->url(-full=>1,-path=>1)
+ $q->url(-rewrite=>1,-path=>1)
+ $q->self_url();
+
+Version 3.54, Apr 28, 2011
+ No code changes
+
+ [INTERNALS]
+ - Address test failures in t/tmpdir.t, thanks to Niko Tyni.
+ Some tests here are failing on some platforms and have been marked as TODO.
+
+Version 3.53, Apr 25, 2011
+
+ [NEW FEATURES]
+ - The DELETE HTTP verb is now supported.
+ (RT#52614, James Robson, Eduardo Ari�o de la Rubia)
+
+ [INTERNALS]
+ - Correct t/tmpdir.t MANIFEST entry. (RT#64949)
+ - Update minimum required Perl version to be Perl 5.8.1, which
+ has been out since 2003. This allows us to drop some hacks
+ and exceptions (Mark Stosberg)
+
+Version 3.52, Jan 24, 2011
+
+ [DOCUMENTATION]
+ - The documentation for multi-line header handling was been updated to reflect
+ the changes in 3.51. (Mark Stosberg, [email protected])
+
+ [INTERNALS]
+ - Add missing t/tmpfile.t file. (RT#64949)
+ - Fix warning in t/cookie.t (RT#64570, Chris Williams, Rainer Tammer, Mark Stosberg)
+ - 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 [email protected])
+ - The -dtd argument to start_html() is now documented
+ (RT#60473, Thanks to giecrilj and [email protected])
+ - 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)
+
+Version 3.50, Nov 8, 2010
+
+ [SECURITY]
+ 1. The MIME boundary in multipart_init is now random.
+ Thanks to Byron Jones, Masahiro Yamada, Reed Loden, and Mark Stosberg
+ 2. Further improvements to handling of newlines embedded in header values.
+ An exception is thrown if header values contain invalid newlines.
+ Thanks to Michal Zalewski, Max Kanat-Alexander, Yanick Champoux,
+ Lincoln Stein, Fr�d�ric Buclin and Mark Stosberg
+
+ [DOCUMENTATION]
+ 1. Correcting/clarifying documentation for param_fetch(). Thanks to
+ Ren�e B�cker. (RT#59132)
+
+ [INTERNALS]
+ 1. Fixing https test in http.t. (RT#54768)
+ 2. Tests were added for multipart_init(). Thanks to Mark Stosberg and CGI::Simple.
+
+Version 3.49, Feb 5th, 2010
[BUG FIXES]
1. Fix a regression since 3.44 involving a case when the header includes "Content-Length: 0".
Thanks to Alex Vandiver (RT#51109)
2. Suppress uninitialized warnings under -w. Thanks to burak. (RT#50301)
3. url() now uses virtual_port() instead of server_port(). Thanks to MKANAT and Yanick Champoux. (RT#51562)
+ 4. CGI::Carp now properly handles stringifiable objects, like Exception::Class throws (RT#39904)
[SECURITY]
1. embedded newlines are now filtered out of header values in header().
@@ -18,7 +192,7 @@
1. More tests were added for autoescape, thanks to Bob Kuo. (RT#25485)
2. Attempt to avoid test failures with t/fast, thanks to Steve Hay. (RT#49599)
-Version 3.48
+Version 3.48, Sep 25, 2009
[BUG FIXES]
1. <optgroup> default values are now properly escaped.
@@ -35,14 +209,15 @@
[INTERNALS]
1. More tests were added for autoescape, thanks to Bob Kuo. (RT#25485)
-Version 3.47
- Released September 9th, 2009.
+Version 3.47, Sep 9, 2009
+
No code changes.
[INTERNALS]
Re-release of 3.46, which did not contain a proper MANIFEST
Version 3.46
+
[BUG FIXES]
1. In CGI::Pretty, we no longer add line breaks after tags we claim not to format. Thanks to rrt, Bob Kuo and
and Mark Stosberg. (RT#42114).
@@ -66,7 +241,7 @@
11.Calling CGI->new() no longer clobbers the value of $_ in the current scope.
Thanks to Alexey Tourbin, Bob Kuo and Mark Stosberg. (RT#25131)
12.UTF-8 params should not get double-decoded now.
- Thanks to Yves, Bodo, Burak G�rsoy, and Michael Schout. (RT#19913)
+ Thanks to Yves, Bodo, Burak G�rsoy, and Michael Schout. (RT#19913)
13.We now give objects passed to CGI::Carp::die a chance to be stringified.
Thanks to teek and Yanick Champoux (RT#41530)
14.Turning off autoEscape() now only affects the behavior of built-in HTML
@@ -95,7 +270,8 @@
2. Automated tests for hidden() have been added, thanks to Russel Jenkins and Mark Stosberg (RT#20436)
3. t/util.t has been updated to use Test::More instead of a home-grown test function. Thanks to Bob Kuo.
-Version 3.45
+Version 3.45, Aug 14, 2009
+
[BUG FIXES]
1. Prevent warnings about "uninitialized values" for REQUEST_URI, HTTP_USER_AGENT and other environment variables.
Patches by Callum Gibson, heiko and Mark Stosberg. (RT#24684, RT#29065)
@@ -113,7 +289,7 @@
8. Support for <optgroup> with scrolling_list() now works the same way as it does for popup_menu().
Thanks to Stuart Johnston (RT#30097)
9. CGI::Pretty now works properly when $" is set to ''. Thanks to Jim Keenan (RT#12401)
- 10. Fix crash when used in combination with PerlEx::DBI. Thanks to Burak G�rsoy (RT#19902)
+ 10. Fix crash when used in combination with PerlEx::DBI. Thanks to Burak G�rsoy (RT#19902)
[DOCUMENTATION]
1. Several typos were fixed, Thanks to ambs. (RT#41105)
@@ -134,41 +310,48 @@
4. CGI::Switch and CGI::Apache now properly set their VERSION in their own name space.
Thanks to Alexey Tourbin (RT#11941,RT#11942)
- Version 3.44
+Version 3.44, Jul 30, 2009
+
1. Patch from Kurt Jaeger to allow HTTP PUT even if the content length is unknown.
2. Patch from Pavel merdin to fix a problem for one of the FireFox addons.
3. Fixed issue in mod_perl & fastCGI environment of cookies returned from
CGI->cookie() leaking from one session to another.
- Version 3.43
+Version 3.43, Apr 06, 2009
+
1. Documentation patch from [email protected] to replace all occurrences of
"new CGI" with CGI->new()" to reflect best perl practices.
2. Patch from Stepan Kasal to fix utf-8 related problems in perl 5.10
- Version 3.42
+Version 3.42, Sep 08, 2008
+
1. Added patch from Renee Baecker that makes it possible to subclass
CGI::Pretty.
2. Added patch from Nicholas Clark to allow ~ characters in temporary directories.
3. Added patch from Renee Baecker that fixes the inappropriate escaping of fields
in multipart headers.
- Version 3.41
+Version 3.41, Aug 25, 2008
+
1. Fix url() returning incorrect path when query string contains escaped newline.
2. Added additional windows temporary directories and environment variables, courtesy patch from Renee Baecker
3. Added a handle() method to the lightweight upload
filehandles. This method returns a real IO::Handle object.
4. Added patch from Tony Vanlingen to fix deep recursion warnings in CGI::Pretty.
- Version 3.40
+Version 3.40, Aug 06, 2008
+
1. Fixed CGI::Fast docs to eliminate references to a "special"
version of Perl.
2. Makefile.PL now depends on FCGI so that CGI::Fast installs properly.
3. Fix script_name() call from Stephane Chazelas.
- Version 3.39
+Version 3.39, Jun 29, 2008
+
1. Fixed regression in "exists" function when using tied interface to CGI via $q->Vars.
- Version 3.38
+Version 3.38, Jun 25, 2008
+
1. Fix annoying warning in http://rt.cpan.org/Ticket/Display.html?id=34551
2. Added nobr() function http://rt.cpan.org/Ticket/Display.html?id=35377
3. popup_menu() allows multiple items to be selected by default, satisfying
@@ -179,56 +362,68 @@
6. Fixed minor warning described at http://rt.cpan.org/Public/Bug/Display.html?id=36435
7. Fixed overlap of attribute and parameter space described in http://rt.perl.org/rt3//Ticket/Display.html?id=24294
- Version 3.37
+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
+Version 3.36
+
1. Fix CGI::Cookie to support cookies that are separated by "," instead of ";".
- Version 3.35
+Version 3.35, Mar 27, 2008
+
1. Resync with bleadperl, primarily fixing a bug in parsing semicolons in uploaded filenames.
- Version 3.34
+Version 3.34, Mar 18, 2008
+
1. Handle Unicode %uXXXX escapes properly -- patch from [email protected]
2. Fix url() method to not choke on path names that contain regex characters.
- Version 3.33
+Version 3.33, Jan 02, 2008
+
1. Remove uninit variable warning when calling url(-relative=>1)
2. Fix uninit variable warnings for two lc calls
3. Fixed failure of tempfile upload due to sprintf() taint failure in perl 5.10
- Version 3.32
+Version 3.32, Dec 27, 2007
+
1. Patch from Miguel Santinho to prevent sending premature headers under mod_perl 2.0
- Version 3.31
+Version 3.31, Nov 30, 2007
+
1. Patch from Xavier Robin so that CGI::Carp issues a 500 Status code rather than a 200 status code.
2. Patch from Alexander Klink to select correct temporary directory in OSX Leopard so that upload works.
3. Possibly fixed "wrapped pack" error on 5.10 and higher.
- Version 3.30
+Version 3.30
+
1. Patch from Mike Barry to handle POSTDATA in the same way as PUT.
2. Patch from Rafael Garcia-Suarez to correctly reencode unicode values as byte values.
- Version 3.29
+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
+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
+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.26
+
1. Fixed alternate stylesheet behavior so that it is insensitive to order of declarations.
2. Patch from John Binns to allow users to provide a callback to CGI::Carp.
3. Added "~" as an unreserved character in escape().
@@ -236,31 +431,37 @@
5. Fixed outdated documentation (and behavior) of -language in start_html -script option.
6. Fixed bug in seconds calculation in CGI::Util::expire_calc.
- Version 3.25
+Version 3.25, Sep 28, 2006
+
1. Fixed the link to the Netscape frames page.
2. Added ability to specify an alternate stylesheet.
3. Add support for XForms POST submssion both as application/xml or as multipart/related
- Version 3.24
+Version 3.24
+
1. In startform(), if request_uri() returns undef, then falls back
to self_url(). This should rarely happen except when run outside of
the CGI environment.
2. image button alignment options were mistakenly being capitalized, causing xhtml validation to fail.
- Version 3.23
+Version 3.23, Aug 23, 2006
+
1. Typo in upload() persisted, now fixed for real. Thanks to
Emanuele Zeppieri for correct patch and regression test.
- Version 3.22
+Version 3.22, Aug 23, 2006
+
1. Typo in upload() function broke uploads. Now fixed (CPAN bug 21126).
- Version 3.21
+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 [email protected] to support HTTPcookies (CPAN bug 21019).
- Version 3.20
+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
@@ -268,7 +469,8 @@
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
+Version 3.19
+
1. Added patch from Stephen Frost that allows one to suppress use of the temp file that is
created during uploads.
2. Fixed problem noted by Martin Foster in which regular expression meta-character terms
@@ -277,12 +479,14 @@
3. More fixes to the url() method.
4. Removed "hack to fix broken PATH_INFO in MSII".
- Version 3.18
+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 Fri Feb 24 14:01:27 EST 2006
+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
@@ -291,7 +495,8 @@
with another's variables.
4. Fixed upload failure on files that contain semicolons in their names.
- Version 3.16 Wed Feb 8 13:29:11 EST 2006
+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.
@@ -302,16 +507,20 @@
but was "Moved".
7. Fixed charset in start_html() and header() to be in synch.
- Version 3.15 Wed Dec 7 15:13:22 EST 2005
+Version 3.15, Dec 7, 2005
+
1. Remove extraneous "?" from self_url() when URI contains a ? but no query string.
- Version 3.14 Tue Dec 6 17:12:03 EST 2005
+Version 3.14, Dec 6, 2005
+
1. Fixed broken scrolling_list() select attribute.
- Version 3.13
+Version 3.13, Dec 4, 2005
+
1. Removed extraneous empty "?" from end of self_url().
- Version 3.12
+Version 3.12, Dec 4, 2005
+
1. Fixed virtual_port so that it works properly with https protocol.
2. Fixed documentation for upload_hook().
3. Added POSTDATA documentation.
@@ -328,7 +537,8 @@
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
+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
@@ -338,21 +548,25 @@
not handle the uncommon case of a ScriptAlias directive that adds additional
path information to the end of the translated URI.
- Version 3.10
+Version 3.10, May 13, 2005
+
1. Added Apache2::RequestIO, which is necessary for mp2 interoperability.
- Version 3.09
+Version 3.09, May 5, 2005
+
1. Fixed tabindex="0" when using CGI to create forms without a prior start_html
2. Removed warning about non-numeric MOD_PERL_API_VERSION.
- Version 3.08
+Version 3.08, Apr 20, 2005
+
1. update support for mod_perl 2.0. versions prior to
mod_perl 1.999_22 (2.0.0-RC5) are no longer supported.
- Version 3.07
+Version 3.07, Mar 14, 2005
+
1. Fixed typo in mod_perl detection.
- Version 3.06
+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
@@ -381,7 +595,7 @@
higher perls (fix courtesy Slaven Rezic).
- Version 3.05
+Version 3.05, Apr 12, 2004
1. Fixed uninitialized variable warning on start_form() when running
from command line.
@@ -414,23 +628,23 @@
15. Fixed documentation bug in -style argument to start_html()
16. Added -status argument to redirect().
- Version 3.04
+Version 3.04, Jan 18, 2004
1. Fixed the problem with mod_perl crashing when "defaults" button
pressed.
- Version 3.03
+Version 3.03, Jan 13, 2004
1. Fix upload hook functionality
2. Workaround for CGI->unescape_html()
3. Bumped version numbers in CGI::Fast and CGI::Util for 5.8.3-tobe
- Version 3.02
+Version 3.02
1. Bring in Apache::Response just in case.
2. File upload on EBCDIC systems now works.
- Version 3.01
+Version 3.01, Dec 10, 2003
1. No fix yet for upload failures when running on EBCDIC server.
2. Fixed uninitialized glob warnings that appeared when file
@@ -453,7 +667,7 @@
12. Added virtual_port() method for finding out what port server is
listening on in a virtual-host aware fashion.
- Version 3.00
+Version 3.00, Aug 18, 2003
1. Patch from Randal Schwartz to fix bug introduced by cross-site
scripting vulnerability "fix."
@@ -607,7 +821,7 @@
Version 2.83
1. Fixed autoEscape() documentation inconsistencies.
- 2. Patch from Ville Skytt� to fix a number of XHTML 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
@@ -1062,7 +1276,7 @@
21. Fixed warning in initialize_globals() under mod_perl.
22. File uploads from Macintosh versions of MSIE should now work.
23. Pragmas now preceded by dashes (-nph) rather than colons (:nph).
- Old style is supported for backward compatability.
+ Old style is supported for backward compatibility.
24. Can now pass arguments to all functions using {} brackets,
resolving historical inconsistencies.
25. Removed autoloader warnings about absent MultipartBuffer::DESTROY.
@@ -1294,7 +1508,7 @@
1. Added cookie() support routines.
2. Added -expires parameter to header().
- 3. Added cgi-lib.pl compatability mode.
+ 3. Added cgi-lib.pl compatibility mode.
4. Made the module more configurable for different operating systems.
5. Fixed a dumb bug in JavaScript button() method.
@@ -1424,7 +1638,7 @@
1. The user_agent() method is now documented;
2. A potential security hole in import() is now plugged.
- 3. Changed name of import() to import_names() for compatability with
+ 3. Changed name of import() to import_names() for compatibility with
CGI:: modules.
Bug fixes in version 1.53
diff -Naur perl-5.12.4/cpan/CGI/lib/CGI/Carp.pm CGI.pm-3.59/cpan/CGI/lib/CGI/Carp.pm
--- perl-5.12.4/cpan/CGI/lib/CGI/Carp.pm 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/lib/CGI/Carp.pm 2011-01-05 10:13:45.000000000 -0800
@@ -116,7 +116,7 @@
Nonfatal errors will still be directed to the log file only (unless redirected
with carpout).
-Note that fatalsToBrowser does B<not> work with mod_perl version 2.0
+Note that fatalsToBrowser may B<not> work well with mod_perl version 2.0
and higher.
=head2 Changing the default message
@@ -183,6 +183,28 @@
this module's functionality, or this module may interfere with
your module's functionality.
+=head2 SUPPRESSING PERL ERRORS APPEARING IN THE BROWSER WINDOW
+
+A problem sometimes encountered when using fatalsToBrowser is
+when a C<die()> is done inside an C<eval> body or expression.
+Even though the
+fatalsToBrower support takes precautions to avoid this,
+you still may get the error message printed to STDOUT.
+This may have some undesireable effects when the purpose of doing the
+eval is to determine which of several algorithms is to be used.
+
+By setting C<$CGI::Carp::TO_BROWSER> to 0 you can suppress printing the C<die> messages
+but without all of the complexity of using C<set_die_handler>.
+You can localize this effect to inside C<eval> bodies if this is desireable:
+For example:
+
+ eval {
+ local $CGI::Carp::TO_BROWSER = 0;
+ die "Fatal error messages not sent browser"
+ }
+ # $@ will contain error message
+
+
=head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
It is now also possible to make non-fatal errors appear as HTML
@@ -245,6 +267,8 @@
=head1 CHANGE LOG
+3.51 Added $CGI::Carp::TO_BROWSER
+
1.29 Patch from Peter Whaite to fix the unfixable problem of CGI::Carp
not behaving correctly in an eval() context.
@@ -321,9 +345,10 @@
$main::SIG{__WARN__}=\&CGI::Carp::warn;
-$CGI::Carp::VERSION = '3.45';
+$CGI::Carp::VERSION = '3.51';
$CGI::Carp::CUSTOM_MSG = undef;
$CGI::Carp::DIE_HANDLER = undef;
+$CGI::Carp::TO_BROWSER = 1;
# fancy import routine detects and handles 'errorWrap' specially.
@@ -421,23 +446,27 @@
}
sub die {
- my ($arg,@rest) = @_;
+ # if no argument is passed, propagate $@ like
+ # the real die
+ my ($arg,@rest) = @_ ? @_
+ : $@ ? "$@\t...propagated"
+ : "Died"
+ ;
&$DIE_HANDLER($arg,@rest) if $DIE_HANDLER;
+ # the "$arg" is done on purpose!
# if called as die( $object, 'string' ),
# all is stringified, just like with
# the real 'die'
$arg = join '' => "$arg", @rest if @rest;
- $arg ||= 'Died';
-
my($file,$line,$id) = id(1);
$arg .= " at $file line $line.\n" unless ref $arg or $arg=~/\n$/;
realdie $arg if ineval();
- &fatalsToBrowser($arg) if $WRAP;
+ &fatalsToBrowser($arg) if ($WRAP and $CGI::Carp::TO_BROWSER);
$arg=~s/^/ stamp() /gme if $arg =~ /\n$/ or not exists $ENV{MOD_PERL};
diff -Naur perl-5.12.4/cpan/CGI/lib/CGI/Cookie.pm CGI.pm-3.59/cpan/CGI/lib/CGI/Cookie.pm
--- perl-5.12.4/cpan/CGI/lib/CGI/Cookie.pm 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/lib/CGI/Cookie.pm 2011-01-05 10:14:15.000000000 -0800
@@ -12,23 +12,20 @@
# 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
+# 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.
-$CGI::Cookie::VERSION='1.29';
+our $VERSION='1.30';
use CGI::Util qw(rearrange unescape escape);
-use CGI;
-use overload '""' => \&as_string,
- 'cmp' => \&compare,
- 'fallback'=>1;
+use overload '""' => \&as_string, 'cmp' => \&compare, 'fallback' => 1;
my $PERLEX = 0;
# Turn on special checking for ActiveState's PerlEx
$PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
-# Turn on special checking for Doug MacEachern's modperl
+# Turn on special checking for mod_perl
# PerlEx::DBI tries to fool DBI by setting MOD_PERL
my $MOD_PERL = 0;
if (exists $ENV{MOD_PERL} && ! $PERLEX) {
@@ -60,20 +57,14 @@
my($key,$value);
my @pairs = split("[;,] ?",$raw_cookie);
- foreach (@pairs) {
- s/\s*(.*?)\s*/$1/;
- if (/^([^=]+)=(.*)/) {
- $key = $1;
- $value = $2;
- }
- else {
- $key = $_;
- $value = '';
- }
- $results{$key} = $value;
- }
- return \%results unless wantarray;
- return %results;
+ for my $pair ( @pairs ) {
+ $pair =~ s/^\s+|\s+$//g; # trim leading trailing whitespace
+ my ( $key, $value ) = split "=", $pair;
+
+ $value = defined $value ? $value : '';
+ $results{$key} = $value;
+ }
+ return wantarray ? %results : \%results;
}
sub get_raw_cookie {
@@ -93,11 +84,15 @@
sub parse {
my ($self,$raw_cookie) = @_;
+ return wantarray ? () : {} unless $raw_cookie;
+
my %results;
my @pairs = split("[;,] ?",$raw_cookie);
- foreach (@pairs) {
- s/\s*(.*?)\s*/$1/;
+ for (@pairs) {
+ s/^\s+//;
+ s/\s+$//;
+
my($key,$value) = split("=",$_,2);
# Some foreign cookies are not in name=value format, so ignore
@@ -113,49 +108,37 @@
# appear. The FIRST one in HTTP_COOKIE is the most recent version.
$results{$key} ||= $self->new(-name=>$key,-value=>\@values);
}
- return \%results unless wantarray;
- return %results;
+ return wantarray ? %results : \%results;
}
sub new {
- my $class = shift;
- $class = ref($class) if ref($class);
- # Ignore mod_perl request object--compatability with Apache::Cookie.
- shift if ref $_[0]
- && eval { $_[0]->isa('Apache::Request::Req') || $_[0]->isa('Apache') };
- my($name,$value,$path,$domain,$secure,$expires,$httponly) =
- rearrange([ 'NAME', ['VALUE','VALUES'], qw/ PATH DOMAIN SECURE EXPIRES
- HTTPONLY / ], @_);
-
- # Pull out our parameters.
- my @values;
- if (ref($value)) {
- if (ref($value) eq 'ARRAY') {
- @values = @$value;
- } elsif (ref($value) eq 'HASH') {
- @values = %$value;
- }
- } else {
- @values = ($value);
- }
-
- bless my $self = {
- 'name'=>$name,
- 'value'=>[@values],
- },$class;
-
- # IE requires the path and domain to be present for some reason.
- $path ||= "/";
- # however, this breaks networks which use host tables without fully qualified
- # names, so we comment it out.
- # $domain = CGI::virtual_host() unless defined $domain;
-
- $self->path($path) if defined $path;
- $self->domain($domain) if defined $domain;
- $self->secure($secure) if defined $secure;
- $self->expires($expires) if defined $expires;
- $self->httponly($httponly) if defined $httponly;
-# $self->max_age($expires) if defined $expires;
+ 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 )
+ = rearrange(
+ [
+ 'NAME', [ 'VALUE', 'VALUES' ],
+ 'PATH', 'DOMAIN',
+ 'SECURE', 'EXPIRES',
+ 'MAX-AGE','HTTPONLY'
+ ],
+ @params
+ );
+ return undef unless defined $name and defined $value;
+ my $self = {};
+ bless $self, $class;
+ $self->name( $name );
+ $self->value( $value );
+ $path ||= "/";
+ $self->path( $path ) if defined $path;
+ $self->domain( $domain ) if defined $domain;
+ $self->secure( $secure ) if defined $secure;
+ $self->expires( $expires ) if defined $expires;
+ $self->max_age($expires) if defined $max_age;
+ $self->httponly( $httponly ) if defined $httponly;
return $self;
}
@@ -163,23 +146,24 @@
my $self = shift;
return "" unless $self->name;
- my(@constant_values,$domain,$path,$expires,$max_age,$secure,$httponly);
+ no warnings; # some things may be undefined, that's OK.
+
+ my $name = escape( $self->name );
+ my $value = join "&", map { escape($_) } $self->value;
+ my @cookie = ( "$name=$value" );
+
+ push @cookie,"domain=".$self->domain if $self->domain;
+ push @cookie,"path=".$self->path if $self->path;
+ push @cookie,"expires=".$self->expires if $self->expires;
+ push @cookie,"max-age=".$self->max_age if $self->max_age;
+ push @cookie,"secure" if $self->secure;
+ push @cookie,"HttpOnly" if $self->httponly;
- push(@constant_values,"domain=$domain") if $domain = $self->domain;
- push(@constant_values,"path=$path") if $path = $self->path;
- push(@constant_values,"expires=$expires") if $expires = $self->expires;
- push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age;
- push(@constant_values,"secure") if $secure = $self->secure;
- push(@constant_values,"HttpOnly") if $httponly = $self->httponly;
-
- my($key) = escape($self->name);
- my($cookie) = join("=",(defined $key ? $key : ''),join("&",map escape(defined $_ ? $_ : ''),$self->value));
- return join("; ",$cookie,@constant_values);
+ return join "; ", @cookie;
}
sub compare {
- my $self = shift;
- my $value = shift;
+ my ( $self, $value ) = @_;
return "$self" cmp $value;
}
@@ -194,6 +178,7 @@
if ($r) {
$r->headers_out->add('Set-Cookie' => $self->as_string);
} else {
+ require CGI;
print CGI::header(-cookie => $self);
}
@@ -201,70 +186,56 @@
# accessors
sub name {
- my $self = shift;
- my $name = shift;
+ my ( $self, $name ) = @_;
$self->{'name'} = $name if defined $name;
return $self->{'name'};
}
sub value {
- my $self = shift;
- my $value = shift;
- if (defined $value) {
- my @values;
- if (ref($value)) {
- if (ref($value) eq 'ARRAY') {
- @values = @$value;
- } elsif (ref($value) eq 'HASH') {
- @values = %$value;
- }
- } else {
- @values = ($value);
- }
- $self->{'value'} = [@values];
- }
- return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0]
+ my ( $self, $value ) = @_;
+ if ( defined $value ) {
+ my @values
+ = ref $value eq 'ARRAY' ? @$value
+ : ref $value eq 'HASH' ? %$value
+ : ( $value );
+ $self->{'value'} = [@values];
+ }
+ return wantarray ? @{ $self->{'value'} } : $self->{'value'}->[0];
}
sub domain {
- my $self = shift;
- my $domain = shift;
+ my ( $self, $domain ) = @_;
$self->{'domain'} = lc $domain if defined $domain;
return $self->{'domain'};
}
sub secure {
- my $self = shift;
- my $secure = shift;
+ my ( $self, $secure ) = @_;
$self->{'secure'} = $secure if defined $secure;
return $self->{'secure'};
}
sub expires {
- my $self = shift;
- my $expires = shift;
+ my ( $self, $expires ) = @_;
$self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires;
return $self->{'expires'};
}
sub max_age {
- my $self = shift;
- my $expires = shift;
- $self->{'max-age'} = CGI::Util::expire_calc($expires)-time() if defined $expires;
- return $self->{'max-age'};
+ my ( $self, $max_age ) = @_;
+ $self->{'max-age'} = CGI::Util::expire_calc($max_age)-time() if defined $max_age;
+ return $self->{'max-age'};
}
sub path {
- my $self = shift;
- my $path = shift;
+ my ( $self, $path ) = @_;
$self->{'path'} = $path if defined $path;
return $self->{'path'};
}
sub httponly { # HttpOnly
- my $self = shift;
- my $httponly = shift;
+ my ( $self, $httponly ) = @_;
$self->{'httponly'} = $httponly if defined $httponly;
return $self->{'httponly'};
}
@@ -273,7 +244,7 @@
=head1 NAME
-CGI::Cookie - Interface to Netscape Cookies
+CGI::Cookie - Interface to HTTP Cookies
=head1 SYNOPSIS
@@ -281,23 +252,23 @@
use CGI::Cookie;
# Create new cookies and send them
- $cookie1 = new CGI::Cookie(-name=>'ID',-value=>123456);
- $cookie2 = new CGI::Cookie(-name=>'preferences',
+ $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 = fetch CGI::Cookie;
+ %cookies = CGI::Cookie->fetch;
$id = $cookies{'ID'}->value;
# create cookies returned from an external source
- %cookies = parse CGI::Cookie($ENV{COOKIE});
+ %cookies = CGI::Cookie->parse($ENV{COOKIE});
=head1 DESCRIPTION
-CGI::Cookie is an interface to Netscape (HTTP/1.1) cookies, an
+CGI::Cookie is an interface to HTTP/1.1 cookies, an
innovation 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
@@ -305,7 +276,9 @@
For full information on cookies see
- http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt
+ http://tools.ietf.org/html/rfc2109
+ http://tools.ietf.org/html/rfc2965
+ http://tools.ietf.org/html/draft-ietf-httpstate-cookie
=head1 USING CGI::Cookie
@@ -332,7 +305,7 @@
This is a partial or complete domain name for which the cookie is
valid. The browser will return the cookie to any host that matches
the partial domain name. For example, if you specify a domain name
-of ".capricorn.com", then Netscape will return the cookie to
+of ".capricorn.com", then the browser will return the cookie to
Web servers running on any of the machines "www.capricorn.com",
"ftp.capricorn.com", "feckless.capricorn.com", etc. Domain names
must contain at least two periods to prevent attempts to match
@@ -355,24 +328,25 @@
If the "secure" attribute is set, the cookie will only be sent to your
script if the CGI request is occurring on a secure channel, such as SSL.
-=item B<4. httponly flag>
+=item B<5. httponly flag>
If the "httponly" attribute is set, the cookie will only be accessible
through HTTP Requests. This cookie will be inaccessible via JavaScript
(to prevent XSS attacks).
-But, currently this feature only used and recognised by
-MS Internet Explorer 6 Service Pack 1 and later.
+This feature is only supported by recent browsers like Internet Explorer
+6 Service Pack 1, Firefox 3.0 and Opera 9.5 (and later of course).
-See this URL for more information:
+See these URLs for more information:
-L<http://msdn.microsoft.com/en-us/library/ms533046%28VS.85%29.aspx>
+ http://msdn.microsoft.com/en-us/library/ms533046.aspx
+ http://www.owasp.org/index.php/HTTPOnly#Browsers_Supporting_HTTPOnly
=back
=head2 Creating New Cookies
- my $c = new CGI::Cookie(-name => 'foo',
+ my $c = CGI::Cookie->new(-name => 'foo',
-value => 'bar',
-expires => '+3M',
-domain => '.capricorn.com',
@@ -390,6 +364,14 @@
recognized by CGI.pm, for example "+3M" for three months in the
future. See CGI.pm's documentation for details.
+B<-max-age> accepts the same data formats as B<< -expires >>, but sets a
+relative value instead of an absolute like B<< -expires >>. This is intended to be
+more secure since a clock could be changed to fake an absolute time. In
+practice, as of 2011, C<< -max-age >> still does not enjoy the widespread support
+that C<< -expires >> has. You can set both, and browsers that support
+C<< -max-age >> should ignore the C<< Expires >> header. The drawback
+to this approach is the bit of bandwidth for sending an extra header on each cookie.
+
B<-domain> points to a domain name or to a fully qualified host name.
If not specified, the cookie will be returned only to the Web server
that created it.
@@ -409,7 +391,7 @@
a mod_perl request object as the first argument to C<new()>. It will
simply be ignored:
- my $c = new CGI::Cookie($r,
+ my $c = CGI::Cookie->new($r,
-name => 'foo',
-value => ['bar','baz']);
@@ -420,6 +402,10 @@
$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);
@@ -428,7 +414,7 @@
a cookie to the browser by creating one or more Set-Cookie: fields in the
HTTP header. Here is a typical sequence:
- my $c = new CGI::Cookie(-name => 'foo',
+ my $c = CGI::Cookie->new(-name => 'foo',
-value => ['bar','baz'],
-expires => '+3M');
@@ -456,14 +442,14 @@
=head2 Recovering Previous Cookies
- %cookies = fetch CGI::Cookie;
+ %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 = fetch CGI::Cookie;
- foreach (keys %cookies) {
+ %cookies = CGI::Cookie->fetch;
+ for (keys %cookies) {
do_something($cookies{$_});
}
@@ -479,13 +465,16 @@
form using the parse() class method:
$COOKIES = `cat /usr/tmp/Cookie_stash`;
- %cookies = parse CGI::Cookie($COOKIES);
+ %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
+contact, 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
@@ -546,4 +535,6 @@
L<CGI::Carp>, L<CGI>
+L<RFC 2109|http://www.ietf.org/rfc/rfc2109.txt>, L<RFC 2695|http://www.ietf.org/rfc/rfc2965.txt>
+
=cut
diff -Naur perl-5.12.4/cpan/CGI/lib/CGI/Fast.pm CGI.pm-3.59/cpan/CGI/lib/CGI/Fast.pm
--- perl-5.12.4/cpan/CGI/lib/CGI/Fast.pm 2011-06-01 00:47:46.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/lib/CGI/Fast.pm 2011-11-09 07:49:15.000000000 -0800
@@ -19,7 +19,7 @@
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
-$CGI::Fast::VERSION='1.08';
+$CGI::Fast::VERSION='1.09';
use CGI;
use FCGI;
@@ -43,27 +43,23 @@
# in this package variable.
use vars qw($Ext_Request);
BEGIN {
- # If ENV{FCGI_SOCKET_PATH} is given, explicitly open the socket,
- # and keep the request handle around from which to call Accept().
- if ($ENV{FCGI_SOCKET_PATH}) {
- my $path = $ENV{FCGI_SOCKET_PATH};
- my $backlog = $ENV{FCGI_LISTEN_QUEUE} || 100;
- my $socket = FCGI::OpenSocket( $path, $backlog );
- $Ext_Request = FCGI::Request( \*STDIN, \*STDOUT, \*STDERR,
- \%ENV, $socket, 1 );
- }
+ # If ENV{FCGI_SOCKET_PATH} is given, explicitly open the socket.
+ if ($ENV{FCGI_SOCKET_PATH}) {
+ my $path = $ENV{FCGI_SOCKET_PATH};
+ my $backlog = $ENV{FCGI_LISTEN_QUEUE} || 100;
+ my $socket = FCGI::OpenSocket( $path, $backlog );
+ $Ext_Request = FCGI::Request( \*STDIN, \*STDOUT, \*STDERR,
+ \%ENV, $socket, 1 );
+ }
+ else {
+ $Ext_Request = FCGI::Request();
+ }
}
-# New is slightly different in that it calls FCGI's
-# accept() method.
sub new {
my ($self, $initializer, @param) = @_;
unless (defined $initializer) {
- if ($Ext_Request) {
- return undef unless $Ext_Request->Accept() >= 0;
- } else {
- return undef unless FCGI::accept() >= 0;
- }
+ return undef unless $Ext_Request->Accept() >= 0;
}
CGI->_reset_globals;
$self->_setup_symbols(@CGI::SAVED_SYMBOLS) if @CGI::SAVED_SYMBOLS;
diff -Naur perl-5.12.4/cpan/CGI/lib/CGI/Pretty.pm CGI.pm-3.59/cpan/CGI/lib/CGI/Pretty.pm
--- perl-5.12.4/cpan/CGI/lib/CGI/Pretty.pm 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/lib/CGI/Pretty.pm 2011-01-05 10:13:45.000000000 -0800
@@ -252,7 +252,7 @@
=head2 Recommendation for when to use CGI::Pretty
CGI::Pretty is far slower than using CGI.pm directly. A benchmark showed that
-it could be about 10 times slower. Adding newslines and spaces may alter the
+it could be about 10 times slower. Adding newlines and spaces may alter the
rendered appearance of HTML. Also, the extra newlines and spaces also make the
file size larger, making the files take longer to download.
diff -Naur perl-5.12.4/cpan/CGI/lib/CGI/Push.pm CGI.pm-3.59/cpan/CGI/lib/CGI/Push.pm
--- perl-5.12.4/cpan/CGI/lib/CGI/Push.pm 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/lib/CGI/Push.pm 2011-01-05 10:13:45.000000000 -0800
@@ -16,7 +16,7 @@
# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::Push::VERSION='1.04';
+$CGI::Push::VERSION='1.05';
use CGI;
use CGI::Util 'rearrange';
@ISA = ('CGI');
@@ -214,7 +214,7 @@
This optional parameter indicates the content type of each page. It
defaults to "text/html". Normally the module assumes that each page
-is of a homogenous MIME type. However if you provide either of the
+is of a homogeneous MIME type. However if you provide either of the
magic values "heterogeneous" or "dynamic" (the latter provided for the
convenience of those who hate long parameter names), you can specify
the MIME type -- and other header fields -- on a per-page basis. See
diff -Naur perl-5.12.4/cpan/CGI/lib/CGI/Util.pm CGI.pm-3.59/cpan/CGI/lib/CGI/Util.pm
--- perl-5.12.4/cpan/CGI/lib/CGI/Util.pm 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/lib/CGI/Util.pm 2011-04-28 07:34:54.000000000 -0700
@@ -1,17 +1,17 @@
package CGI::Util;
-
+require 5.008001;
use strict;
-use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A);
require Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape
expires ebcdic2ascii ascii2ebcdic);
-$VERSION = '3.48';
+our $VERSION = '3.53';
+
+use constant EBCDIC => "\t" ne "\011";
-$EBCDIC = "\t" ne "\011";
# (ord('^') == 95) for codepage 1047 as on os390, vmesa
-@A2E = (
+our @A2E = (
0, 1, 2, 3, 55, 45, 46, 47, 22, 5, 21, 11, 12, 13, 14, 15,
16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
@@ -29,7 +29,7 @@
68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
);
-@E2A = (
+our @E2A = (
0, 1, 2, 3,156, 9,134,127,151,141,142, 11, 12, 13, 14, 15,
16, 17, 18, 19,157, 10, 8,135, 24, 25,146,143, 28, 29, 30, 31,
128,129,130,131,132,133, 23, 27,136,137,138,139,140, 5, 6, 7,
@@ -48,7 +48,7 @@
48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
);
-if ($EBCDIC && ord('^') == 106) { # as in the BS2000 posix-bc coded character set
+if (EBCDIC && ord('^') == 106) { # as in the BS2000 posix-bc coded character set
$A2E[91] = 187; $A2E[92] = 188; $A2E[94] = 106; $A2E[96] = 74;
$A2E[123] = 251; $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95;
$A2E[162] = 176; $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186;
@@ -61,7 +61,7 @@
$E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125;
$E2A[255] = 126;
}
-elsif ($EBCDIC && ord('^') == 176) { # as in codepage 037 on os400
+elsif (EBCDIC && ord('^') == 176) { # as in codepage 037 on os400
$A2E[10] = 37; $A2E[91] = 186; $A2E[93] = 187; $A2E[94] = 176;
$A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173;
@@ -161,47 +161,10 @@
}
sub utf8_chr {
- my $c = shift(@_);
- if ($] >= 5.006){
- require utf8;
- my $u = chr($c);
- utf8::encode($u); # drop utf8 flag
- return $u;
- }
- if ($c < 0x80) {
- return sprintf("%c", $c);
- } elsif ($c < 0x800) {
- return sprintf("%c%c", 0xc0 | ($c >> 6), 0x80 | ($c & 0x3f));
- } elsif ($c < 0x10000) {
- return sprintf("%c%c%c",
- 0xe0 | ($c >> 12),
- 0x80 | (($c >> 6) & 0x3f),
- 0x80 | ( $c & 0x3f));
- } elsif ($c < 0x200000) {
- return sprintf("%c%c%c%c",
- 0xf0 | ($c >> 18),
- 0x80 | (($c >> 12) & 0x3f),
- 0x80 | (($c >> 6) & 0x3f),
- 0x80 | ( $c & 0x3f));
- } elsif ($c < 0x4000000) {
- return sprintf("%c%c%c%c%c",
- 0xf8 | ($c >> 24),
- 0x80 | (($c >> 18) & 0x3f),
- 0x80 | (($c >> 12) & 0x3f),
- 0x80 | (($c >> 6) & 0x3f),
- 0x80 | ( $c & 0x3f));
-
- } elsif ($c < 0x80000000) {
- return sprintf("%c%c%c%c%c%c",
- 0xfc | ($c >> 30),
- 0x80 | (($c >> 24) & 0x3f),
- 0x80 | (($c >> 18) & 0x3f),
- 0x80 | (($c >> 12) & 0x3f),
- 0x80 | (($c >> 6) & 0x3f),
- 0x80 | ( $c & 0x3f));
- } else {
- return utf8_chr(0xfffd);
- }
+ my $c = shift(@_);
+ my $u = chr($c);
+ utf8::encode($u); # drop utf8 flag
+ return $u;
}
# unescape URL-encoded data
@@ -210,10 +173,10 @@
my $todecode = shift;
return undef unless defined($todecode);
$todecode =~ tr/+/ /; # pluses become spaces
- if ($EBCDIC) {
+ if (EBCDIC) {
$todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
} else {
- # handle surrogate pairs first -- dankogai
+ # handle surrogate pairs first -- dankogai. Ref: http://unicode.org/faq/utf_bom.html#utf16-2
$todecode =~ s{
%u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi
%u([Dd][c-fC-F][0-9a-fA-F]{2}) # lo
@@ -235,7 +198,7 @@
# We cannot use the %u escapes, they were rejected by W3C, so the official
# way is %XX-escaped utf-8 encoding.
# Naturally, Unicode strings have to be converted to their utf-8 byte
-# representation. (No action is required on 5.6.)
+# representation.
# Byte strings were traditionally used directly as a sequence of octets.
# This worked if they actually represented binary data (i.e. in CGI::Compress).
# This also worked if these byte strings were actually utf-8 encoded; e.g.,
@@ -244,39 +207,14 @@
# was always so and cannot be fixed without breaking the binary data case.
# -- Stepan Kasal <[email protected]>
#
-if ($] == 5.008) {
- package utf8;
-
- no warnings 'redefine'; # needed for Perl 5.8.1+
-
- my $is_utf8_redefinition = <<'EOR';
- sub is_utf8 {
- my ($text) = @_;
-
- my $ctext = pack q{C0a*}, $text;
-
- return ($text ne $ctext) && ($ctext =~ m/^(
- [\x09\x0A\x0D\x20-\x7E]
- | [\xC2-\xDF][\x80-\xBF]
- | \xE0[\xA0-\xBF][\x80-\xBF]
- | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}
- | \xED[\x80-\x9F][\x80-\xBF]
- | \xF0[\x90-\xBF][\x80-\xBF]{2}
- | [\xF1-\xF3][\x80-\xBF]{3}
- | \xF4[\x80-\x8F][\x80-\xBF]{2}
- )*$/xo);
- }
-EOR
-
- eval $is_utf8_redefinition;
-}
sub escape {
+ # If we being called in an OO-context, discard the first argument.
shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
my $toencode = shift;
return undef unless defined($toencode);
- utf8::encode($toencode) if ($] >= 5.008 && utf8::is_utf8($toencode));
- if ($EBCDIC) {
+ utf8::encode($toencode) if utf8::is_utf8($toencode);
+ if (EBCDIC) {
$toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
} else {
$toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",ord($1))/eg;
@@ -340,7 +278,8 @@
} else {
return $time;
}
- return (time+$offset);
+ my $cur_time = time;
+ return ($cur_time+$offset);
}
sub ebcdic2ascii {
@@ -373,7 +312,7 @@
=head1 AUTHOR INFORMATION
-Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
+Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -383,7 +322,7 @@
Perl, the name and version of your Web server, and the name and
version of the operating system you are using. If the problem is even
remotely browser dependent, please provide information about the
-affected browers as well.
+affected browsers as well.
=head1 SEE ALSO
diff -Naur perl-5.12.4/cpan/CGI/lib/CGI.pm CGI.pm-3.59/cpan/CGI/lib/CGI.pm
--- perl-5.12.4/cpan/CGI/lib/CGI.pm 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/lib/CGI.pm 2011-12-30 05:31:41.000000000 -0800
@@ -1,5 +1,5 @@
package CGI;
-require 5.004;
+require 5.008001;
use Carp 'croak';
# See the bottom of this file for the POD documentation. Search for the
@@ -16,10 +16,11 @@
# listing the modifications you have made.
# The most recent version and complete docs are available at:
-# http://stein.cshl.org/WWW/software/CGI/
+# http://search.cpan.org/dist/CGI.pm
+# The revision is no longer being updated since moving to git.
$CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $';
-$CGI::VERSION='3.49';
+$CGI::VERSION='3.59';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -385,7 +386,7 @@
# user is still holding any reference to them as well.
sub DESTROY {
my $self = shift;
- if ($OS eq 'WINDOWS') {
+ if ($OS eq 'WINDOWS' || $OS eq 'VMS') {
for my $href (values %{$self->{'.tmpfiles'}}) {
$href->{hndl}->DESTROY if defined $href->{hndl};
$href->{name}->DESTROY if defined $href->{name};
@@ -524,7 +525,7 @@
# if we get called more than once, we want to initialize
# ourselves from the original query (which may be gone
# if it was read from STDIN originally.)
- if (defined(@QUERY_PARAM) && !defined($initializer)) {
+ if (@QUERY_PARAM && !defined($initializer)) {
for my $name (@QUERY_PARAM) {
my $val = $QUERY_PARAM{$name}; # always an arrayref;
$self->param('-name'=>$name,'-value'=> $val);
@@ -647,9 +648,9 @@
last METHOD;
}
- # If method is GET or HEAD, fetch the query from
+ # If method is GET, HEAD or DELETE, fetch the query from
# the environment.
- if ($is_xforms || $meth=~/^(GET|HEAD)$/) {
+ if ($is_xforms || $meth=~/^(GET|HEAD|DELETE)$/) {
if ($MOD_PERL) {
$query_string = $self->r->args;
} else {
@@ -663,14 +664,6 @@
if ( $content_length > 0 ) {
$self->read_from_client(\$query_string,$content_length,0);
}
- elsif (not defined $ENV{CONTENT_LENGTH}) {
- $self->read_from_stdin(\$query_string);
- # should this be PUTDATA in case of PUT ?
- my($param) = $meth . 'DATA' ;
- $self->add_parameter($param) ;
- push (@{$self->{param}{$param}},$query_string);
- undef $query_string ;
- }
# Some people want to have their cake and eat it too!
# Uncomment this line to have the contents of the query string
# APPENDED to the POST data.
@@ -1023,47 +1016,6 @@
}
END_OF_FUNC
-'read_from_stdin' => <<'END_OF_FUNC',
-# Read data from stdin until all is read
-sub read_from_stdin {
- my($self, $buff) = @_;
- local $^W=0; # prevent a warning
-
- #
- # TODO: loop over STDIN until all is read
- #
-
- my($eoffound) = 0;
- my($localbuf) = '';
- my($tempbuf) = '';
- my($bufsiz) = 1024;
- my($res);
- while ($eoffound == 0) {
- if ( $MOD_PERL ) {
- $res = $self->r->read($tempbuf, $bufsiz, 0)
- }
- else {
- $res = read(\*STDIN, $tempbuf, $bufsiz);
- }
-
- if ( !defined($res) ) {
- # TODO: how to do error reporting ?
- $eoffound = 1;
- last;
- }
- if ( $res == 0 ) {
- $eoffound = 1;
- last;
- }
- $localbuf .= $tempbuf;
- }
-
- $$buff = $localbuf;
-
- return $res;
-}
-END_OF_FUNC
-
'delete' => <<'END_OF_FUNC',
#### Method: delete
# Deletes the named parameter entirely.
@@ -1570,12 +1522,8 @@
$type ||= 'text/html' unless defined($type);
- if (defined $charset) {
- $self->charset($charset);
- } else {
- $charset = $self->charset if $type =~ /^text\//;
- }
- $charset ||= '';
+ # sets if $charset is given, gets if not
+ $charset = $self->charset( $charset );
# rearrange() was designed for the HTML portion, so we
# need to fix it up a little.
@@ -1629,7 +1577,6 @@
}
END_OF_FUNC
-
#### Method: cache
# Control whether header() will produce the no-cache
# Pragma directive.
@@ -1861,20 +1808,20 @@
my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script);
for $script (@scripts) {
- my($src,$code,$language);
- if (ref($script)) { # script is a hash
- ($src,$code,$type) =
- rearrange(['SRC','CODE',['LANGUAGE','TYPE']],
- '-foo'=>'bar', # a trick to allow the '-' to be omitted
- ref($script) eq 'ARRAY' ? @$script : %$script);
+ my($src,$code,$language,$charset);
+ if (ref($script)) { # script is a hash
+ ($src,$code,$type,$charset) =
+ rearrange(['SRC','CODE',['LANGUAGE','TYPE'],'CHARSET'],
+ '-foo'=>'bar', # a trick to allow the '-' to be omitted
+ ref($script) eq 'ARRAY' ? @$script : %$script);
$type ||= 'text/javascript';
unless ($type =~ m!\w+/\w+!) {
$type =~ s/[\d.]+$//;
$type = "text/$type";
}
- } else {
- ($src,$code,$type) = ('',$script, 'text/javascript');
- }
+ } else {
+ ($src,$code,$type,$charset) = ('',$script, 'text/javascript', '');
+ }
my $comment = '//'; # javascript by default
$comment = '#' if $type=~/perl|tcl/i;
@@ -1892,6 +1839,7 @@
my(@satts);
push(@satts,'src'=>$src) if $src;
push(@satts,'type'=>$type);
+ push(@satts,'charset'=>$charset) if ($src && $charset);
$code = $cdata_start . $code . $cdata_end if defined $code;
push(@result,$self->script({@satts},$code || ''));
}
@@ -2859,7 +2807,6 @@
my $query_str = $self->query_string;
my $rewrite_in_use = $request_uri && $request_uri !~ /^\Q$script_name/;
- undef $path if $rewrite_in_use && $rewrite; # path not valid when rewriting active
my $uri = $rewrite && $request_uri ? $request_uri : $script_name;
$uri =~ s/\?.*$//s; # remove query string
@@ -2961,6 +2908,8 @@
sub param_fetch {
my($self,@p) = self_or_default(@_);
my($name) = rearrange([NAME],@p);
+ return [] unless defined $name;
+
unless (exists($self->{param}{$name})) {
$self->add_parameter($name);
$self->{param}{$name} = [];
@@ -3532,11 +3481,11 @@
if ($DEBUG && @ARGV) {
@words = @ARGV;
} elsif ($DEBUG > 1) {
- require "shellwords.pl";
+ require Text::ParseWords;
print STDERR "(offline mode: enter name=value pairs on standard input; press ^D or ^Z when done)\n";
chomp(@lines = <STDIN>); # remove newlines
$input = join(" ",@lines);
- @words = &shellwords($input);
+ @words = &Text::ParseWords::old_shellwords($input);
}
for (@words) {
s/\\=/%3D/g;
@@ -3636,7 +3585,7 @@
last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES));
$seqno += int rand(100);
}
- die "CGI open of tmpfile: $!\n" unless defined $filehandle;
+ die "CGI.pm open of tmpfile $tmp/$filename failed: $!\n" unless defined $filehandle;
$CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode
&& defined fileno($filehandle);
@@ -4271,7 +4220,10 @@
sub new {
my($package,$sequence) = @_;
my $filename;
- find_tempdir() unless -w $TMPDIRECTORY;
+ unless (-w $TMPDIRECTORY) {
+ $TMPDIRECTORY = undef;
+ find_tempdir();
+ }
for (my $i = 0; $i < $MAXTRIES; $i++) {
last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d", $TMPDIRECTORY, $sequence++));
}
@@ -4522,7 +4474,7 @@
$query = CGI->new;
-This will parse the input (from both POST and GET methods) and store
+This will parse the input (from POST, GET and DELETE methods) and store
it into a perl5 object called $query.
Any filehandles from file uploads will have their position reset to
@@ -4721,9 +4673,10 @@
unshift @{$q->param_fetch(-name=>'address')},'George Munster';
If you need access to the parameter list in a way that isn't covered
-by the methods above, you can obtain a direct reference to it by
-calling the B<param_fetch()> method with the name of the . This
-will return an array reference to the named parameters, which you then
+by the methods given in the previous sections, you can obtain a direct
+reference to it by
+calling the B<param_fetch()> method with the name of the parameter. This
+will return an array reference to the named parameter, which you then
can manipulate in any way you like.
You can also use a named argument style using the B<-name> argument.
@@ -5128,8 +5081,7 @@
The temporary directory is selected using the following algorithm:
- 1. if the current user (e.g. "nobody") has a directory named
- "tmp" in its home directory, use that (Unix systems only).
+ 1. if $CGITempFile::TMPDIRECTORY is already set, use that
2. if the environment variable TMPDIR exists, use the location
indicated.
@@ -5291,17 +5243,14 @@
P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
-Note that if a header value contains a carriage return, a leading space will be
-added to each new line that doesn't already have one as specified by RFC2616
-section 4.2. For example:
-
- print header( -ingredients => "ham\neggs\nbacon" );
+CGI.pm will accept valid multi-line headers when each line is separated with a
+CRLF value ("\r\n" on most platforms) followed by at least one space. For example:
-will generate
+ print header( -ingredients => "ham\r\n\seggs\r\n\sbacon" );
- Ingredients: ham
- eggs
- bacon
+Invalid multi-line header input will trigger in an exception. When multi-line headers
+are received, CGI.pm will always output them back as a single line, according to the
+folding rules of RFC 2616: the newlines will be removed, while the white space remains.
=head2 GENERATING A REDIRECTION HEADER
@@ -5357,8 +5306,7 @@
-style=>{'src'=>'/styles/style1.css'},
-BGCOLOR=>'blue');
-After creating the HTTP header, most CGI scripts will start writing
-out an HTML document. The start_html() routine creates the top of the
+The start_html() routine creates the top of the
page, along with a lot of optional information that controls the
page's appearance and behavior.
@@ -5412,6 +5360,18 @@
The B<-encoding> argument can be used to specify the character set for
XHTML. It defaults to iso-8859-1 if not specified.
+The B<-dtd> argument can be used to specify a public DTD identifier string. For example:
+
+ -dtd => '-//W3C//DTD HTML 4.01 Transitional//EN')
+
+Alternatively, it can take public and system DTD identifiers as an array:
+
+ dtd => [ '-//W3C//DTD HTML 4.01 Transitional//EN', 'http://www.w3.org/TR/html4/loose.dtd' ]
+
+For the public DTD identifier to be considered, it must be valid. Otherwise it
+will be replaced by the default DTD. If the public DTD contains 'XHTML', CGI.pm
+will emit XML.
+
The B<-declare_xml> argument, when used in conjunction with XHTML,
will put a <?xml> declaration at the top of the HTML header. The sole
purpose of this declaration is to declare the character set
@@ -5420,11 +5380,11 @@
most validators. The default for -declare_xml is false.
You can place other arbitrary HTML elements to the <head> section with the
-B<-head> tag. For example, to place the rarely-used <link> element in the
+B<-head> tag. For example, to place a <link> element in the
head section, use this:
- print start_html(-head=>Link({-rel=>'next',
- -href=>'http://www.capricorn.com/s2.html'}));
+ print start_html(-head=>Link({-rel=>'shortcut icon',
+ -href=>'favicon.ico'}));
To incorporate multiple HTML elements into the <head> section, just pass an
array reference:
@@ -5486,12 +5446,10 @@
browsers that do not have JavaScript (or browsers where JavaScript is turned
off).
-The <script> tag, has several attributes including "type" and src.
-The latter is particularly interesting, as it allows you to keep the
-JavaScript code in a file or CGI script rather than cluttering up each
-page with the source. To use these attributes pass a HASH reference
-in the B<-script> parameter containing one or more of -type, -src, or
--code:
+The <script> tag, has several attributes including "type", "charset" and "src".
+"src" allows you to keep JavaScript code in an external file. To use these
+attributes pass a HASH reference in the B<-script> parameter containing one or
+more of -type, -src, or -code:
print $q->start_html(-title=>'The Riddle of the Sphinx',
-script=>{-type=>'JAVASCRIPT',
@@ -5527,7 +5485,7 @@
);
The option "-language" is a synonym for -type, and is supported for
-backwad compatibility.
+backwards compatibility.
The old-style positional parameters are as follows:
@@ -5558,13 +5516,13 @@
=head2 ENDING THE HTML DOCUMENT:
- print end_html
+ print $q->end_html;
This ends an HTML document by printing the </body></html> tags.
=head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
- $myself = self_url;
+ $myself = $q->self_url;
print q(<a href="$myself">I'm talking to myself.</a>);
self_url() will return a URL, that, when selected, will reinvoke
@@ -5573,7 +5531,7 @@
internal anchors but you don't want to disrupt the current contents
of the form(s). Something like this will do the trick.
- $myself = self_url;
+ $myself = $q->self_url;
print "<a href=\"$myself#table1\">See table 1</a>";
print "<a href=\"$myself#table2\">See table 2</a>";
print "<a href=\"$myself#yourself\">See for yourself</a>";
@@ -5583,7 +5541,10 @@
You can also retrieve the unprocessed query string with query_string():
- $the_string = query_string;
+ $the_string = $q->query_string();
+
+The behavior of calling query_string is currently undefined when the HTTP method is
+something other than GET.
=head2 OBTAINING THE SCRIPT'S URL
@@ -5645,9 +5606,7 @@
info probably won't match the request that the user sent. Set
-rewrite=>1 (default) to return URLs that match what the user sent
(the original request URI). Set -rewrite=>0 to return URLs that match
-the URL after mod_rewrite's rules have run. Because the additional
-path information only makes sense in the context of the rewritten URL,
--rewrite is set to false when you request path info in the URL.
+the URL after mod_rewrite's rules have run.
=back
@@ -5672,14 +5631,8 @@
=head1 CREATING STANDARD HTML ELEMENTS:
-CGI.pm defines general HTML shortcut methods for most, if not all of
-the HTML 3 and HTML 4 tags. HTML shortcuts are named after a single
-HTML element and return a fragment of HTML text that you can then
-print or manipulate as you like. Each shortcut returns a fragment of
-HTML code that you can append to a string, save to a file, or, most
-commonly, print out so that it displays in the browser window.
-
-This example shows how to use the HTML methods:
+CGI.pm defines general HTML shortcut methods for many HTML tags. HTML shortcuts are named after a single
+HTML element and return a fragment of HTML text. Example:
print $q->blockquote(
"Many years ago on the island of",
@@ -5935,7 +5888,7 @@
$query->autoEscape(0);
Note that autoEscape() is exclusively used to effect the behavior of how some
-CGI.pm HTML generation fuctions handle escaping. Calling escapeHTML()
+CGI.pm HTML generation functions handle escaping. Calling escapeHTML()
explicitly will always escape the HTML.
I<A Lurking Trap!> Some of the form-element generating methods return
@@ -5985,7 +5938,7 @@
method: POST
action: this script
enctype: application/x-www-form-urlencoded for non-XHTML
- multipart/form-data for XHTML, see mulitpart/form-data below.
+ multipart/form-data for XHTML, see multipart/form-data below.
end_form() returns the closing </form> tag.
@@ -6228,7 +6181,7 @@
=head3 Basics
-When the form is processed, you can retrieve an L<IO::Handle> compatibile
+When the form is processed, you can retrieve an L<IO::Handle> compatible
handle for a file upload field like this:
$lightweight_fh = $q->upload('field_name');
@@ -6316,7 +6269,7 @@
CGI.pm gives you low-level access to file upload management through
a file upload hook. You can use this feature to completely turn off
the temp file storage of file uploads, or potentially write your own
-file upload progess meter.
+file upload progress meter.
This is much like the UPLOAD_HOOK facility available in L<Apache::Request>, with
the exception that the first argument to the callback is an L<Apache::Upload>
@@ -6369,7 +6322,7 @@
To solve this problem the upload() method was added, which always returns a
lightweight filehandle. This generally works well, but will have trouble
interoperating with some other modules because the file handle is not derived
-from L<IO::Handle>. So that brings us to current recommedation given above,
+from L<IO::Handle>. So that brings us to current recommendation given above,
which is to call the handle() method on the file handle returned by upload().
That upgrades the handle to an IO::Handle. It's a big win for compatibility for
a small penalty of loading IO::Handle the first time you call it.
@@ -7608,7 +7561,7 @@
127.0.0.1 if the address is unavailable.
=item B<script_name()>
-Return the script name as a partial URL, for self-refering
+Return the script name as a partial URL, for self-referring
scripts.
=item B<referer()>
@@ -7725,7 +7678,7 @@
=item In the B<use> statement
-Simply add the "-nph" pragmato the list of symbols to be imported into
+Simply add the "-nph" pragma to the list of symbols to be imported into
your script:
use CGI qw(:standard -nph)
@@ -7911,11 +7864,13 @@
compatibility routine "ReadParse" is provided. Porting is simple:
OLD VERSION
+
require "cgi-lib.pl";
&ReadParse;
print "The value of the antique is $in{antique}.\n";
NEW VERSION
+
use CGI;
CGI::ReadParse();
print "The value of the antique is $in{antique}.\n";
@@ -7923,30 +7878,79 @@
CGI.pm's ReadParse() routine creates a tied variable named %in,
which can be accessed to obtain the query variables. Like
ReadParse, you can also provide your own variable. Infrequently
-used features of ReadParse, such as the creation of @in and $in
+used features of ReadParse, such as the creation of @in and $in
variables, are not supported.
Once you use ReadParse, you can retrieve the query object itself
this way:
$q = $in{CGI};
- print textfield(-name=>'wow',
- -value=>'does this really work?');
+ print $q->textfield(-name=>'wow',
+ -value=>'does this really work?');
This allows you to start using the more interesting features
of CGI.pm without rewriting your old scripts from scratch.
-=head1 AUTHOR INFORMATION
+An even simpler way to mix cgi-lib calls with CGI.pm calls is to import both the
+C<:cgi-lib> and C<:standard> method:
+
+ use CGI qw(:cgi-lib :standard);
+ &ReadParse;
+ print "The price of your purchase is $in{price}.\n";
+ print textfield(-name=>'price', -default=>'$1.99');
+
+=head2 Cgi-lib functions that are available in CGI.pm
+
+In compatibility mode, the following cgi-lib.pl functions are
+available for your use:
+
+ ReadParse()
+ PrintHeader()
+ HtmlTop()
+ HtmlBot()
+ SplitParam()
+ MethGet()
+ MethPost()
+
+=head2 Cgi-lib functions that are not available in CGI.pm
+
+ * Extended form of ReadParse()
+ The extended form of ReadParse() that provides for file upload
+ spooling, is not available.
+
+ * MyBaseURL()
+ This function is not available. Use CGI.pm's url() method instead.
+
+ * MyFullURL()
+ This function is not available. Use CGI.pm's self_url() method
+ instead.
+
+ * CgiError(), CgiDie()
+ These functions are not supported. Look at CGI::Carp for the way I
+ prefer to handle error messages.
+
+ * PrintVariables()
+ This function is not available. To achieve the same effect,
+ just print out the CGI object:
+
+ use CGI qw(:standard);
+ $q = CGI->new;
+ print h1("The Variables Are"),$q;
-The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein. It is
-distributed under GPL and the Artistic License 2.0.
+ * PrintEnv()
+ This function is not available. You'll have to roll your own if you really need it.
+
+=head1 AUTHOR INFORMATION
-Address bug reports and comments to: [email protected]. When sending
-bug reports, please provide the version of CGI.pm, the version of
-Perl, the name and version of your Web server, and the name and
-version of the operating system you are using. If the problem is even
-remotely browser dependent, please provide information about the
-affected browers as well.
+The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein. It is
+distributed under GPL and the Artistic License 2.0. It is currently
+maintained by Mark Stosberg with help from many contributors.
+
+Address bug reports and comments to: https://rt.cpan.org/Public/Dist/Display.html?Queue=CGI.pm
+When sending bug reports, please provide the version of CGI.pm, the version of
+Perl, the name and version of your Web server, and the name and version of the
+operating system you are using. If the problem is even remotely browser
+dependent, please provide information about the affected browsers as well.
=head1 CREDITS
diff -Naur perl-5.12.4/cpan/CGI/t/carp.t CGI.pm-3.59/cpan/CGI/t/carp.t
--- perl-5.12.4/cpan/CGI/t/carp.t 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/t/carp.t 2011-01-05 10:13:45.000000000 -0800
@@ -1,12 +1,12 @@
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
-#!/usr/local/bin/perl -w
+#!perl -w
use strict;
-use Test::More tests => 59;
+use Test::More tests => 61;
use IO::Handle;
-BEGIN { use_ok('CGI::Carp') };
+use CGI::Carp;
#-----------------------------------------------------------------------------
# Test id
@@ -337,9 +337,14 @@
CGI::Carp::die( My::Stringified::Object->new );
$result{string_object} .= $_ while <STDOUT>;
+ undef $@;
CGI::Carp::die();
$result{no_args} .= $_ while <STDOUT>;
+ $@ = "I think I caught a virus";
+ CGI::Carp::die();
+ $result{propagated} .= $_ while <STDOUT>;
+
untie *STDOUT;
like $result{string} => qr/regular string/, 'regular string, wrapped';
@@ -352,6 +357,9 @@
'stringified object, wrapped';
like $result{no_args} => qr/Died at/, 'no args, wrapped';
+ like $result{propagated} => qr/I think I caught a virus\t\.{3}propagated/,
+ 'propagating $@ if no argument';
+
}
{
@@ -371,3 +379,20 @@
return bless {}, shift;
}
}
+
+
+@result = ();
+tie *STDOUT, 'StoreStuff' or die "Can't tie STDOUT";
+ {
+ eval {
+ $CGI::Carp::TO_BROWSER = 0;
+ die 'Message ToBrowser = 0';
+ };
+ $result[0] = $@;
+ $result[1] .= $_ while (<STDOUT>);
+ }
+untie *STDOUT;
+
+ like $result[0] => qr/Message ToBrowser/, 'die message for ToBrowser = 0 is OK';
+ ok !$result[1], 'No output for ToBrowser = 0';
+
diff -Naur perl-5.12.4/cpan/CGI/t/charset.t CGI.pm-3.59/cpan/CGI/t/charset.t
--- perl-5.12.4/cpan/CGI/t/charset.t 1969-12-31 16:00:00.000000000 -0800
+++ CGI.pm-3.59/cpan/CGI/t/charset.t 2011-01-05 10:13:45.000000000 -0800
@@ -0,0 +1,27 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+my $q = CGI->new;
+
+like( $q->header
+ , qr/charset=ISO-8859-1/, "charset ISO-8859-1 is set by default for default content-type");
+like( $q->header('application/json')
+ , qr/charset=ISO-8859-1/, "charset ISO-8859-1 is set by default for application/json content-type");
+
+{
+ $q->charset('UTF-8');
+ my $out = $q->header('text/plain');
+ like($out, qr{Content-Type: text/plain; charset=UTF-8}, "setting charset alters header of text/plain");
+}
+{
+ $q->charset('UTF-8');
+ my $out = $q->header('application/json');
+ like($out, qr{Content-Type: application/json; charset=UTF-8}, "setting charset alters header of application/json");
+}
+
diff -Naur perl-5.12.4/cpan/CGI/t/cookie.t CGI.pm-3.59/cpan/CGI/t/cookie.t
--- perl-5.12.4/cpan/CGI/t/cookie.t 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/t/cookie.t 2011-04-28 07:34:54.000000000 -0700
@@ -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 $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)");
+
+ @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)");
}
#-----------------------------------------------------------------------------
@@ -126,6 +138,10 @@
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 @@
{
# 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 @@
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 @@
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 $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 @@
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 @@
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 $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 $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 @@
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';
+
+ $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.
#-----------------------------------------------------------------------------
diff -Naur perl-5.12.4/cpan/CGI/t/delete.t CGI.pm-3.59/cpan/CGI/t/delete.t
--- perl-5.12.4/cpan/CGI/t/delete.t 1969-12-31 16:00:00.000000000 -0800
+++ CGI.pm-3.59/cpan/CGI/t/delete.t 2011-04-28 07:34:54.000000000 -0700
@@ -0,0 +1,57 @@
+#!/usr/local/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use CGI ();
+use Config;
+
+my $loaded = 1;
+
+$| = 1;
+
+######################### End of black magic.
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD} = 'DELETE';
+$ENV{QUERY_STRING} = 'game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO} = '/somewhere/else';
+$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME} = '/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+$ENV{REQUEST_URI} = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
+$ENV{HTTP_LOVE} = 'true';
+
+my $q = new CGI;
+ok $q,"CGI::new()";
+is $q->request_method => 'DELETE',"CGI::request_method()";
+is $q->query_string => 'game=chess;game=checkers;weather=dull',"CGI::query_string()";
+is $q->param(), 2,"CGI::param()";
+is join(' ',sort $q->param()), 'game weather',"CGI::param()";
+is $q->param('game'), 'chess',"CGI::param()";
+is $q->param('weather'), 'dull',"CGI::param()";
+is join(' ',$q->param('game')), 'chess checkers',"CGI::param()";
+ok $q->param(-name=>'foo',-value=>'bar'),'CGI::param() put';
+is $q->param(-name=>'foo'), 'bar','CGI::param() get';
+is $q->query_string, 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux";
+is $q->http('love'), 'true',"CGI::http()";
+is $q->script_name, '/cgi-bin/foo.cgi',"CGI::script_name()";
+is $q->url, 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()";
+is $q->self_url,
+ 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+ "CGI::url()";
+is $q->url(-absolute=>1), '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)';
+is $q->url(-relative=>1), 'foo.cgi','CGI::url(-relative=>1)';
+is $q->url(-relative=>1,-path=>1), 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)';
+is $q->url(-relative=>1,-path=>1,-query=>1),
+ 'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+ 'CGI::url(-relative=>1,-path=>1,-query=>1)';
+$q->delete('foo');
+ok !$q->param('foo'),'CGI::delete()';
+
+
+done_testing();
diff -Naur perl-5.12.4/cpan/CGI/t/fast.t CGI.pm-3.59/cpan/CGI/t/fast.t
--- perl-5.12.4/cpan/CGI/t/fast.t 1969-12-31 16:00:00.000000000 -0800
+++ CGI.pm-3.59/cpan/CGI/t/fast.t 2011-12-30 05:07:26.000000000 -0800
@@ -0,0 +1,34 @@
+#!perl -w
+
+my $fcgi;
+BEGIN {
+ local $@;
+ eval { require FCGI };
+ $fcgi = $@ ? 0 : 1;
+}
+
+use Test::More tests => 9;
+
+# Shut up "used only once" warnings.
+() = $CGI::Q;
+
+SKIP: {
+ skip( 'FCGI not installed, cannot continue', 9 ) unless $fcgi;
+
+ require CGI::Fast;
+ ok( my $q = CGI::Fast->new(), 'created new CGI::Fast object' );
+ is( $q, $CGI::Q, 'checking to see if the object was stored properly' );
+ is( $q->param(), (), 'no params' );
+
+ ok( $q = CGI::Fast->new({ foo => 'bar' }), 'creating object with params' );
+ is( $q->param('foo'), 'bar', 'checking passed param' );
+
+ is($CGI::PRIVATE_TEMPFILES,0, "reality check default value for CGI::PRIVATE_TEMPFILES");
+ import CGI::Fast '-private_tempfiles';
+ CGI::Fast->new;
+ is($CGI::PRIVATE_TEMPFILES,1, "pragma in subclass set package variable in parent class. ");
+ $q = CGI::Fast->new({ a => 1 });
+ ok($q, "reality check: something was returned from CGI::Fast->new besides undef");
+ is($CGI::PRIVATE_TEMPFILES,1, "package variable in parent class persists through multiple calls to CGI::Fast->new ");
+
+};
diff -Naur perl-5.12.4/cpan/CGI/t/gen-tests/gen-start-end-tags.pl CGI.pm-3.59/cpan/CGI/t/gen-tests/gen-start-end-tags.pl
--- perl-5.12.4/cpan/CGI/t/gen-tests/gen-start-end-tags.pl 1969-12-31 16:00:00.000000000 -0800
+++ CGI.pm-3.59/cpan/CGI/t/gen-tests/gen-start-end-tags.pl 2011-01-05 10:13:45.000000000 -0800
@@ -0,0 +1,75 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+my @tags =
+ (
+ "h1","h2","h3","h4","h5","h6",
+ "table","ul","li","ol","td",
+ "b","i","u","div",
+ );
+
+my $the_tag;
+my $tests_body = "";
+my $num_tests = 0;
+foreach $the_tag (@tags)
+{
+ my $start_or_end;
+ foreach $start_or_end (qw(start end))
+ {
+ my $slash = ($start_or_end eq "start") ? "" : "/";
+ $tests_body .= "is(${start_or_end}_${the_tag}(), \"<${slash}${the_tag}>\", \"${start_or_end}_${the_tag}\"); # TEST\n";
+ $num_tests++;
+ if ($start_or_end eq "start")
+ {
+ $tests_body .= "is(${start_or_end}_${the_tag}({class => 'hello'}), \"<${slash}${the_tag} class=\\\"hello\\\">\", \"${start_or_end}_${the_tag} with param\"); # TEST\n";
+ $num_tests++;
+ }
+ }
+ $tests_body .= "\n";
+}
+
+my $header1 = <<"EOF";
+#!/usr/local/bin/perl -w
+
+use lib qw(t/lib);
+use strict;
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in \@INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+EOF
+;
+
+my $header2 = "use Test::More tests => $num_tests;\n\n";
+
+my $header3;
+
+sub write_file
+{
+ my %args = (@_);
+ local(*O);
+ open O, ">t/start_end_" . $args{'filename'} . ".t\n";
+ my $content = $header1 . $header2 .
+ "use CGI qw(:standard " .
+ join(" ", @{$args{'use_params'}}) . ");\n\n" .
+ $tests_body;
+ print O $content;
+ close(O);
+}
+
+write_file(
+ "filename" => "asterisk",
+ "use_params" => [ map {"\*$_" } @tags ],
+);
+
+write_file(
+ "filename" => "start",
+ "use_params" => [ map {"start_$_"} @tags],
+);
+
+write_file(
+ "filename" => "end",
+ "use_params" => [ map {"end_$_"} @tags],
+);
+
diff -Naur perl-5.12.4/cpan/CGI/t/html.t CGI.pm-3.59/cpan/CGI/t/html.t
--- perl-5.12.4/cpan/CGI/t/html.t 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/t/html.t 2011-01-05 10:13:45.000000000 -0800
@@ -63,11 +63,14 @@
is header(), "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}",
"header()";
-is header( -type => 'image/gif' ), "Content-Type: image/gif${CRLF}${CRLF}",
+is header( -type => 'image/gif', -charset => '' ), "Content-Type: image/gif${CRLF}${CRLF}",
"header()";
is header( -type => 'image/gif', -status => '500 Sucks' ),
"Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}", "header()";
+
+# return to normal
+charset( 'ISO-8859-1' );
like header( -nph => 1 ),
qr!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,
@@ -85,13 +88,17 @@
<body>
END
-is start_html( -Title => 'The world of foo' ), <<END, "start_html()";
+is start_html(
+ -Title => 'The world of foo' ,
+ -Script => [ {-src=> 'foo.js', -charset=>'utf-8'} ],
+ ), <<END, "start_html()";
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>The world of foo</title>
+<script src="foo.js" charset="utf-8" type="text/javascript"></script>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
</head>
<body>
diff -Naur perl-5.12.4/cpan/CGI/t/multipart_init.t CGI.pm-3.59/cpan/CGI/t/multipart_init.t
--- perl-5.12.4/cpan/CGI/t/multipart_init.t 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/t/multipart_init.t 1969-12-31 16:00:00.000000000 -0800
@@ -1,20 +0,0 @@
-use Test::More 'no_plan';
-
-use CGI;
-
-my $q = CGI->new;
-
-my $sv = $q->multipart_init;
-like( $sv, qr|Content-Type: multipart/x-mixed-replace;boundary="------- =|, 'multipart_init(), basic');
-
-like( $sv, qr/$CGI::CRLF$/, 'multipart_init(), ends in CRLF' );
-
-$sv = $q->multipart_init( 'this_is_the_boundary' );
-like( $sv, qr/boundary="this_is_the_boundary"/, 'multipart_init("simple_boundary")' );
-$sv = $q->multipart_init( -boundary => 'this_is_another_boundary' );
-like($sv,
- qr/boundary="this_is_another_boundary"/, "multipart_init( -boundary => 'this_is_another_boundary')");
-
-$sv = $q->multipart_init;
-my $sv2 = $q->multipart_init;
-isnt($sv,$sv2,"due to random boundaries, multiple calls produce different results");
diff -Naur perl-5.12.4/cpan/CGI/t/param_fetch.t CGI.pm-3.59/cpan/CGI/t/param_fetch.t
--- perl-5.12.4/cpan/CGI/t/param_fetch.t 1969-12-31 16:00:00.000000000 -0800
+++ CGI.pm-3.59/cpan/CGI/t/param_fetch.t 2011-01-05 10:13:45.000000000 -0800
@@ -0,0 +1,26 @@
+#!perl
+
+# Tests for the param_fetch() method.
+
+use Test::More 'no_plan';
+use CGI;
+
+{
+ my $q = CGI->new('b=baz;a=foo;a=bar');
+
+ is $q->param_fetch('a')->[0] => 'foo', 'first "a" is "foo"';
+ is $q->param_fetch( -name => 'a' )->[0] => 'foo',
+ 'first "a" is "foo", with -name';
+ is $q->param_fetch('a')->[1] => 'bar', 'second "a" is "bar"';
+ is_deeply $q->param_fetch('a') => [qw/ foo bar /], 'a is array ref';
+ is_deeply $q->param_fetch( -name => 'a' ) => [qw/ foo bar /],
+ 'a is array ref, w/ name';
+
+ is $q->param_fetch('b')->[0] => 'baz', '"b" is "baz"';
+ is_deeply $q->param_fetch('b') => [qw/ baz /], 'b is array ref too';
+
+ is_deeply $q->param_fetch, [], "param_fetch without parameters";
+
+ is_deeply $q->param_fetch( 'a', 'b' ), [qw/ foo bar /],
+ "param_fetch only take first argument";
+}
diff -Naur perl-5.12.4/cpan/CGI/t/rt-52469.t CGI.pm-3.59/cpan/CGI/t/rt-52469.t
--- perl-5.12.4/cpan/CGI/t/rt-52469.t 1969-12-31 16:00:00.000000000 -0800
+++ CGI.pm-3.59/cpan/CGI/t/rt-52469.t 2011-12-30 05:22:19.000000000 -0800
@@ -0,0 +1,14 @@
+use strict;
+use warnings;
+
+use Test::More tests => 1; # last test to print
+
+use CGI;
+
+$ENV{REQUEST_METHOD} = 'PUT';
+
+my $cgi = CGI->new;
+
+pass 'new() returned';
+
+
diff -Naur perl-5.12.4/cpan/CGI/t/tmpdir.t CGI.pm-3.59/cpan/CGI/t/tmpdir.t
--- perl-5.12.4/cpan/CGI/t/tmpdir.t 1969-12-31 16:00:00.000000000 -0800
+++ CGI.pm-3.59/cpan/CGI/t/tmpdir.t 2011-12-30 04:52:33.000000000 -0800
@@ -0,0 +1,40 @@
+#!perl
+use Test::More tests => 9;
+use strict;
+
+my ($testdir, $testdir2);
+
+BEGIN {
+ $testdir = "CGItest";
+ $testdir2 = "CGItest2";
+ for ($testdir, $testdir2) {
+ ( -d ) || mkdir $_;
+ ( ! -w ) || chmod 0700, $_;
+ }
+ $CGITempFile::TMPDIRECTORY = $testdir;
+ $ENV{TMPDIR} = $testdir2;
+}
+
+use CGI;
+is($CGITempFile::TMPDIRECTORY, $testdir, "can pre-set \$CGITempFile::TMPDIRECTORY");
+CGITempFile->new;
+is($CGITempFile::TMPDIRECTORY, $testdir, "\$CGITempFile::TMPDIRECTORY unchanged");
+
+TODO: {
+ local $TODO = "figuring out why these tests fail on some platforms";
+ ok(chmod 0500, $testdir, "revoking write access to $testdir");
+ ok(! -w $testdir, "write access to $testdir revoked");
+CGITempFile->new;
+is($CGITempFile::TMPDIRECTORY, $testdir2,
+ "unwritable \$CGITempFile::TMPDIRECTORY overridden");
+
+ok(chmod 0500, $testdir2, "revoking write access to $testdir2");
+ok(! -w $testdir, "write access to $testdir revoked");
+CGITempFile->new;
+isnt($CGITempFile::TMPDIRECTORY, $testdir2,
+ "unwritable \$ENV{TMPDIR} overridden");
+isnt($CGITempFile::TMPDIRECTORY, $testdir,
+ "unwritable \$ENV{TMPDIR} not overridden with an unwritable \$CGITempFile::TMPDIRECTORY");
+}
+
+END { for ($testdir, $testdir2) { chmod 0700, $_; rmdir; } }
diff -Naur perl-5.12.4/cpan/CGI/t/url.t CGI.pm-3.59/cpan/CGI/t/url.t
--- perl-5.12.4/cpan/CGI/t/url.t 2011-06-01 00:47:46.000000000 -0700
+++ CGI.pm-3.59/cpan/CGI/t/url.t 2011-11-09 07:49:15.000000000 -0800
@@ -1,9 +1,10 @@
use strict;
use warnings;
-use Test::More tests => 4; # last test to print
+use Test::More;
+
+use CGI ':all';
-use CGI qw/ :all /;
$ENV{HTTP_X_FORWARDED_HOST} = 'proxy:8484';
$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
@@ -21,3 +22,51 @@
is url() => 'http://proxy', 'url() with default port';
+subtest 'rewrite_interactions' => sub {
+ # Reference: RT#45019
+
+ local %ENV = (
+ # These two are always set
+ 'SCRIPT_NAME' => '/real/cgi-bin/dispatch.cgi',
+ 'SCRIPT_FILENAME' => '/home/mark/real/path/cgi-bin/dispatch.cgi',
+
+ # These two are added by mod_rewrite Ref: http://httpd.apache.org/docs/2.2/mod/mod_rewrite.html
+
+ 'SCRIPT_URL' => '/real/path/info',
+ 'SCRIPT_URI' => 'http://example.com/real/path/info',
+
+ 'PATH_INFO' => '/path/info',
+ 'REQUEST_URI' => '/real/path/info',
+ 'HTTP_HOST' => 'example.com'
+ );
+
+ my $q = CGI->new;
+
+ is(
+ $q->url( -absolute => 1, -query => 1, -path_info => 1 ),
+ '/real/path/info',
+ '$q->url( -absolute => 1, -query => 1, -path_info => 1 ) should return complete path, even when mod_rewrite is detected.'
+ );
+ is( $q->url(), 'http://example.com/real', '$q->url(), with rewriting detected' );
+ is( $q->url(-full=>1), 'http://example.com/real', '$q->url(-full=>1), with rewriting detected' );
+ is( $q->url(-path=>1), 'http://example.com/real/path/info', '$q->url(-path=>1), with rewriting detected' );
+ is( $q->url(-path=>0), 'http://example.com/real', '$q->url(-path=>0), with rewriting detected' );
+ is( $q->url(-full=>1,-path=>1), 'http://example.com/real/path/info', '$q->url(-full=>1,-path=>1), with rewriting detected' );
+ is( $q->url(-rewrite=>1,-path=>0), 'http://example.com/real', '$q->url(-rewrite=>1,-path=>0), with rewriting detected' );
+ is( $q->url(-rewrite=>1), 'http://example.com/real',
+ '$q->url(-rewrite=>1), with rewriting detected' );
+ is( $q->url(-rewrite=>0), 'http://example.com/real/cgi-bin/dispatch.cgi',
+ '$q->url(-rewrite=>0), with rewriting detected' );
+ is( $q->url(-rewrite=>0,-path=>1), 'http://example.com/real/cgi-bin/dispatch.cgi/path/info',
+ '$q->url(-rewrite=>0,-path=>1), with rewriting detected' );
+ is( $q->url(-rewrite=>1,-path=>1), 'http://example.com/real/path/info',
+ '$q->url(-rewrite=>1,-path=>1), with rewriting detected' );
+ is( $q->url(-rewrite=>0,-path=>0), 'http://example.com/real/cgi-bin/dispatch.cgi',
+ '$q->url(-rewrite=>0,-path=>1), with rewriting detected' );
+ done_testing();
+};
+
+
+done_testing();
+
+
diff -Naur perl-5.12.4/MANIFEST CGI.pm-3.59/MANIFEST
--- perl-5.12.4/MANIFEST 2011-06-07 13:04:05.000000000 -0700
+++ CGI.pm-3.59/MANIFEST 2012-06-13 14:15:21.906099448 -0700
@@ -198,30 +198,36 @@
cpan/CGI/t/autoescape.t See if CGI.pm works
cpan/CGI/t/can.t See if CGI.pm works
cpan/CGI/t/carp.t See if CGI::Carp works
+cpan/CGI/t/charset.t
cpan/CGI/t/checkbox_group.t See if CGI.pm works
cpan/CGI/t/cookie.t See if CGI::Cookie works
+cpan/CGI/t/delete.t
cpan/CGI/t/Dump.t See if CGI->Dump works
cpan/CGI/t/end_form.t See if CGI.pm works
+cpan/CGI/t/fast.t See if CGI.pm works
cpan/CGI/t/form.t See if CGI.pm works
cpan/CGI/t/function.t See if CGI.pm works
+cpan/CGI/t/gen-tests/gen-start-end-tags.pl
cpan/CGI/t/headers.t See if CGI.pm works
cpan/CGI/t/hidden.t See if CGI.pm works
cpan/CGI/t/html.t See if CGI.pm works
cpan/CGI/t/http.t See if CGI.pm works
cpan/CGI/t/init.t See if CGI.pm works
cpan/CGI/t/init_test.txt See if CGI.pm works
-cpan/CGI/t/multipart_init.t See if CGI.pm works
cpan/CGI/t/no_tabindex.t See if CGI.pm works
+cpan/CGI/t/param_fetch.t
cpan/CGI/t/popup_menu.t See if CGI pop menus work
cpan/CGI/t/pretty.t See if CGI.pm works
cpan/CGI/t/push.t See if CGI::Push works
cpan/CGI/t/query_string.t See if CGI->query_string() works
cpan/CGI/t/request.t See if CGI.pm works
+cpan/CGI/t/rt-52469.t
cpan/CGI/t/save_read_roundtrip.t See if CGI.pm works
cpan/CGI/t/start_end_asterisk.t See if CGI.pm works
cpan/CGI/t/start_end_end.t See if CGI.pm works
cpan/CGI/t/start_end_start.t See if CGI.pm works
cpan/CGI/t/switch.t See if CGI::Switch still loads
+cpan/CGI/t/tmpdir.t
cpan/CGI/t/unescapeHTML.t See if CGI::unescapeHTML() works
cpan/CGI/t/uploadInfo.t See if CGI.pm works
cpan/CGI/t/upload_post_text.txt Test data for CGI.pm