CGI-4.68/000755 000765 000024 00000000000 14772731701 013375 5ustar00leejohnsonstaff000000 000000 CGI-4.68/Changes000644 000765 000024 00000276521 14770523571 014707 0ustar00leejohnsonstaff000000 000000 4.68 2025-04-01 [ FIX ] - handle passing of hash keys as args with a mix of dashed and non dashed (GH #270, thanks to kocoureasy for the patch) 4.67 2025-01-08 [ FIX ] - correctly parse unquoted expires cookie values containing embedded commas (GH #268, thanks to rlauer6 for the patch) 4.66 2024-06-04 [ FIX ] - Restore trailing slashes in the ->url call (GH #267) 4.65 2024-06-04 [ TESTING ] - "fix" t/url.t for older Perls (GH #266) 4.64 2024-03-18 [ META ] - pass --no-xattrs to tar in Makefile to fix tar backwards compat (GH #264, thanks to ryandesign) 4.63 2024-03-01 [ FIX ] - ->url returns a string in all cases (GH #263, thanks to Sketch6307) 4.62 2024-03-01 [ FIX ] - ->url now returns the correct thing for ipv6 brackets (GH #259, thanks to eserte) 4.61 2024-01-08 [ ENHANCEMENT ] - Support Paritioned cookies in CGI::Cookie (GH #262, thanks to dakkar) 4.60 2023-11-01 [ TESTING ] - move t/changes.t to xt/ as is now broken by the recent rewrite of Test::CPAN::Changes (GH #260) 4.59 2023-10-02 [ FIX ] - Bring VERSION values inline 4.58 2023-10-02 [ FIX ] - Update cookie expires date format (GH #258 , thanks to robbiebow) 4.57 2023-05-01 [ DOCUMENTATION ] - Documentation tweaks around uploadInfo() and hooks (GH #256, thanks to rlauer6) 4.56 2023-03-01 [ TESTING ] - add new cookie field 'Priority' to CGI::Cookie code (GH #253, thanks to Pavel) 4.55 2023-01-03 [ TESTING ] - remove dependency on Test::Deep (GH #254) 4.54 2022-02-03 [ FIX ] - fix use of cache when calling ->cookie (GH #252) - thanks to Sergey Panteleev for the PR 4.53 2021-06-03 [ FIX ] - fix typo in passing of max-age to CGI::Cookie (GH #247) 4.52 2021-05-04 [ FIX ] - sort hash keys for deterministic behaviour (GH #245, GH #246) 4.51 2020-10-01 [ DOCUMENTATION ] - Document support for SameSite=None cookies in CGI::Cookie (GH #244) 4.50 2020-06-22 [ ENHANCEMENT ] - Add APPEND_QUERY_STRING option (GH #243, thanks to stevenh) 4.49 2020-06-08 [ FIX ] - remove deprecation warning as no longer in core (GH #221) 4.48 2020-06-02 [ FIX ] - fix CGI::Cookie->bake() doesn't work with mod_perl redirects (GH #240) - thanks to sherrardb for the PR (GH #241) 4.47 2020-05-01 [ FIX / TESTING ] - fix typo in variable name (GH #239) 4.46 2020-02-03 [ DOCUMENTATION ] - Document support for SameSite=None cookies (GH #238) 4.45 2019-06-03 [ ENHANCEMENT ] - Add support for SameSite=None cookies (GH #237, thanks to Dur09) 4.44 2019-06-03 [ ENHANCEMENT ] - Replace only use of "base" with "parent" (GH #235) 4.43 2019-05-01 [ FIX / TESTING ] - support unquoted multipart/form-data name values (GH #234) 4.42 2019-03-26 [ DOCUMENTATION ] - clarify licence also in Makefile.PL (GH #232) 4.41 2019-03-26 [ DOCUMENTATION ] - clarify licence (GH #232) 4.40 2018-08-15 [ FIX / TESTING ] - support perls < 5.10.1 in Makefile.PL by being more dynamic (GH #229, GH #230, thanks to Aristotle) 4.39 2018-08-13 [ FIX / TESTING ] - specify CONFIGURE_REQUIRES in Makefile.PL so can use TEST_REQUIRES to build with older perls (GH #228) 4.38 2017-12-01 [ TESTING ] - command_line.t: Avoid -I for libs (GH #224, thanks to cpansprout) 4.37 2017-11-01 [ FIX ] - Fix incorrect quoting of ? in ->url (GH #112, GH #222, with thanks to Reuben Thomas) 4.36 2017-03-29 [ ENHANCEMENT ] - Support PATCH HTTP method (thanks to GovtGeek for the... patch) - pass through max_age and samesite to CGI::Cookie->new in the call in CGI->cookie (GH #220) [ FIX ] - skip t/command_line.t on windows as it doesn't work 4.35 2016-10-13 [ FIX ] - revert changes from 4.34 as they broke stuff 4.34 2016-10-13 [ ENHANCEMENT ] - If running from the command line, url_param now picks up parameters given on then command line or on stdin (GH #210) [ DOCUMENTATION ] - documentation for above addition 4.33 2016-09-16 [ DOCUMENTATION ] - clarify that ->param will return the first value if there are multiple values (when not called in list context) 4.32 2016-07-19 [ DOCUMENTATION ] - make perldoc CGI object consistent (GH #205) - clarify reason for absolute URLs (GH #206) [ INTERNALS ] - tweak dependency defs in Makefile.PL (GH #207, GH #208) - (thanks to karenetheridge and kentfredric) 4.31 2016-06-14 [ FEATURES ] - Add SameSite support to Cookie handling (thanks to pangyre) [ INTERNALS ] - The MultipartBuffer package has been renamed to CGI::MultipartBuffer. This has been done in a way to ensure any $MultipartBuffer package variables are still set correctly in CGI::MultipartBuffer. if you are explicitly using MultipartBuffer in a form such as: MultipartBuffer->new your code will break. you should be calling: CGI->new->new_MultipartBuffer( $boundary,$length ); to ensure the correctly package is called. if you are extending the MultipartBuffer package though use of ISA or base (or parent) then you will need to update your code to use CGI::MultipartBuffer - fake using strict and warnings to appease CPANTS Kwalitee - require File::Temp v0.17+ to get seekable file handles (GH #204) 4.28 2016-03-14 [ RELEASE NOTES ] - please see v4.21 Changes for any potentially impacting changes [ SPEC / BUG FIXES ] - undef %QUERY_PARAM in initialize_globals to clean mod_perl env [ TESTING ] - improve test coverage on request types (GH #199, GH #200) - improve test coverage on CGI::Carp 4.27 2016-03-02 [ RELEASE NOTES ] - please see v4.21 Changes for any potentially impacting changes [ INTERNALS ] - fix a couple of warnings in test harness - add taint flag to example file_upload - fix a warnings in STORE subroutine 4.26 2016-02-04 [ RELEASE NOTES ] - please see v4.21 Changes for any potentially impacting changes [ SPEC / BUG FIXES ] - sort HTML attributes by default (GH #106, GH #196) [ DOCUMENTATION ] - clarifications about HTML function non removal 4.25 2015-12-17 [ RELEASE NOTES ] - please see v4.21 Changes for any potentially impacting changes [ DOCUMENTATION ] - fix link to CONTRIBUTING file (thanks to Manwar for the fix) - clarify that "soft" deprecation means that the HTML functions are deprecated but will not raise any deprecation warnings [ SPEC / BUG FIXES ] - make the list context warning only happen once per process (or thread) to prevent excessive log noise in long running or in persistent processes (thanks to @dadamail for the suggestion) 4.23 2015-12-17 [ RELEASE NOTES ] - Documentation fixes only - please see v4.21 Changes for any potentially impacting changes [ DOCUMENTATION ] - add LICENSE file and LICENSE info to Makefile.PL 4.22 2015-10-16 [ RELEASE NOTES ] - Documentation fixes only - please see v4.21 Changes for any potentially impacting changes [ DOCUMENTATION ] - fix typos in CONTRIBUTING file - links to docs, stackoverflow and perlmonks - clarify deprecation policy on HTML functions (GH #188) - mention HTML::Tiny in CGI::HTML::Functions (thanks to osfameron for the suggestion) 4.21 2015-06-16 [ RELEASE NOTES ] - CGI.pm is now considered "done". See also "mature" and "legacy" Features requests and non-critical issues will be outright rejected. The module is now in maintenance mode for critical issues only. - This release removes the AUTOLOAD and compile optimisations from CGI.pm that were introduced into CGI.pm twenty (20) years ago as a response to its large size, which meant there was a significant compile time penalty. - This optimisation is no longer relevant and makes the code difficult to deal with as well as making test coverage metrics incorrect. Benchmarks show that advantages of AUTOLOAD / lazy loading / deferred compile are less than 0.05s, which will be dwarfed by just about any meaningful code in a cgi script. If this is an issue for you then you should look at running CGI.pm in a persistent environment (FCGI, etc) - To offset some of the time added by removing the AUTOLOAD functionality the dependencies have been made runtime rather than compile time. The POD has also been split into its own file. CGI.pm now contains around 4000 lines of code, which compared to some modules on CPAN isn't really that much - This essentially deprecates the -compile pragma and ->compile method. The -compile pragma will no longer do anything, whereas the ->compile method will raise a deprecation warning. More importantly this also REMOVES the -any pragma because as per the documentation this pragma needed to be "used with care or not at all" and allowing arbitrary HTML tags is almost certainly a bad idea. If you are using the -any pragma and using arbitrary tags (or have typo's in your code) your code will *BREAK* - Although this release should be back compatible (with the exception of any code using the -any pragma) you are encouraged to test it throughly as if you are doing anything out of the ordinary with CGI.pm (i.e. have bugs that may have been masked by the AUTOLOAD feature) you may see some issues. - References: GH #162, GH #137, GH #164 [ SPEC / BUG FIXES ] - make the list context warning in param show the filename rather than the package so we have more information on exactly where the warning has been raised from (GH #171) - correct self_url when PATH_INFO and SCRIPT_NAME are the same but we are not running under IIS (GH #176) - Add the multi_param method to :cgi export (thanks to xblitz for the patch and tests. GH #167) - Fix warning for lack of HTTP_USER_AGENT in CGI::Carp (GH #168) - Fix imports when called from CGI::Fast, restores the import of CGI functions into the callers namespace for users of CGI::Fast (GH leejo/cgi-fast#11 and GH leejo/cgi-fast#12) - Fix regression of tmpFileName when calling with a plain string (GH #178, thanks to Simon McVittie for the report and fix) [ FEATURES ] - CGI::Carp now has $CGI::Carp::FULL_PATH for displaying the full path to the offending script in error messages - CGI now has env_query_string() for getting the value of QUERY_STRING from the environment and not that fiddled with by CGI.pm (which is what query_string() does) (GH #161) - CGI::ENCODE_ENTITIES var added to control which chracters are encoded by the call to the HTML::Entities module - defaults to &<>"' (GH #157 - the \x8b and \x9b chars have been removed from this list as we are concerned more about unicode compat these days than old browser support.) [ DOCUMENTATION ] - Fix some typos (GH #173, GH #174) - All *documentation* for HTML functionality in CGI has been moved into its own namespace: CGI::HTML::Functions - although the functionality continues to exist within CGI.pm so there are no code changes required (GH #142) - Add missing documentation for env variable fetching routines (GH #163) [ TESTING ] - Increase test coverage (GH #3) [ INTERNALS ] - Cwd made a TEST_REQUIRES rather than a BUILD_REQUIRES in Makefile.PL (GH #170) - AutoloadClass variables have been removed as AUTOLOAD was removed in v4.14 so these are no longer necessary (GH #172 thanks to alexmv) - Remove dependency on constant - internal DEBUG, XHTML_DTD and EBCDIC constants changes to $_DEBUG, $_XHTML_DTD, and $_EBCDIC 4.13 2014-12-18 [ RELEASE NOTES ] - CGI::Pretty is now DEPRECATED and will be removed in a future release. Please see GH #162 (https://github.com/leejo/CGI.pm/issues/162) for more information and discussion (also GH #140 for HTML function deprecation discussion: https://github.com/leejo/CGI.pm/issues/140) [ TESTING ] - fix t\rt-84767.t for failures on Win32 platforms related to file paths 4.11 2014-12-02 [ SPEC / BUG FIXES ] - more hash key ordering bugs fixed in HTML attribute output (GH #158, thanks to Marcus Meissner for the patch and test case) [ REFACTORING ] - escapeHTML (and unescapeHTML) have been refactored to use the functions exported by the HTML::Entities module (GH #157) - change BUILD_REQUIRES to TEST_REQUIRES in Makefile.PL as these are test dependencies not build dependencies (GH #159) [ DOCUMENTATION ] - replace any remaining uses of indirect object notation (new Object) with the safer Object->new syntax (GH #156) 4.10 2014-11-27 [ SPEC / BUG FIXES ] - favour -content-type arg in header if -type and -charset options are also passed in (GH #155, thanks to kaoru for the test case). this change also sorts the hash keys in the rearrange method in CGI::Util meaning the order of the arrangement will always be the same for params that have multiple aliases. really you shouldn't be passing in multiple aliases, but this will make it consistent should you do that [ DOCUMENTATION ] - fix some typos 4.09 2014-10-21 [ RELEASE NOTES ] - with this release the large backlog of issues against CGI.pm has been cleared. All fixes have been made in the versions 4.00 and above so if you are upgrading from 3.* you should thoroughly test your code against recent versions of CGI.pm - an effort has been made to retain back compatibility against previous versions of CGI.pm for any fixes made, however some changes related to the handling of temporary files may have consequences for your code - please refer to the RELEASE NOTES for version 4.00 and above for all recent changes and file an issue on github if there has been a regression. - please do *NOT* file issues regarding HTML generating functions, these are no longer being maintained (see perldoc for rationale) [ SPEC / BUG FIXES ] - tweak url to DTRT when the web server is IIS (RT #89827 / GH #152) - fix temporary file handling when dealing with multiple files in MIME uploads (GH #154, thanks to GeJ for the test case) 4.08 2014-10-18 [ DOCUMENTATION ] - note that calling headers without a -charset may lead to a nonsensical charset being added to certain content types due to the default and the workaround - remove documentation stating that calls to escapeHTML with a changed charset force numeric encoding of all characters, because that does not happen - documentation tweaks for calling param() in list context and the addition of multi_param() [ SPEC / BUG FIXES ] - don't sub out PATH_INFO in url if PATH_INFO is the same as SCRIPT_NAME (RT #89827) - add multi_param() method to allow calling of param() in list context without having to disable the $LIST_CONTEXT_WARN flag (see RELEASE NOTES for version 4.05 on why calling param() in list context could be a bad thing) 4.07 2014-10-12 [ RELEASE NOTES ] - please see changes for v4.05 [ TESTING ] - typo and POD fixes, add test to check POD and compiles 4.06 2014-10-10 [ RELEASE NOTES ] - please see changes for v4.05 [ DOCUMENTATION ] - make warning on list context call of ->param more lenient and don't warn if called with no arguments 4.05 2014-10-08 [ RELEASE NOTES ] - this release includes *significant* refactoring of temporary file handling in CGI.pm. See "Changes in temporary file handling" in perldoc - this release adds a warning for when the param method is called in list context, see the Warning in the perldoc for the section "Fetching the value or values of a single named parameter" for why this has been added and how to disable this warning [ DOCUMENTATION ] - change AUTHOR INFORMATION to LICENSE to please Kwalitee [ TESTING ] - t/arbitrary_handles.t to check need for patch in RT #54055, it turns out there is no need - the first argument to CGI->new can be an arbitrary handle - add test case for incorrect unescaping of redirect headers (RT #61120) - add tests for the handle method (RT #85074, thanks to TONYC@cpan.org) [ SPEC / BUG FIXES ] - don't set binmode on STDOUT/STDERR/STDIN if a none standard layer is already set on them on none UNIX platforms (RT #57524) - make XForms:Model data accesible through POSTDATA/PUTDATA param (RT #75628) - prevent corruption of POSTDATA/PUTDATA when -utf8 flag is used and use tempfiles to handle this data (RT #79102, thanks anonymous) - unescape request URI *after* having removed the query string to prevent removal of ? chars that are part of the original URI (and were encoded) (RT #83265) - fix q( to qq( in CGI::Carp so $@ is correct interpolated (RT #83360) - don't call ->query_string in url unless -query is passed (RT #87790) (optimisation and fits the current documented behaviour) 4.04 2014-09-04 [ RELEASE NOTES ] - this release removes some long deprecated modules/functions and includes refactoring to the temporary file handling in CGI.pm. if you are doing anything out of the ordinary with regards to temp files you should test your code before deploying this update as temp files may no longer be stored in previously used locations [ REMOVED / DEPRECATIONS ] - startform and endform methods removed (previously deprecated, you should be using the start_form and end_form methods) - both CGI::Apache and CGI::Switch have been removed as these modules 1) have been deprecated for *years*, and 2) do nothing whatsoever [ SPEC / BUG FIXES ] - handle multiple values in X-Forwarded-Host header, we follow the logic in most other frameworks and take the last value from the list (RT #54487) - reverse the order of TEMP dir placement for WINDOWS: TEMP > TMP > WINDIR (RT #71799, thanks to jeff@math.tntech.edu), this returns the behaviour to pre e24d04e9bc5fda7722444b02fec135d8cc2ff488 but with the undefined fix still in place - refactor CGITempFile::find_tempdir to use File::Spec->tmpdir (related: RT #71799) - fix warnings when QUERY_STRING has empty key=value pairs (RT #54511) - pad custom 500 status response messages to > 512 for MSIE (RT #81946) - make Vars tied hash delete method return the value deleted from the hash making it act like perl's delete (RT #51020) [ TESTING ] - add .travis.yml (https://travis-ci.org) - test case for RT #53966 - disallow filenames with ~ char - test case for RT #55166 - calling Vars to get the filename does not return a filehandle, so this cannot be used in the call to uploadinfo, also update documentation for the uploadInfo to show that ->Vars should not be used to get the filename for this method - fix t/url.t to pass on Win32 platforms that have the SCRIPT_NAME env variable set (RT #89992) - add procedural call tests for upload and uploadInfo to confirm these work as should (RT #91136) [ DOCUMENTATION ] - tweak perldoc for -utf8 option (RT #54341, thanks to Helmut Richter) - explain the HTML generation functions should no longer be used and that they may be deprecated in a future release 4.03 2014-07-02 [ REMOVED / DEPRECATIONS ] - the -multiple option to popup_menu is now IGNORED as this did not function correctly. If you require a menu with multiple selections use the scrolling_list method. (RT #30057) [ SPEC / BUG FIXES ] - support redirects in mod_perl2, or fall back to using env variable for up to 5 redirects, when getting the query string (RT #36312) - CGI::Cookie now correctly supports the -max-age argument, previously if this was passed the value of the -expires argument would be used meaning there was no way to supply *only* this argument (RT #50576) - make :all actually import all methods, except for :cgi-lib, and add :ssl to the :standard import (RT #70337) [ DOCUMENTATION ] - clarify documentation regarding query_string method (RT #48370) - links fixed in some perldoc (Thanks to Michiel Beijen) [ TESTING ] - add t/changes.t for testing this Changes file - test case for RT #31107 confirming multipart parsing is to spec - improve t/rt-52469.t by adding a timeout check 4.02 2014-06-09 [ NEW FEATURES ] - CGI::Carp learns noTimestamp / $CGI::Carp::NO_TIMESTAMP to prevent timestamp in messages (RT #82364, EDAVIS@cpan.org) - multipart_init and multipart_start learn -charset option (RT #22737) [ SPEC / BUG FIXES ] - Support multiple cookies when passing an ARRAY ref with -set-cookie (RT #15065, JWILLIAMS@cpan.org) [ DOCUMENTATION ] - Made licencing information consistent and remove duplicate comments about licence details, corrected location to report bugs (RT #38285) 4.01 2014-05-27 [ DOCUMENTATION ] - CGI.pm hasn't been removed from core *just* yet, but will be soon: http://perl5.git.perl.org/perl.git/commitdiff/e9fa5a80 4.00 2014-05-22 [ INTERNALS ] - CGI::Fast split out into its own distribution, related files and tests removed - developer test added for building with perlbrew [ DOCUMENTATION ] - Update perldoc to explain that CGI.pm has been removed from perl core - Make =head2 perldoc less shouty (RT #91140) - Tickets migrated from RT to github issues (both CGI and CGI.pm distributions) - Repointing bugtracker at newly forked github repo and note that Lee Johnson is the current maintainer. - Bump version to 4.00 for clear boundary of above changes Version 3.65 Feb 11, 2014 [INTERNALS] - Update Makefile to refine where CGI.pm gets installed (Thanks to bingo, rjbs: https://github.com/markstos/CGI.pm/pull/30) Version 3.64 Nov 23, 2013 [BUG FIXES] - Avoid warning about "undefined variable in user_agent in some cases (RT#72882) [INTERNALS] - Avoiding warning about "unitialized value" in when calling user_agent() in some cases. (RT#72882, perl@max-maurer.de) - Update minimum required version in Makefile.PL to 5.8.1. It had already been updated to 5.8.1 in the CGI.pm module in 3.53. - Fix POD errors reported by newer pod2man (Thanks to jmdh) - Typo fixes, (dsteinbrunner). - use deprecate.pm on perls 5.19.0 and later. (rjbs). [DOCUMENTATION] - Update CGI::Cookie docs to reflect that HttpOnly is widely supported now. Version 3.63 Nov 12, 2012 [SECURITY] - CR escaping for Set-Cookie and P3P headers was improved. There was potential for newline injection in these headers. (Thanks to anazawa, https://github.com/markstos/CGI.pm/pull/23) Version 3.62, Nov 9th, 2012 [INTERNALS] - Changed how the deprecated endform function was defined for compatibility with the development version of Perl. - Fix failures in t/tmpdir.t when run as root https://github.com/markstos/CGI.pm/issues/22, RT#80659) - Made it possible to force a sorted order for things like hash attributes so that tests are not dependent on a particular hash ordering. This will be required in modern perls which will change the ordering per process. (Yves, RT#80659) Version 3.61 Nov 2nd, 2012 (No code changes) [INTERNALS] - formatting of CGI::Carp documentation was improved. Thanks to benkasminbullock. - un-TODO some tests in t/tmpdir.t that were passing in most cases. More on this: https://github.com/markstos/CGI.pm/issues/19# https://github.com/markstos/CGI.pm/commit/cc73dc9807b0fabb56b3cdf1a9726588b2eda0f7 Version 3.60 Aug 15th, 2012 [BUG FIXES] - In some caes, When unescapeHTML() hit something it didn't recognize with an ampersand and and semicolon, it would throw away the semicolon and ampersand. It now does a better job. of preserving content it doesn't recognize. Thanks to CEBJYRE@cpan.org (RT#75595) - Remove trailing newline after
tag inserted by startform and start_form. It can cause rendering problems in some cases. Thanks to SJOHNSTON@cpan.org (RT#67719) - Workaround "Insecure Dependency" warning generated by some versions of Perl (RT#53733). Thanks to degatcpan@ntlworld.com, klchu@lbl.gov and Anonymous Monk [DOCUMENTATION] - Clarify that when -status is used, the human-readable phase should be included, per RFC 2616. Thanks to SREZIC@cpan.org (RT#76691). [INTERNALS] - More tests for header(), thanks to Ryo Anazawa. - t/url.t has been fixed on VMS. Thanks to cberry@cpan.org (RT#72380) - MANIFEST patched so that t/multipart_init.t is included again. Thanks to shay@cpan.org (RT#76189) 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. (Thanks to chansen) [INTERNALS] - tmp files are now cleaned up on VMS ( RT#69210, thanks to cberry@cpan.org ) - 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, ntyni@iki.fi) [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 \n"; warningsToBrowser(1); # re-enable warnings Note: In this respect warningsToBrowser() differs fundamentally from fatalsToBrowser(), which you should never call yourself! =head1 OVERRIDING THE NAME OF THE PROGRAM CGI::Carp includes the name of the program that generated the error or warning in the messages written to the log and the browser window. Sometimes, Perl can get confused about what the actual name of the executed program was. In these cases, you can override the program name that CGI::Carp will use for all messages. The quick way to do that is to tell CGI::Carp the name of the program in its use statement. You can do that by adding "name=cgi_carp_log_name" to your "use" statement. For example: use CGI::Carp qw(name=cgi_carp_log_name); . If you want to change the program name partway through the program, you can use the C function instead. It is not exported by default, you must import it explicitly by saying use CGI::Carp qw(set_progname); Once you've done that, you can change the logged name of the program at any time by calling set_progname(new_program_name); You can set the program back to the default by calling set_progname(undef); Note that this override doesn't happen until after the program has compiled, so any compile-time errors will still show up with the non-overridden program name =head1 TURNING OFF TIMESTAMPS IN MESSAGES If your web server automatically adds a timestamp to each log line, you may not need CGI::Carp to add its own. You can disable timestamping by importing "noTimestamp": use CGI::Carp qw(noTimestamp); Alternatively you can set C<$CGI::Carp::NO_TIMESTAMP> to 1. Note that the name of the program is still automatically included in the message. =head1 GETTING THE FULL PATH OF THE SCRIPT IN MESSAGES Set C<$CGI::Carp::FULL_PATH> to 1. =head1 AUTHOR INFORMATION The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein. It is distributed under the Artistic License 2.0. It is currently maintained by Lee Johnson with help from many contributors. Address bug reports and comments to: https://github.com/leejo/CGI.pm/issues The original bug tracker can be found at: 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 SEE ALSO L, L, L, L, L, L, L. =cut require 5.000; use Exporter; #use Carp; BEGIN { require Carp; *CORE::GLOBAL::die = \&CGI::Carp::die; } use File::Spec; @ISA = qw(Exporter); @EXPORT = qw(confess croak carp); @EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap noTimestamp set_message set_die_handler set_progname cluck ^name= die); $main::SIG{__WARN__}=\&CGI::Carp::warn; $CGI::Carp::VERSION = '4.68'; $CGI::Carp::CUSTOM_MSG = undef; $CGI::Carp::DIE_HANDLER = undef; $CGI::Carp::TO_BROWSER = 1; $CGI::Carp::NO_TIMESTAMP= 0; $CGI::Carp::FULL_PATH = 0; # fancy import routine detects and handles 'errorWrap' specially. sub import { my $pkg = shift; my(%routines); my(@name); if (@name=grep(/^name=/,@_)) { my($n) = (split(/=/,$name[0]))[1]; set_progname($n); @_=grep(!/^name=/,@_); } grep($routines{$_}++,@_,@EXPORT); $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'}; $WARN++ if $routines{'warningsToBrowser'}; my($oldlevel) = $Exporter::ExportLevel; $Exporter::ExportLevel = 1; Exporter::import($pkg,keys %routines); $Exporter::ExportLevel = $oldlevel; $main::SIG{__DIE__} =\&CGI::Carp::die if $routines{'fatalsToBrowser'}; $CGI::Carp::NO_TIMESTAMP = 1 if $routines{'noTimestamp'}; } # These are the originals sub realwarn { CORE::warn(@_); } sub realdie { CORE::die(@_); } sub id { my $level = shift; my($pack,$file,$line,$sub) = caller($level); my($dev,$dirs,$id) = File::Spec->splitpath($file); return ($file,$line,$id); } sub stamp { my $frame = 0; my ($id,$pack,$file,$dev,$dirs); if (defined($CGI::Carp::PROGNAME)) { $id = $CGI::Carp::PROGNAME; } else { do { $id = $file; ($pack,$file) = caller($frame++); } until !$file; } if (! $CGI::Carp::FULL_PATH) { ($dev,$dirs,$id) = File::Spec->splitpath($id); } return "$id: " if $CGI::Carp::NO_TIMESTAMP; my $time = scalar(localtime); return "[$time] $id: "; } sub set_progname { $CGI::Carp::PROGNAME = shift; return $CGI::Carp::PROGNAME; } sub warn { my $message = shift; my($file,$line,$id) = id(1); $message .= " at $file line $line.\n" unless $message=~/\n$/; _warn($message) if $WARN; my $stamp = stamp; $message=~s/^/$stamp/gm; realwarn $message; } sub _warn { my $msg = shift; if ($EMIT_WARNINGS) { # We need to mangle the message a bit to make it a valid HTML # comment. This is done by substituting similar-looking ISO # 8859-1 characters for <, > and -. This is a hack. $msg =~ tr/<>-/\253\273\255/; chomp $msg; print STDOUT "\n"; } else { push @WARNINGS, $msg; } } # The mod_perl package Apache::Registry loads CGI programs by calling # eval. These evals don't count when looking at the stack backtrace. sub _longmess { my $message = Carp::longmess(); $message =~ s,eval[^\n]+(ModPerl|Apache)/(?:Registry|Dispatch)\w*\.pm.*,,s if exists $ENV{MOD_PERL}; return $message; } sub ineval { (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m } sub die { # 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; 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 and $CGI::Carp::TO_BROWSER); $arg=~s/^/ stamp() /gme if $arg =~ /\n$/ or not exists $ENV{MOD_PERL}; $arg .= "\n" unless $arg =~ /\n$/; realdie $arg; } sub set_message { $CGI::Carp::CUSTOM_MSG = shift; return $CGI::Carp::CUSTOM_MSG; } sub set_die_handler { my ($handler) = shift; #setting SIG{__DIE__} here is necessary to catch runtime #errors which are not called by literally saying "die", #such as the line "undef->explode();". however, doing this #will interfere with fatalsToBrowser, which also sets #SIG{__DIE__} in the import() function above (or the #import() function above may interfere with this). for #this reason, you should choose to either set the die #handler here, or use fatalsToBrowser, not both. $main::SIG{__DIE__} = $handler; $CGI::Carp::DIE_HANDLER = $handler; return $CGI::Carp::DIE_HANDLER; } sub confess { CGI::Carp::die Carp::longmess @_; } sub croak { CGI::Carp::die Carp::shortmess @_; } sub carp { CGI::Carp::warn Carp::shortmess @_; } sub cluck { CGI::Carp::warn Carp::longmess @_; } # We have to be ready to accept a filehandle as a reference # or a string. sub carpout { my($in) = @_; my($no) = fileno(to_filehandle($in)); realdie("Invalid filehandle $in\n") unless defined $no; open(SAVEERR, ">&STDERR"); open(STDERR, ">&$no") or ( print SAVEERR "Unable to redirect >&$no: $!\n" and exit(1) ); } sub warningsToBrowser { $EMIT_WARNINGS = @_ ? shift : 1; _warn(shift @WARNINGS) while $EMIT_WARNINGS and @WARNINGS; } # headers sub fatalsToBrowser { my $msg = shift; $msg = "$msg" if ref $msg; $msg=~s/&/&/g; $msg=~s/>/>/g; $msg=~s/$ENV{SERVER_ADMIN})] : "this site's webmaster"; my ($outer_message) = <Software error: 
$msg

$outer_message

END ; if ($mod_perl) { my $r; if ($ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { $mod_perl = 2; require Apache2::RequestRec; require Apache2::RequestIO; require Apache2::RequestUtil; require APR::Pool; require ModPerl::Util; require Apache2::Response; $r = Apache2::RequestUtil->request; } else { $r = Apache->request; } # If bytes have already been sent, then # we print the message out directly. # Otherwise we make a custom error # handler to produce the doc for us. if ($r->bytes_sent) { $r->print($mess); $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit; } else { # MSIE won't display a custom 500 response unless it is >512 bytes! if (defined($ENV{HTTP_USER_AGENT}) && $ENV{HTTP_USER_AGENT} =~ /MSIE/) { $mess = "\n$mess"; } $r->custom_response(500,$mess); } } else { my $bytes_written = eval{tell STDOUT}; if (defined $bytes_written && $bytes_written > 0) { print STDOUT $mess; } else { print STDOUT "Status: 500\n"; print STDOUT "Content-type: text/html\n\n"; # MSIE won't display a custom 500 response unless it is >512 bytes! if (defined($ENV{HTTP_USER_AGENT}) && $ENV{HTTP_USER_AGENT} =~ /MSIE/) { $mess = "\n$mess"; } print STDOUT $mess; } } warningsToBrowser(1); # emit warnings before dying } # Cut and paste from CGI.pm so that we don't have the overhead of # always loading the entire CGI module. sub to_filehandle { my $thingy = shift; return undef unless $thingy; return $thingy if UNIVERSAL::isa($thingy,'GLOB'); return $thingy if UNIVERSAL::isa($thingy,'FileHandle'); if (!ref($thingy)) { my $caller = 1; while (my $package = caller($caller++)) { my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; return $tmp if defined(fileno($tmp)); } } return undef; } 1; CGI-4.68/lib/CGI/Util.pm000644 000765 000024 00000026752 14770522143 016030 0ustar00leejohnsonstaff000000 000000 package CGI::Util; use parent 'Exporter'; require 5.008001; use strict; our @EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic check_hash_param); our $VERSION = '4.67'; our $_EBCDIC = "\t" ne "\011"; my $appease_cpants_kwalitee = q/ use strict; use warnings; #/; # (ord('^') == 95) for codepage 1047 as on os390, vmesa 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, 240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111, 124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214, 215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109, 121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150, 151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161, 7, 32, 33, 34, 35, 36, 37, 6, 23, 40, 41, 42, 43, 44, 9, 10, 27, 48, 49, 26, 51, 52, 53, 54, 8, 56, 57, 58, 59, 4, 20, 62,255, 65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188, 144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171, 100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119, 172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89, 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 ); 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, 144,145, 22,147,148,149,150, 4,152,153,154,155, 20, 21,158, 26, 32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124, 38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94, 45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63, 248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34, 216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177, 176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164, 181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174, 172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215, 123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245, 125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255, 92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213, 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 $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; $A2E[175] = 161; $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173; $A2E[249] = 192; $E2A[74] = 96; $E2A[95] = 159; $E2A[106] = 94; $E2A[121] = 168; $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172; $E2A[187] = 91; $E2A[188] = 92; $E2A[192] = 249; $E2A[208] = 166; $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 $A2E[10] = 37; $A2E[91] = 186; $A2E[93] = 187; $A2E[94] = 176; $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173; $E2A[21] = 133; $E2A[37] = 10; $E2A[95] = 172; $E2A[173] = 221; $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168; } # Smart rearrangement of parameters to allow named parameter # calling. We do the rearrangement if: # the first parameter begins with a - sub rearrange { my ($order,@param) = @_; my ($result, $leftover) = _rearrange_params( $order, @param ); push @$result, make_attributes( $leftover, defined $CGI::Q ? $CGI::Q->{escape} : 1 ) if keys %$leftover; @$result; } sub rearrange_header { my ($order,@param) = @_; my ($result,$leftover) = _rearrange_params( $order, @param ); push @$result, make_attributes( $leftover, 0, 1 ) if keys %$leftover; @$result; } sub _rearrange_params { my($order,@param) = @_; return [] unless @param; if (ref($param[0]) eq 'HASH') { @param = %{$param[0]}; } else { return \@param unless (defined($param[0]) && check_hash_param(@param)); } # map parameters into positional indices my ($i,%pos); $i = 0; foreach (@$order) { foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; } $i++; } my %params_as_hash = ( @param ); my (@result,%leftover); $#result = $#$order; # preextend foreach my $k ( # sort keys alphabetically but favour certain keys before others # specifically for the case where there could be several options # for a param key, but one should be preferred (see GH #155) sort { if ( $a =~ /content/i ) { return 1 } elsif ( $b =~ /content/i ) { return -1 } else { $a cmp $b } } keys( %params_as_hash ) ) { my $key = lc($k); $key =~ s/^\-//; if (exists $pos{$key}) { $result[$pos{$key}] = $params_as_hash{$k}; } else { $leftover{$key} = $params_as_hash{$k}; } } return \@result, \%leftover; } sub make_attributes { my $attr = shift; return () unless $attr && ref($attr) && ref($attr) eq 'HASH'; my $escape = shift || 0; my $do_not_quote = shift; my $quote = $do_not_quote ? '' : '"'; my @attr_keys= sort keys %$attr; my(@att); foreach (@attr_keys) { my($key) = $_; $key=~s/^\-//; # get rid of initial - if present # old way: breaks EBCDIC! # $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes ($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_}; push(@att,defined($attr->{$_}) ? qq/$key=$quote$value$quote/ : qq/$key/); } return sort @att; } sub simple_escape { return unless defined(my $toencode = shift); $toencode =~ s{&}{&}gso; $toencode =~ s{<}{<}gso; $toencode =~ s{>}{>}gso; $toencode =~ s{\"}{"}gso; # Doesn't work. Can't work. forget it. # $toencode =~ s{\x8b}{‹}gso; # $toencode =~ s{\x9b}{›}gso; $toencode; } sub utf8_chr { my $c = shift(@_); my $u = chr($c); utf8::encode($u); # drop utf8 flag return $u; } # unescape URL-encoded data sub unescape { shift() if @_ > 0 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass)); my $todecode = shift; return undef unless defined($todecode); $todecode =~ tr/+/ /; # pluses become spaces if ($_EBCDIC) { $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge; } else { # 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 }{ utf8_chr( 0x10000 + (hex($1) - 0xD800) * 0x400 + (hex($2) - 0xDC00) ) }gex; $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/ defined($1)? chr hex($1) : utf8_chr(hex($2))/ge; } return $todecode; } # URL-encode data # # 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. # 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., # when the source file used utf-8 without the appropriate "use utf8;". # This fails if the byte string is actually a Latin 1 encoded string, but it # was always so and cannot be fixed without breaking the binary data case. # -- Stepan Kasal # 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 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; } return $toencode; } # This internal routine creates date strings suitable for use in # cookies and HTTP headers. (They differ, unfortunately.) # Thanks to Mark Fisher for this. sub expires { my $time = shift; my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/; # pass through preformatted dates for the sake of expire_calc() $time = expire_calc($time); return $time unless $time =~ /^\d+$/; my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time); $year += 1900; return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec); } # This internal routine creates an expires time exactly some number of # hours from the current time. It incorporates modifications from # Mark Fisher. sub expire_calc { my($time) = @_; my(%mult) = ('s'=>1, 'm'=>60, 'h'=>60*60, 'd'=>60*60*24, 'M'=>60*60*24*30, 'y'=>60*60*24*365); # format for time can be in any of the forms... # "now" -- expire immediately # "+180s" -- in 180 seconds # "+2m" -- in 2 minutes # "+12h" -- in 12 hours # "+1d" -- in 1 day # "+3M" -- in 3 months # "+2y" -- in 2 years # "-3m" -- 3 minutes ago(!) # If you don't supply one of these forms, we assume you are # specifying the date yourself my($offset); if (!$time || (lc($time) eq 'now')) { $offset = 0; } elsif ($time=~/^\d+/) { return $time; } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([smhdMy])/) { $offset = ($mult{$2} || 1)*$1; } else { return $time; } my $cur_time = time; return ($cur_time+$offset); } sub ebcdic2ascii { my $data = shift; $data =~ s/(.)/chr $E2A[ord($1)]/ge; $data; } sub ascii2ebcdic { my $data = shift; $data =~ s/(.)/chr $A2E[ord($1)]/ge; $data; } sub check_hash_param { my $cnt = scalar(@_); return 0 unless $cnt; if ($cnt < 2 || $cnt % 2) { return substr($_[0], 0, 1) eq '-' ? 1 : 0; } my %h = @_; foreach (keys %h) { return 1 if substr($_, 0, 1) eq '-'; } return 0; } 1; __END__ =head1 NAME CGI::Util - Internal utilities used by CGI module =head1 SYNOPSIS none =head1 DESCRIPTION no public subroutines =head1 AUTHOR INFORMATION The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein. It is distributed under the Artistic License 2.0. It is currently maintained by Lee Johnson with help from many contributors. Address bug reports and comments to: https://github.com/leejo/CGI.pm/issues The original bug tracker can be found at: 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 SEE ALSO L =cut CGI-4.68/lib/CGI/Cookie.pm000644 000765 000024 00000044456 14737513614 016333 0ustar00leejohnsonstaff000000 000000 package CGI::Cookie; use strict; use warnings; our $VERSION='4.59'; use CGI::Util qw(rearrange unescape escape); use overload '""' => \&as_string, 'cmp' => \&compare, 'fallback' => 1; my $PERLEX = 0; # Turn on special checking for ActiveState's PerlEx $PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; # 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) { if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { $MOD_PERL = 2; require Apache2::RequestUtil; require APR::Table; } else { $MOD_PERL = 1; require Apache; } } # fetch a list of cookies from the environment and # return as a hash. the cookies are parsed as normal # escaped URL data. sub fetch { my $class = shift; my $raw_cookie = get_raw_cookie(@_) or return; return $class->parse($raw_cookie); } # Fetch a list of cookies from the environment or the incoming headers and # return as a hash. The cookie values are not unescaped or altered in any way. sub raw_fetch { my $class = shift; my $raw_cookie = get_raw_cookie(@_) or return; my %results; my($key,$value); my @pairs = split("[;,] ?",$raw_cookie); 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 { my $r = shift; $r ||= eval { $MOD_PERL == 2 ? Apache2::RequestUtil->request() : Apache->request } if $MOD_PERL; return $r->headers_in->{'Cookie'} if $r; die "Run $r->subprocess_env; before calling fetch()" if $MOD_PERL and !exists $ENV{REQUEST_METHOD}; return $ENV{HTTP_COOKIE} || $ENV{COOKIE}; } sub parse { my ($self,$raw_cookie) = @_; return wantarray ? () : {} unless $raw_cookie; my ($expires_name, $expires_value) = $raw_cookie =~ /(expires)=([^;]+)/ixsm; my %results; if ( $expires_name ) { $raw_cookie =~ s/$expires_name=$expires_value//xsm; $results{$expires_name} = $self->new(-name => $expires_name, -value => $expires_value); } my @pairs = split("[;,] ?",$raw_cookie); for (@pairs) { s/^\s+//; s/\s+$//; my($key,$value) = split("=",$_,2); # Some foreign cookies are not in name=value format, so ignore # them. next if !defined($value); my @values = (); if ($value ne '') { @values = map unescape($_),split(/[&;]/,$value.'&dmy'); pop @values; } $key = unescape($key); # A bug in Netscape can cause several cookies with same name to # appear. The FIRST one in HTTP_COOKIE is the most recent version. $results{$key} ||= $self->new(-name=>$key,-value=>\@values); } return wantarray ? %results : \%results; } sub new { my ( $class, @params ) = @_; $class = ref( $class ) || $class; # Ignore mod_perl request object--compatibility with Apache::Cookie. shift if ref $params[0] && eval { $params[0]->isa('Apache::Request::Req') || $params[0]->isa('Apache') }; my ( $name, $value, $path, $domain, $secure, $expires, $max_age, $httponly, $samesite, $priority, $partitioned ) = rearrange( [ 'NAME', [ 'VALUE', 'VALUES' ], 'PATH', 'DOMAIN', 'SECURE', 'EXPIRES', 'MAX-AGE','HTTPONLY','SAMESITE', 'PRIORITY', 'PARTITIONED', ], @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( $max_age ) if defined $max_age; $self->httponly( $httponly ) if defined $httponly; $self->samesite( $samesite ) if defined $samesite; $self->priority( $priority ) if defined $priority; $self->partitioned( $partitioned ) if defined $partitioned; return $self; } sub as_string { my $self = shift; return "" unless $self->name; 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 @cookie,"SameSite=".$self->samesite if $self->samesite; push @cookie,"Priority=".$self->priority if $self->priority; push @cookie,"Partitioned" if $self->partitioned; return join "; ", @cookie; } sub compare { my ( $self, $value ) = @_; return "$self" cmp $value; } sub bake { my ($self, $r) = @_; $r ||= eval { $MOD_PERL == 2 ? Apache2::RequestUtil->request() : Apache->request } if $MOD_PERL; if ($r) { $r->err_headers_out->add('Set-Cookie' => $self->as_string); } else { require CGI; print CGI::header(-cookie => $self); } } # accessors sub name { my ( $self, $name ) = @_; $self->{'name'} = $name if defined $name; return $self->{'name'}; } sub value { 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, $domain ) = @_; $self->{'domain'} = lc $domain if defined $domain; return $self->{'domain'}; } sub secure { my ( $self, $secure ) = @_; $self->{'secure'} = $secure if defined $secure; return $self->{'secure'}; } sub expires { my ( $self, $expires ) = @_; $self->{'expires'} = CGI::Util::expires($expires) if defined $expires; return $self->{'expires'}; } sub 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, $path ) = @_; $self->{'path'} = $path if defined $path; return $self->{'path'}; } sub httponly { # HttpOnly my ( $self, $httponly ) = @_; $self->{'httponly'} = $httponly if defined $httponly; return $self->{'httponly'}; } sub partitioned { # Partitioned my ( $self, $partitioned ) = @_; $self->{'partitioned'} = $partitioned if defined $partitioned; return $self->{'partitioned'}; } my %_legal_samesite = ( Strict => 1, Lax => 1, None => 1 ); sub samesite { # SameSite my $self = shift; my $samesite = ucfirst lc +shift if @_; # Normalize casing. $self->{'samesite'} = $samesite if $samesite and $_legal_samesite{$samesite}; return $self->{'samesite'}; } my %_legal_priority = ( Low => 1, Medium => 1, High => 1 ); sub priority { my $self = shift; my $priority = ucfirst lc +shift if @_; if ($priority && $_legal_priority{$priority}) { $self->{'priority'} = $priority; } return $self->{'priority'}; } 1; =head1 NAME CGI::Cookie - Interface to HTTP Cookies =head1 SYNOPSIS use CGI qw/:standard/; use CGI::Cookie; # Create new cookies and send them $cookie1 = CGI::Cookie->new(-name=>'ID',-value=>123456); $cookie2 = CGI::Cookie->new(-name=>'preferences', -value=>{ font => Helvetica, size => 12 } ); print header(-cookie=>[$cookie1,$cookie2]); # fetch existing cookies %cookies = CGI::Cookie->fetch; $id = $cookies{'ID'}->value; # create cookies returned from an external source %cookies = CGI::Cookie->parse($ENV{COOKIE}); =head1 DESCRIPTION CGI::Cookie is an interface to HTTP/1.1 cookies, a mechanism that allows Web servers to store persistent information on the browser's side of the connection. Although CGI::Cookie is intended to be used in conjunction with CGI.pm (and is in fact used by it internally), you can use this module independently. For full information on cookies see https://tools.ietf.org/html/rfc6265 =head1 USING CGI::Cookie CGI::Cookie is object oriented. Each cookie object has a name and a value. The name is any scalar value. The value is any scalar or array value (associative arrays are also allowed). Cookies also have several optional attributes, including: =over 4 =item B<1. expiration date> The expiration date tells the browser how long to hang on to the cookie. If the cookie specifies an expiration date in the future, the browser will store the cookie information in a disk file and return it to the server every time the user reconnects (until the expiration date is reached). If the cookie species an expiration date in the past, the browser will remove the cookie from the disk file. If the expiration date is not specified, the cookie will persist only until the user quits the browser. =item B<2. domain> 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 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 on top level domains like ".edu". If no domain is specified, then the browser will only return the cookie to servers on the host the cookie originated from. =item B<3. path> If you provide a cookie path attribute, the browser will check it against your script's URL before returning the cookie. For example, if you specify the path "/cgi-bin", then the cookie will be returned to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", and "/cgi-bin/customer_service/complain.pl", but not to the script "/cgi-private/site_admin.pl". By default, the path is set to "/", so that all scripts at your site will receive the cookie. =item B<4. secure flag> 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<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). This feature is supported by nearly all modern browsers. See these URLs for more information: http://msdn.microsoft.com/en-us/library/ms533046.aspx http://www.browserscope.org/?category=security&v=top =item B<6. samesite flag> Allowed settings are C, C and C. As of June 2016, support is limited to recent releases of Chrome and Opera. L =item B<7. priority flag> Allowed settings are C, C and C. Support is limited to recent releases of Chrome. =back =head2 Creating New Cookies my $c = CGI::Cookie->new(-name => 'foo', -value => 'bar', -expires => '+3M', '-max-age' => '+3M', -domain => '.capricorn.com', -path => '/cgi-bin/database', -secure => 1, -samesite=> "Lax", -priority=> "High", ); Create cookies from scratch with the B method. The B<-name> and B<-value> parameters are required. The name must be a scalar value. The value can be a scalar, an array reference, or a hash reference. (At some point in the future cookies will support one of the Perl object serialization protocols for full generality). B<-expires> accepts any of the relative or absolute date formats 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. B<-path> points to a partial URL on the current server. The cookie will be returned to all URLs beginning with the specified path. If not specified, it defaults to '/', which returns the cookie to all pages at your site. B<-secure> if set to a true value instructs the browser to return the cookie only when a cryptographic protocol is in use. B<-httponly> if set to a true value, the cookie will not be accessible via JavaScript. B<-samesite> may be C, C, or C and is an evolving part of the standards for cookies. Please refer to current documentation regarding it. For compatibility with Apache::Cookie, you may optionally pass in a mod_perl request object as the first argument to C. It will simply be ignored: my $c = CGI::Cookie->new($r, -name => 'foo', -value => ['bar','baz']); =head2 Sending the Cookie to the Browser The simplest way to send a cookie to the browser is by calling the bake() method: $c->bake; This will print the Set-Cookie HTTP header to STDOUT using CGI.pm. CGI.pm will be loaded for this purpose if it is not already. Otherwise CGI.pm is not required or used by this module. Under mod_perl, pass in an Apache request object: $c->bake($r); If you want to set the cookie yourself, Within a CGI script you can send a cookie to the browser by creating one or more Set-Cookie: fields in the HTTP header. Here is a typical sequence: my $c = CGI::Cookie->new(-name => 'foo', -value => ['bar','baz'], -expires => '+3M'); print "Set-Cookie: $c\n"; print "Content-Type: text/html\n\n"; To send more than one cookie, create several Set-Cookie: fields. If you are using CGI.pm, you send cookies by providing a -cookie argument to the header() method: print header(-cookie=>$c); Mod_perl users can set cookies using the request object's header_out() method: $r->err_headers_out->add('Set-Cookie' => $c); Internally, Cookie overloads the "" operator to call its as_string() method when incorporated into the HTTP header. as_string() turns the Cookie's internal representation into an RFC-compliant text representation. You may call as_string() yourself if you prefer: print "Set-Cookie: ",$c->as_string,"\n"; =head2 Recovering Previous Cookies %cookies = CGI::Cookie->fetch; B returns an associative array consisting of all cookies returned by the browser. The keys of the array are the cookie names. You can iterate through the cookies this way: %cookies = CGI::Cookie->fetch; for (keys %cookies) { do_something($cookies{$_}); } In a scalar context, fetch() returns a hash reference, which may be more efficient if you are manipulating multiple cookies. CGI.pm uses the URL escaping methods to save and restore reserved characters in its cookies. If you are trying to retrieve a cookie set by a foreign server, this escaping method may trip you up. Use raw_fetch() instead, which has the same semantics as fetch(), but performs no unescaping. You may also retrieve cookies that were stored in some external form using the parse() class method: $COOKIES = `cat /usr/tmp/Cookie_stash`; %cookies = CGI::Cookie->parse($COOKIES); If you are in a mod_perl environment, you can save some overhead by passing the request object to fetch() like this: CGI::Cookie->fetch($r); If the value passed to parse() is undefined, an empty array will returned in list context, and an empty hashref will be returned in scalar context. =head2 Manipulating Cookies Cookie objects have a series of accessor methods to get and set cookie attributes. Each accessor has a similar syntax. Called without arguments, the accessor returns the current value of the attribute. Called with an argument, the accessor changes the attribute and returns its new value. =over 4 =item B Get or set the cookie's name. Example: $name = $c->name; $new_name = $c->name('fred'); =item B Get or set the cookie's value. Example: $value = $c->value; @new_value = $c->value(['a','b','c','d']); B is context sensitive. In a list context it will return the current value of the cookie as an array. In a scalar context it will return the B value of a multivalued cookie. =item B Get or set the cookie's domain. =item B Get or set the cookie's path. =item B Get or set the cookie's expiration time. =item B Get or set the cookie's max_age value. =back =head1 AUTHOR INFORMATION The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein. It is distributed under the Artistic License 2.0. It is currently maintained by Lee Johnson with help from many contributors. Address bug reports and comments to: https://github.com/leejo/CGI.pm/issues The original bug tracker can be found at: 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 BUGS This section intentionally left blank. =head1 SEE ALSO L, L L, L =cut CGI-4.68/lib/CGI/Pretty.pm000644 000765 000024 00000003627 14770523122 016374 0ustar00leejohnsonstaff000000 000000 package CGI::Pretty; use strict; use warnings; use CGI (); $CGI::Pretty::VERSION = '4.68'; $CGI::DefaultClass = __PACKAGE__; @CGI::Pretty::ISA = qw( CGI ); sub new { my $class = shift; my $this = $class->SUPER::new( @_ ); return bless $this, $class; } sub import { warn "CGI::Pretty is DEPRECATED and will be removed in a future release. Please see https://github.com/leejo/CGI.pm/issues/162 for more information"; my $self = shift; no strict 'refs'; # This causes modules to clash. undef %CGI::EXPORT; undef %CGI::EXPORT; $self->_setup_symbols(@_); my ($callpack, $callfile, $callline) = caller; # To allow overriding, search through the packages # Till we find one in which the correct subroutine is defined. my @packages = ($self,@{"$self\:\:ISA"}); foreach my $sym (keys %CGI::EXPORT) { my $pck; my $def = $CGI::DefaultClass; foreach $pck (@packages) { if (defined(&{"$pck\:\:$sym"})) { $def = $pck; last; } } *{"${callpack}::$sym"} = \&{"$def\:\:$sym"}; } } 1; =head1 NAME CGI::Pretty - module to produce nicely formatted HTML code =head1 CGI::Pretty IS DEPRECATED It will be removed from the CGI distribution in a future release, so you should no longer use it and remove it from any code that currently uses it. For now it has been reduced to a shell to prevent your code breaking, but the "pretty" functions will no longer output "pretty" HTML. =head1 Alternatives L + L + L: print HTML::HTML5::Writer->new( start_tags => 'force', end_tags => 'force', )->document( XML::LibXML::PrettyPrint->new_for_html( indent_string => "\t" ) ->pretty_print( HTML::HTML5::Parser->new->parse_string( $html_string ) ) ); L (see the html_fmt script for examples) L L =cut CGI-4.68/lib/CGI/HTML/000755 000765 000024 00000000000 14772731701 015311 5ustar00leejohnsonstaff000000 000000 CGI-4.68/lib/CGI/Push.pm000644 000765 000024 00000023575 14770523123 016031 0ustar00leejohnsonstaff000000 000000 package CGI::Push; my $appease_cpants_kwalitee = q/ use strict; use warnings; #/; $CGI::Push::VERSION='4.68'; use CGI; use CGI::Util 'rearrange'; @ISA = ('CGI'); $CGI::DefaultClass = 'CGI::Push'; # add do_push() and push_delay() to exported tags push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push','push_delay'); sub do_push { my ($self,@p) = CGI::self_or_default(@_); # unbuffer output $| = 1; srand; my ($random) = sprintf("%08.0f",rand()*1E8); my ($boundary) = "----=_NeXtPaRt$random"; my (@header); my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,$nph,@other) = rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p); $type = 'text/html' unless $type; $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE'; $delay = 1 unless defined($delay); $self->push_delay($delay); $nph = 1 unless defined($nph); my(@o); foreach (@other) { push(@o,split("=")); } push(@o,'-Target'=>$target) if defined($target); push(@o,'-Cookie'=>$cookie) if defined($cookie); push(@o,'-Type'=>"multipart/x-mixed-replace;boundary=\"$boundary\""); push(@o,'-Server'=>"CGI.pm Push Module") if $nph; push(@o,'-Status'=>'200 OK'); push(@o,'-nph'=>1) if $nph; print $self->header(@o); $boundary = "$CGI::CRLF--$boundary"; print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.${boundary}$CGI::CRLF"; my (@contents) = &$callback($self,++$COUNTER); # now we enter a little loop while (1) { print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i; print @contents; @contents = &$callback($self,++$COUNTER); if ((@contents) && defined($contents[0])) { print "${boundary}$CGI::CRLF"; do_sleep($self->push_delay()) if $self->push_delay(); } else { if ($last_page && ref($last_page) eq 'CODE') { print "${boundary}$CGI::CRLF"; do_sleep($self->push_delay()) if $self->push_delay(); print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i; print &$last_page($self,$COUNTER); } print "${boundary}--$CGI::CRLF"; last; } } print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.$CGI::CRLF"; } sub simple_counter { my ($self,$count) = @_; return $self->start_html("CGI::Push Default Counter"), $self->h1("CGI::Push Default Counter"), "This page has been updated ",$self->strong($count)," times.", $self->hr(), $self->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'), $self->end_html; } sub do_sleep { my $delay = shift; if ( ($delay >= 1) && ($delay!~/\./) ){ sleep($delay); } else { select(undef,undef,undef,$delay); return $delay; } } sub push_delay { my ($self,$delay) = CGI::self_or_default(@_); return defined($delay) ? $self->{'.delay'} = $delay : $self->{'.delay'}; } 1; =head1 NAME CGI::Push - Simple Interface to Server Push =head1 SYNOPSIS use strict; use warnings; use CGI::Push qw(:standard); do_push( -next_page => \&next_page, -last_page => \&last_page, -delay => 0.5 ); sub next_page { my($q,$counter) = @_; return undef if $counter >= 10; .... } sub last_page { my($q,$counter) = @_; return ... } =head1 DESCRIPTION CGI::Push is a subclass of the CGI object created by CGI.pm. It is specialized for server push operations, which allow you to create animated pages whose content changes at regular intervals. You provide CGI::Push with a pointer to a subroutine that will draw one page. Every time your subroutine is called, it generates a new page. The contents of the page will be transmitted to the browser in such a way that it will replace what was there beforehand. The technique will work with HTML pages as well as with graphics files, allowing you to create animated GIFs. Only Netscape Navigator supports server push. Internet Explorer browsers do not. =head1 USING CGI::Push CGI::Push adds one new method to the standard CGI suite, do_push(). When you call this method, you pass it a reference to a subroutine that is responsible for drawing each new page, an interval delay, and an optional subroutine for drawing the last page. Other optional parameters include most of those recognized by the CGI header() method. You may call do_push() in the object oriented manner or not, as you prefer: use CGI::Push; $q = CGI::Push->new; $q->do_push(-next_page=>\&draw_a_page); -or- use CGI::Push qw(:standard); do_push(-next_page=>\&draw_a_page); Parameters are as follows: =over 4 =item -next_page do_push(-next_page=>\&my_draw_routine); This required parameter points to a reference to a subroutine responsible for drawing each new page. The subroutine should expect two parameters consisting of the CGI object and a counter indicating the number of times the subroutine has been called. It should return the contents of the page as an B of one or more items to print. It can return a false value (or an empty array) in order to abort the redrawing loop and print out the final page (if any) sub my_draw_routine { my($q,$counter) = @_; return undef if $counter > 100; ... } You are of course free to refer to create and use global variables within your draw routine in order to achieve special effects. =item -last_page This optional parameter points to a reference to the subroutine responsible for drawing the last page of the series. It is called after the -next_page routine returns a false value. The subroutine itself should have exactly the same calling conventions as the -next_page routine. =item -type 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 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 "heterogeneous pages" for more details. =item -delay This indicates the delay, in seconds, between frames. Smaller delays refresh the page faster. Fractional values are allowed. B =item -cookie, -target, -expires, -nph These have the same meaning as the like-named parameters in CGI::header(). If not specified, -nph will default to 1 (as needed for many servers, see below). =back =head2 Heterogeneous Pages Ordinarily all pages displayed by CGI::Push share a common MIME type. However by providing a value of "heterogeneous" or "dynamic" in the do_push() -type parameter, you can specify the MIME type of each page on a case-by-case basis. If you use this option, you will be responsible for producing the HTTP header for each page. Simply modify your draw routine to look like this: sub my_draw_routine { my($q,$counter) = @_; return header('text/html'), # note we're producing the header here .... } You can add any header fields that you like, but some (cookies and status fields included) may not be interpreted by the browser. One interesting effect is to display a series of pages, then, after the last page, to redirect the browser to a new URL. Because redirect() does b work, the easiest way is with a -refresh header field, as shown below: sub my_draw_routine { my($q,$counter) = @_; return undef if $counter > 10; return header('text/html'), # note we're producing the header here ... } sub my_last_page { return header(-refresh=>'5; URL=http://somewhere.else/finished.html', -type=>'text/html'), ... } =head2 Changing the Page Delay on the Fly If you would like to control the delay between pages on a page-by-page basis, call push_delay() from within your draw routine. push_delay() takes a single numeric argument representing the number of seconds you wish to delay after the current page is displayed and before displaying the next one. The delay may be fractional. Without parameters, push_delay() just returns the current delay. =head1 INSTALLING CGI::Push SCRIPTS Server push scripts must be installed as no-parsed-header (NPH) scripts in order to work correctly on many servers. On Unix systems, this is most often accomplished by prefixing the script's name with "nph-". Recognition of NPH scripts happens automatically with WebSTAR and Microsoft IIS. Users of other servers should see their documentation for help. Apache web server from version 1.3b2 on does not need server push scripts installed as NPH scripts: the -nph parameter to do_push() may be set to a false value to disable the extra headers needed by an NPH script. =head1 AUTHOR INFORMATION The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein. It is distributed under the Artistic License 2.0. It is currently maintained by Lee Johnson with help from many contributors. Address bug reports and comments to: https://github.com/leejo/CGI.pm/issues The original bug tracker can be found at: 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. Copyright 1995-1998, Lincoln D. Stein. All rights reserved. =head1 BUGS This section intentionally left blank. =head1 SEE ALSO L, L =cut CGI-4.68/lib/CGI/HTML/Functions.pm000644 000765 000024 00000000175 14171527774 017630 0ustar00leejohnsonstaff000000 000000 package CGI::HTML::Functions; use strict; use warnings; # nothing here yet... may move functions here in the long term 1; CGI-4.68/lib/CGI/HTML/Functions.pod000644 000765 000024 00000166160 14171527774 020005 0ustar00leejohnsonstaff000000 000000 =head1 NAME CGI::HTML::Functions - Documentation for CGI.pm Legacy HTML Functionality =head1 SYNOPSIS Nothing here - please do not use this functionality, it is considered to be legacy and essentially deprecated. This documentation exists solely to aid in maintenance and migration of legacy code using this functionality and you are strongly encouraged to migrate away from it. If you are working on new code you should be using a template engine. For more information see L. If you really want to continue using the HTML generation functionality of CGI.pm then you should take a look at L instead, which may give you a migration path away from CGI.pm's html generation functions; i strongly encourage you to move towards template driven page generation for anything involving markup as it will make porting your app to other frameworks much easier in the long run. =head1 DESCRIPTION The documentation here should be considered an addendum to the sections in the L documentation - the sections here are named the same as those within the CGI perldoc. =head1 Calling CGI.pm routines HTML tag functions have both attributes (the attribute="value" pairs within the tag itself) and contents (the part between the opening and closing pairs). To distinguish between attributes and contents, CGI.pm uses the convention of passing HTML attributes as a hash reference as the first argument, and the contents, if any, as any subsequent arguments. It works out like this: Code Generated HTML ---- -------------- h1()

h1('some','contents');

some contents

h1({-align=>left});

h1({-align=>left},'contents');

contents

Many newcomers to CGI.pm are puzzled by the difference between the calling conventions for the HTML shortcuts, which require curly braces around the HTML tag attributes, and the calling conventions for other routines, which manage to generate attributes without the curly brackets. Don't be confused. As a convenience the curly braces are optional in all but the HTML shortcuts. If you like, you can use curly braces when calling any routine that takes named arguments. For example: print $q->header( { -type => 'image/gif', -expires => '+3d' } ); If you use warnings, you will be warned that some CGI.pm argument names conflict with built-in perl functions. The most frequent of these is the -values argument, used to create multi-valued menus, radio button clusters and the like. To get around this warning, you have several choices: =over 4 =item 1. Use another name for the argument, if one is available. For example, -value is an alias for -values. =item 2. Change the capitalization, e.g. -Values =item 3. Put quotes around the argument name, e.g. '-values' =back =head2 Function-oriented interface HTML exports Here is a list of the HTML related function sets you can import: =over 4 =item B<:form> Import all fill-out form generating methods, such as B. =item B<:html2> Import all methods that generate HTML 2.0 standard elements. =item B<:html3> Import all methods that generate HTML 3.0 elements (such as , and ). =item B<:html4> Import all methods that generate HTML 4 elements (such as , and ). =item B<:netscape> Import the , and
tags. =item B<:html> Import all HTML-generating shortcuts (i.e. 'html2', 'html3', 'html4' and 'netscape') =item B<:standard> Import "standard" features, 'html2', 'html3', 'html4', 'ssl', 'form' and 'cgi'. =back If you import any of the state-maintaining CGI or form-generating methods, a default CGI object will be created and initialized automatically the first time you use any of the methods that require one to be present. This includes B, B, B and the like. (If you need direct access to the CGI object, you can find it in the global variable B<$CGI::Q>). =head2 Pragmas Additional HTML generation related pragms: =over 4 =item -nosticky By default the CGI module implements a state-preserving behavior called "sticky" fields. The way this works is that if you are regenerating a form, the methods that generate the form field values will interrogate param() to see if similarly-named parameters are present in the query string. If they find a like-named parameter, they will use it to set their default values. Sometimes this isn't what you want. The B<-nosticky> pragma prevents this behavior. You can also selectively change the sticky behavior in each element that you generate. =item -tabindex Automatically add tab index attributes to each form field. With this option turned off, you can still add tab indexes manually by passing a -tabindex option to each field-generating method. =item -no_xhtml By default, CGI.pm versions 2.69 and higher emit XHTML (http://www.w3.org/TR/xhtml1/). The -no_xhtml pragma disables this feature. Thanks to Michalis Kabrianis for this feature. If start_html()'s -dtd parameter specifies an HTML 2.0, 3.2, 4.0 or 4.01 DTD, XHTML will automatically be disabled without needing to use this pragma. =back =head2 Special forms for importing HTML-tag functions Many of the methods generate HTML tags. As described below, tag functions automatically generate both the opening and closing tags. For example: print h1('Level 1 Header'); produces

Level 1 Header

There will be some times when you want to produce the start and end tags yourself. In this case, you can use the form start_I and end_I, as in: print start_h1,'Level 1 Header',end_h1; =head2 Creating the HTML document header print start_html( -title => 'Secrets of the Pyramids', -author => 'fred@capricorn.org', -base => 'true', -target => '_blank', -meta => {'keywords'=>'pharaoh secret mummy', 'copyright' => 'copyright 1996 King Tut'}, -style => {'src'=>'/styles/style1.css'}, -BGCOLOR => 'blue' ); 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. This method returns a canned HTML header and the opening tag. All parameters are optional. In the named parameter form, recognized parameters are -title, -author, -base, -xbase, -dtd, -lang and -target (see below for the explanation). Any additional parameters you provide, such as the unofficial BGCOLOR attribute, are added to the tag. Additional parameters must be proceeded by a hyphen. The argument B<-xbase> allows you to provide an HREF for the tag different from the current location, as in -xbase => "http://home.mcom.com/" All relative links will be interpreted relative to this tag. The argument B<-target> allows you to provide a default target frame for all the links and fill-out forms on the page. B B -target => "answer_window" All relative links will be interpreted relative to this tag. You add arbitrary meta information to the header with the B<-meta> argument. This argument expects a reference to a hash containing name/value pairs of meta information. These will be turned into a series of header tags that look something like this: To create an HTTP-EQUIV type of tag, use B<-head>, described below. The B<-style> argument is used to incorporate cascading stylesheets into your code. See the section on CASCADING STYLESHEETS for more information. The B<-lang> argument is used to incorporate a language attribute into the tag. For example: print $q->start_html( -lang => 'fr-CA' ); The default if not specified is "en-US" for US English, unless the -dtd parameter specifies an HTML 2.0 or 3.2 DTD, in which case the lang attribute is left off. You can force the lang attribute to left off in other cases by passing an empty string (-lang=>''). 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 declaration at the top of the HTML header. The sole purpose of this declaration is to declare the character set encoding. In the absence of -declare_xml, the output HTML will contain a tag that specifies the encoding, allowing the HTML to pass most validators. The default for -declare_xml is false. You can place other arbitrary HTML elements to the section with the B<-head> tag. For example, to place a element in the head section, use this: print start_html( -head => Link({ -rel => 'shortcut icon', -href => 'favicon.ico' }) ); To incorporate multiple HTML elements into the section, just pass an array reference: print start_html( -head => [ Link({ -rel => 'next', -href => 'http://www.capricorn.com/s2.html' }), Link({ -rel => 'previous', -href => 'http://www.capricorn.com/s1.html' }) ] ); And here's how to create an HTTP-EQUIV tag: print start_html( -head => meta({ -http_equiv => 'Content-Type', -content => 'text/html' }) ); JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>, B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used to add JavaScript calls to your pages. B<-script> should point to a block of text containing JavaScript function definitions. This block will be placed within a END for my $v (qw/ 2.0 3.2 4.0 4.01 /) { local $CGI::XHTML = 1; is start_html( -dtd => "-//IETF//DTD HTML $v//FR", -lang => 'fr' ), <<"END", 'start_html()'; Untitled Document END } is start_html( -dtd => "-//IETF//DTD HTML 9.99//FR", -lang => 'fr' ), <<"END", 'start_html()'; Untitled Document END my $cookie = cookie( -name => 'fred', -value => [ 'chocolate', 'chip' ], -path => '/' ); is $cookie, 'fred=chocolate&chip; path=/', "cookie()"; my $h = header( -Cookie => $cookie ); like $h, qr!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, "header(-cookie)"; $h = header( '-set-cookie' => $cookie ); like $h, qr!^Set-[Cc]ookie: fred=chocolate&chip\; path=/${CRLF}(Date:.*${CRLF})?Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, "header(-set-cookie)"; my $cookie2 = cookie( -name => 'ginger', -value => 'snap' , -path => '/' ); is $cookie2, 'ginger=snap; path=/', "cookie2()"; $h = header( -cookie => [ $cookie, $cookie2 ] ); like $h, qr!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Set-Cookie: ginger=snap\; path=/${CRLF}(Date:.*${CRLF})?Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, "header(-cookie=>[cookies])"; $h = header( '-set-cookie' => [ $cookie, $cookie2 ] ); like $h, qr!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Set-Cookie: ginger=snap\; path=/${CRLF}(Date:.*${CRLF})?Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, "header(-set-cookie=>[cookies])"; $h = redirect('http://elsewhere.org/'); like $h, qr!Status: 302 Found${CRLF}Location: http://elsewhere.org/!s, "redirect"; $h = redirect(-url=>'http://elsewhere.org/', -cookie=>[$cookie,$cookie2]); like $h, qr!Status: 302 Found${CRLF}Set-[Cc]ookie: \Q$cookie\E${CRLF}Set-[Cc]ookie: \Q$cookie2\E${CRLF}(Date:.*${CRLF})?Location: http://elsewhere.org/!s, "redirect with cookies"; $h = redirect(-url=>'http://elsewhere.org/', '-set-cookie'=>[$cookie,$cookie2]); like $h, qr!Status: 302 Found${CRLF}Set-[Cc]ookie: \Q$cookie\E${CRLF}Set-[Cc]ookie: \Q$cookie2\E${CRLF}(Date:.*${CRLF})?Location: http://elsewhere.org/!s, "redirect with set-cookies"; is start_h3, '

'; is end_h3, '

'; is start_table( { -border => undef } ), '
'; charset('utf-8'); my $old_encode = $CGI::ENCODE_ENTITIES; $CGI::ENCODE_ENTITIES = '<'; isnt h1( escapeHTML("this is \x8bright\x9b") ), '

this is <not> ‹right›

'; undef( $CGI::ENCODE_ENTITIES ); is h1( escapeHTML("this is \x8bright\x9b") ), '

this is <not> ‹right›

'; $CGI::ENCODE_ENTITIES = $old_encode; is i( p('hello there') ), '

hello there

'; my $q = CGI->new; is $q->h1('hi'), '

hi

'; $q->autoEscape(1); is $q->p( { title => "hello worldè" }, 'hello á' ), '

hello á

'; $q->autoEscape(0); is $q->p( { title => "hello worldè" }, 'hello á' ), '

hello á

'; is p( { title => "hello worldè" }, 'hello á' ), '

hello á

'; is header( -type => 'image/gif', -charset => 'UTF-8' ), "Content-Type: image/gif; charset=UTF-8${CRLF}${CRLF}", "header()"; CGI-4.68/t/rt_31107.txt000644 000765 000024 00000002306 14171527774 015570 0ustar00leejohnsonstaff000000 000000 ------=_Part_0.7772611529786723.1196412625897 Content-Type: text/xml Content-Transfer-Encoding: 7bit Content-ID: 4401196412625869430 5.3.0 XXXXX 4401196412625869430 2007-11-30 09:50:25 1000 Request Received ------=_Part_0.7772611529786723.1196412625897 Content-Type: application/x-zip; name=capabilities.zip Content-Transfer-Encoding: base64 Content-Disposition: attachment; filename=capabilities.zip Content-ID: UEsDBBQACAAIA ------=_Part_0.7772611529786723.1196412625897-- CGI-4.68/t/start_end_end.t000644 000765 000024 00000005640 14171527774 016651 0ustar00leejohnsonstaff000000 000000 #!/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); use Test::More tests => 45; use CGI qw(:standard end_h1 end_h2 end_h3 end_h4 end_h5 end_h6 end_table end_ul end_li end_ol end_td end_b end_i end_u end_div); is(start_h1(), "

", "start_h1"); # TEST is(start_h1({class => 'hello'}), "

", "start_h1 with param"); # TEST is(end_h1(), "

", "end_h1"); # TEST is(start_h2(), "

", "start_h2"); # TEST is(start_h2({class => 'hello'}), "

", "start_h2 with param"); # TEST is(end_h2(), "

", "end_h2"); # TEST is(start_h3(), "

", "start_h3"); # TEST is(start_h3({class => 'hello'}), "

", "start_h3 with param"); # TEST is(end_h3(), "

", "end_h3"); # TEST is(start_h4(), "

", "start_h4"); # TEST is(start_h4({class => 'hello'}), "

", "start_h4 with param"); # TEST is(end_h4(), "

", "end_h4"); # TEST is(start_h5(), "
", "start_h5"); # TEST is(start_h5({class => 'hello'}), "
", "start_h5 with param"); # TEST is(end_h5(), "
", "end_h5"); # TEST is(start_h6(), "
", "start_h6"); # TEST is(start_h6({class => 'hello'}), "
", "start_h6 with param"); # TEST is(end_h6(), "
", "end_h6"); # TEST is(start_table(), "
", "start_table"); # TEST is(start_table({class => 'hello'}), "
", "start_table with param"); # TEST is(end_table(), "
", "end_table"); # TEST is(start_ul(), "