HTTP-Message-6.36/000755 000765 000024 00000000000 14165326704 013705 5ustar00olafstaff000000 000000 HTTP-Message-6.36/perltidyrc000644 000765 000024 00000000330 14165326704 016005 0ustar00olafstaff000000 000000 --blank-lines-before-packages=0 --iterations=2 --no-outdent-long-comments -b -bar -boc -ci=4 -i=4 -l=78 -nolq -se -wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" HTTP-Message-6.36/perlcriticrc000644 000765 000024 00000004405 14165326704 016320 0ustar00olafstaff000000 000000 severity = 3 verbose = 11 theme = core + pbp + bugs + maintenance + cosmetic + complexity + security + tests + moose exclude = Subroutines::ProhibitCallsToUndeclaredSubs [BuiltinFunctions::ProhibitStringySplit] severity = 3 [CodeLayout::RequireTrailingCommas] severity = 3 [ControlStructures::ProhibitCStyleForLoops] severity = 3 [InputOutput::RequireCheckedSyscalls] functions = :builtins exclude_functions = sleep severity = 3 [Moose::RequireCleanNamespace] modules = Moose Moose::Role MooseX::Role::Parameterized Moose::Util::TypeConstraints cleaners = namespace::autoclean [NamingConventions::Capitalization] package_exemptions = [A-Z]\w+|minFraud file_lexical_variables = [A-Z]\w+|[^A-Z]+ global_variables = :starts_with_upper scoped_lexical_variables = [A-Z]\w+|[^A-Z]+ severity = 3 # Given our code base, leaving this at 5 would be a huge pain [Subroutines::ProhibitManyArgs] max_arguments = 10 [RegularExpressions::ProhibitComplexRegexes] max_characters = 200 [RegularExpressions::ProhibitUnusualDelimiters] severity = 3 [Subroutines::ProhibitUnusedPrivateSubroutines] private_name_regex = _(?!build)\w+ skip_when_using = Moo::Role Moose::Role MooseX::Role::Parameterized Role::Tiny Test::Class::Moose::Role [TestingAndDebugging::ProhibitNoWarnings] allow = redefine [ValuesAndExpressions::ProhibitEmptyQuotes] severity = 3 [ValuesAndExpressions::ProhibitInterpolationOfLiterals] severity = 3 [ValuesAndExpressions::RequireUpperCaseHeredocTerminator] severity = 3 [Variables::ProhibitPackageVars] add_packages = Test::Builder [TestingAndDebugging::RequireUseStrict] [TestingAndDebugging::RequireUseWarnings] [-ControlStructures::ProhibitCascadingIfElse] [-ErrorHandling::RequireCarping] [-InputOutput::RequireBriefOpen] [-ValuesAndExpressions::ProhibitConstantPragma] # No need for /xsm everywhere [-RegularExpressions::RequireDotMatchAnything] [-RegularExpressions::RequireExtendedFormatting] [-RegularExpressions::RequireLineBoundaryMatching] [-Subroutines::ProhibitExplicitReturnUndef] # http://stackoverflow.com/questions/2275317/why-does-perlcritic-dislike-using-shift-to-populate-subroutine-variables [-Subroutines::RequireArgUnpacking] [-Subroutines::RequireFinalReturn] # "use v5.14" is more readable than "use 5.014" [-ValuesAndExpressions::ProhibitVersionStrings] HTTP-Message-6.36/cpanfile000644 000765 000024 00000003667 14165326704 015425 0ustar00olafstaff000000 000000 # This file is generated by Dist::Zilla::Plugin::CPANFile v6.024 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Carp" => "0"; requires "Compress::Raw::Zlib" => "0"; requires "Encode" => "3.01"; requires "Encode::Locale" => "1"; requires "Exporter" => "5.57"; requires "File::Spec" => "0"; requires "HTTP::Date" => "6"; requires "IO::Compress::Bzip2" => "2.021"; requires "IO::Compress::Deflate" => "0"; requires "IO::Compress::Gzip" => "0"; requires "IO::HTML" => "0"; requires "IO::Uncompress::Bunzip2" => "2.021"; requires "IO::Uncompress::Gunzip" => "0"; requires "IO::Uncompress::Inflate" => "0"; requires "IO::Uncompress::RawInflate" => "0"; requires "LWP::MediaTypes" => "6"; requires "MIME::Base64" => "2.1"; requires "MIME::QuotedPrint" => "0"; requires "URI" => "1.10"; requires "base" => "0"; requires "perl" => "5.008001"; requires "strict" => "0"; requires "warnings" => "0"; suggests "Clone" => "0"; on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "File::Temp" => "0"; requires "PerlIO::encoding" => "0"; requires "Test::More" => "0.88"; requires "Time::Local" => "0"; requires "Try::Tiny" => "0"; requires "URI::URL" => "0"; requires "lib" => "0"; requires "overload" => "0"; requires "perl" => "5.008001"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "perl" => "5.006"; }; on 'configure' => sub { suggests "JSON::PP" => "2.27300"; }; on 'develop' => sub { requires "Clone" => "0"; requires "File::Spec" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Test::CPAN::Changes" => "0.19"; requires "Test::Mojibake" => "0"; requires "Test::More" => "0.96"; requires "Test::Pod" => "1.41"; requires "Test::Portability::Files" => "0"; requires "Test::Version" => "1"; requires "perl" => "5.006"; }; HTTP-Message-6.36/Changes000644 000765 000024 00000017612 14165326704 015207 0ustar00olafstaff000000 000000 Revision history for HTTP-Message 6.36 2022-01-05 14:39:42Z - Fix examples in HTTP::Request::Common synopsis: HTTP::Request::Common does not put headers in an arrayref, unlike HTTP::Request (GH#170) (Karen Etheridge) - Update to contributing information (GH#171) (Håkon Hægland) 6.35 2021-11-11 22:10:31Z - Clarify documentation for decoded_content (GH#166) (Eric Wastl) 6.34 2021-11-08 14:27:36Z - Catch case of empty name/value in header words split. (GH#168) (Galen Huntington) 6.33 2021-06-28 16:51:58Z - Allow `can` method to respond to delegated methods (GH#159) (nanto_vi, TOYAMA Nao) 6.32 2021-05-18 18:54:27Z - Use File::Spec for MSWin32 on Content-Disposition filename (GH#157) (tzccinct) 6.31 2021-05-11 18:07:37Z - Fix test writing to files (GH#156) (Michal Josef Špaček) 6.30 2021-05-10 14:55:55Z - Don't inherit from Exporter anymore (GH#155) (Max Maischein) - Remove superfluous Perl version requirement. This module requires Perl 5.6 or newer. (GH#155) (Max Maischein) 6.29 2021-03-06 04:50:34Z - fix issue with HTTP::Request internal cache for canonical url when using URI::URL (GH#146) (andrew-grechkin) 6.28 2021-02-19 16:22:13Z - fix warnings during HTTP::Config->match #62 (GH#152) (Viťas Strádal) 6.27 2021-01-05 03:02:01Z - Clean up backcompat code (GH#148) (Dan Book) - Add "308 Permanent Redirect" to is_cacheable_by_default (GH#150) (simbabque) 6.26 2020-09-10 02:34:25Z - Update comment which explains in which RFC 451 is defined (GH#143) (Olaf Alders). Reported by Toby Inkster. - Fix HTTP status descriptions and add 425 Too Early (GH#145) (Dan Book) 6.25 2020-06-28 17:52:12Z - Don't run Changes test on master in GH actions - move Clone from required to suggests prerequisite, to re-enable fatpacking 6.24 2020-05-11 13:15:25Z - Full release. No changes since TRIAL release 6.23 6.23 2020-05-07 17:57:18Z (TRIAL RELEASE) - Enable static install (GH#134) (Olaf Alders) - Support non-string header values that stringify (GH#137) (Will Storey) 6.22 2020-02-24 18:58:07Z - Full release. No changes since TRIAL release 6.21 6.21 2020-02-19 14:35:09Z (TRIAL RELEASE) - Bump Encode to latest version (3.01) (GH#129) (Olaf Alders) - Revert #115 (GH#131) (Olaf Alders) - Revert (GH#125) "try hard to make a usable file name" (GH#130) (Olaf Alders) - Fix JSON request encoding examples in POD (GH#126) (Michael Schout) 6.20 2019-02-05 01:46:39Z (TRIAL RELEASE) - Fix encoded file names when LC_ALL=C (GH#125) (Lars Dɪᴇᴄᴋᴏᴡ 迪拉斯) 6.19 2019-01-16 15:17:35Z (TRIAL RELEASE) - Add support for RFC 8187 encoded filenames (GH#115) (Zaki Mughal) - Fix memoized _uri_canonical #121 (GH#123) (Dorian Taylor) - Don't overwrite $@ in decodable (gh #80) (GH#118) (mschae94) - Add support for RFC 8187 encoded filenames (GH#115) (Zaki Mughal) 6.18 2018-06-05 16:29:15Z - Revert status_message to original code (GH#111) (Theo van Hoesel) 6.17 2018-06-05 01:55:34Z - Documented status code 451 in the list of constants (GH #104) (Robert Rothenberg) - Status code 451 is cachable by default, as per RFC 7725 (GH #104) (Robert Rothenberg) - Add default status_message for unknown status codes (GH#105) (Robert Rothenberg) - Corrections to the documentation (GH#102) (Jonas B. Nielsen) 6.16 2018-03-28 14:09:17Z - Update status codes to official IANA list (GH#100) (Theo van Hoesel) 6.15 2018-03-13 13:02:56Z - Whenever possible, use an absolute four digit year for Time::Local (GH#97) - Add is_cacheable_by_default() (GH#98) (Theo van Hoesel) 6.14 2017-12-20 22:28:48Z - Add some useful examples in HTTP::Request (GH #92) (Chase Whitener). Batch requests are now explained. - PUT and PATCH docs updated (GH #84) (saturdaywalkers) - Trim trailing \r from status line so message() doesn't return it (GH #87) (Felipe Gasper) - Bring test coverage of HTTP::Config to 100% (GH #85) (Pete Houston) - Add 103 Early Hints to HTTP::Status (GH #94) (Tatsuhiko Miyagawa) 6.13 2017-06-20 01:07:03Z - Non-TRIAL release of changes found in 6.12 6.12 2017-06-15 18:03:50Z (TRIAL RELEASE) - If an object is passed to HTTP::Request, it must provide a canonical() method (Olaf Alders) - Make sure status messages don't die by checking the status exists before checking the value range (Kent Fredric, GH #39) - Add a .mailmap file to clean up the contributors list - Avoid inconsistent setting of content to undef (Jerome Eteve) - Simplify the way some methods are created (Tom Hukins) - Remove some indirect object notation (Chase Whitener) - Fix example in Pod (Tobias Leich) - Add support for HTTP PATCH method (Mickey Nasriachi) 6.11 2015-09-09 - fix an undefined value warning in HTTP::Headers::as_string 6.10 2015-07-19 - fix uses of qr/.../m in tests that do not work in 5.8.x 6.09 2015-07-19 - converted all uses of Test.pm to Test::More - fix uninitialized warning in HTTP::Config (RT#105929) 6.08 2015-07-10 - Resolve new uninitialized warning from HTTP::Request::Common::request_type_with_data (RT#105787) 6.07 2015-07-09 - Allow subclasses to override the class of parts - it used to be hardcoded to HTTP::Message. (Gisle Aas, RT#79239) - Added support for is_client_error, is_server_error to HTTP::Response (Karen Etheridge) - Added flatten interface to HTTP::Headers (Tokuhiro Matsuno, GH#5) - Allow PUT to pass content data via hashrefs just like with POST (Michael Schilli, GH#9) - Fix for "Content-Encoding: none" header (Gisle Aas, RT#94882) - Add support for HTTP status 308, defined in RFC 7238 (Olivier Mengué, RT#104102) - drop the use of "use vars" (Karen Etheridge) 6.06 2012-10-21 - More forgiving test on croak message [RT#80302] (Gisle Aas) - Added test for multipart parsing (Gisle Aas) - Multipart end boundary doesn't need match a complete line [RT#79239] (Mark Overmeer) 6.05 2012-10-20 - Updated ignores (Gisle Aas) - No need to prevent visiting field values starting with '_' (Gisle Aas) - Report the correct croak caller for delegated methods (Gisle Aas) - Disallow empty field names or field names containing ':' (Gisle Aas) - Make the extra std_case entries local to each header (Gisle Aas) 6.04 2012-09-30 - Updated repository URL (Gisle Aas) - Avoid undef warning for empty content (Gisle Aas) - Teach $m->content_charset about JSON (Gisle Aas) - Use the canonical charset name for UTF-16LE (and frieds) (Gisle Aas) - Add option to override the "(no content)" marker of $m->dump (Gisle Aas) - Use IO::HTML for encoding sniffing (Christopher J. Madsen) - mime_name was introduced in Encode 2.21 (Christopher J. Madsen) - Remove an unneeded "require" (Tom Hukins) - Spelling fixes. (Ville Skyttä) - Sanitized PERL_HTTP_URI_CLASS environment variable. (chromatic) - Add test from RT#77466 (Martin H. Sluka) - Fix doc grammo [RT#75831] (Father Chrysostomos) 6.03 2012-02-16 - Support 'bzip2' as alternative to Content-Encoding: x-bzip2. Some servers seem to return it. - Make newlines in forms be "\r\n" terminated. - Added some more status codes. - Restore perl-5.8.1 compatibility. 6.02 2011-03-20 - Declare dependency on Bunzip2 v2.021 [RT#66593] 6.01 2011-03-07 - Avoid loading XML::Simple to avoid test failures. - Eliminate the HTML::Entities dependency. 6.00 2011-02-27 - Initial release of HTTP-Message as a separate distribution. There are no code changes besides incrementing the version number since libwww-perl-5.837. - The HTTP::Message module with friends used to be bundled with the libwww-perl distribution. HTTP-Message-6.36/INSTALL000644 000765 000024 00000004553 14165326704 014745 0ustar00olafstaff000000 000000 This is the Perl distribution HTTP-Message. Installing HTTP-Message is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm HTTP::Message If it does not have permission to install modules to the current perl, cpanm will automatically set up and install to a local::lib in your home directory. See the local::lib documentation (https://metacpan.org/pod/local::lib) for details on enabling it in your environment. ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan HTTP::Message ## Manual installation As a last resort, you can manually install it. If you have not already downloaded the release tarball, you can find the download link on the module's MetaCPAN page: https://metacpan.org/pod/HTTP::Message Untar the tarball, install configure prerequisites (see below), then build it: % perl Makefile.PL % make && make test Then install it: % make install On Windows platforms, you should use `dmake` or `nmake`, instead of `make`. If your perl is system-managed, you can create a local::lib in your home directory to install modules to. For details, see the local::lib documentation: https://metacpan.org/pod/local::lib The prerequisites of this distribution will also have to be installed manually. The prerequisites are listed in one of the files: `MYMETA.yml` or `MYMETA.json` generated by running the manual build process described above. ## Configure Prerequisites This distribution requires other modules to be installed before this distribution's installer can be run. They can be found under the "configure_requires" key of META.yml or the "{prereqs}{configure}{requires}" key of META.json. ## Other Prerequisites This distribution may require additional modules to be installed after running Makefile.PL. Look for prerequisites in the following phases: * to run make, PHASE = build * to use the module code itself, PHASE = runtime * to run tests, PHASE = test They can all be found in the "PHASE_requires" key of MYMETA.yml or the "{prereqs}{PHASE}{requires}" key of MYMETA.json. ## Documentation HTTP-Message documentation is available as POD. You can run `perldoc` from a shell to read the documentation: % perldoc HTTP::Message For more information on installing Perl modules via CPAN, please see: https://www.cpan.org/modules/INSTALL.html HTTP-Message-6.36/MANIFEST000644 000765 000024 00000001674 14165326704 015046 0ustar00olafstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.024. CONTRIBUTING.md CONTRIBUTORS Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README.md cpanfile dist.ini lib/HTTP/Config.pm lib/HTTP/Headers.pm lib/HTTP/Headers/Auth.pm lib/HTTP/Headers/ETag.pm lib/HTTP/Headers/Util.pm lib/HTTP/Message.pm lib/HTTP/Request.pm lib/HTTP/Request/Common.pm lib/HTTP/Response.pm lib/HTTP/Status.pm perlcriticrc perltidyrc t/00-report-prereqs.dd t/00-report-prereqs.t t/common-req.t t/headers-auth.t t/headers-etag.t t/headers-util.t t/headers.t t/http-config.t t/lib/Secret.pm t/message-charset.t t/message-decode-xml.t t/message-old.t t/message-parts.t t/message.t t/request.t t/request_type_with_data.t t/response.t t/status-old.t t/status.t tidyall.ini xt/author/00-compile.t xt/author/mojibake.t xt/author/pod-syntax.t xt/author/portability.t xt/author/test-version.t xt/release/changes_has_content.t xt/release/cpan-changes.t HTTP-Message-6.36/LICENSE000644 000765 000024 00000043637 14165326704 014727 0ustar00olafstaff000000 000000 This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 1994 by Gisle Aas. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 1994 by Gisle Aas. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End HTTP-Message-6.36/t/000755 000765 000024 00000000000 14165326704 014150 5ustar00olafstaff000000 000000 HTTP-Message-6.36/xt/000755 000765 000024 00000000000 14165326704 014340 5ustar00olafstaff000000 000000 HTTP-Message-6.36/META.yml000644 000765 000024 00000051013 14165326704 015156 0ustar00olafstaff000000 000000 --- abstract: 'HTTP style message (base class)' author: - 'Gisle Aas ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' File::Temp: '0' PerlIO::encoding: '0' Test::More: '0.88' Time::Local: '0' Try::Tiny: '0' URI::URL: '0' lib: '0' overload: '0' perl: '5.008001' configure_requires: ExtUtils::MakeMaker: '0' perl: '5.006' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.024, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: HTTP-Message no_index: directory: - examples - t - xt requires: Carp: '0' Compress::Raw::Zlib: '0' Encode: '3.01' Encode::Locale: '1' Exporter: '5.57' File::Spec: '0' HTTP::Date: '6' IO::Compress::Bzip2: '2.021' IO::Compress::Deflate: '0' IO::Compress::Gzip: '0' IO::HTML: '0' IO::Uncompress::Bunzip2: '2.021' IO::Uncompress::Gunzip: '0' IO::Uncompress::Inflate: '0' IO::Uncompress::RawInflate: '0' LWP::MediaTypes: '6' MIME::Base64: '2.1' MIME::QuotedPrint: '0' URI: '1.10' base: '0' perl: '5.008001' strict: '0' warnings: '0' resources: IRC: irc://irc.perl.org/#lwp MailingList: mailto:libwww@perl.org bugtracker: https://github.com/libwww-perl/HTTP-Message/issues homepage: https://github.com/libwww-perl/HTTP-Message repository: https://github.com/libwww-perl/HTTP-Message.git version: '6.36' x_Dist_Zilla: perl: version: '5.030002' plugins: - class: Dist::Zilla::Plugin::MetaResources name: MetaResources version: '6.024' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: runtime type: requires name: Prereqs version: '6.024' - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 0 check_all_prereqs: 0 modules: - Dist::Zilla::PluginBundle::Author::OALDERS phase: build run_under_travis: 0 skip: [] name: '@Author::OALDERS/stale modules, build' version: '0.057' - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 1 check_all_prereqs: 1 modules: [] phase: release run_under_travis: 0 skip: [] name: '@Author::OALDERS/stale modules, release' version: '0.057' - class: Dist::Zilla::Plugin::OALDERS::TidyAll name: '@Author::OALDERS/OALDERS::TidyAll' version: '0.000029' - class: Dist::Zilla::Plugin::AutoPrereqs name: '@Author::OALDERS/AutoPrereqs' version: '6.024' - class: Dist::Zilla::Plugin::CheckChangesHasContent name: '@Author::OALDERS/CheckChangesHasContent' version: '0.011' - class: Dist::Zilla::Plugin::MakeMaker config: Dist::Zilla::Role::TestRunner: default_jobs: '1' name: '@Author::OALDERS/MakeMaker' version: '6.024' - class: Dist::Zilla::Plugin::CPANFile name: '@Author::OALDERS/CPANFile' version: '6.024' - class: Dist::Zilla::Plugin::ContributorsFile name: '@Author::OALDERS/ContributorsFile' version: 0.3.0 - class: Dist::Zilla::Plugin::MetaJSON name: '@Author::OALDERS/MetaJSON' version: '6.024' - class: Dist::Zilla::Plugin::MetaYAML name: '@Author::OALDERS/MetaYAML' version: '6.024' - class: Dist::Zilla::Plugin::Manifest name: '@Author::OALDERS/Manifest' version: '6.024' - class: Dist::Zilla::Plugin::MetaNoIndex name: '@Author::OALDERS/MetaNoIndex' version: '6.024' - class: Dist::Zilla::Plugin::MetaConfig name: '@Author::OALDERS/MetaConfig' version: '6.024' - class: Dist::Zilla::Plugin::MetaResources name: '@Author::OALDERS/MetaResources' version: '6.024' - class: Dist::Zilla::Plugin::License name: '@Author::OALDERS/License' version: '6.024' - class: Dist::Zilla::Plugin::InstallGuide config: Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000037' version: '0.006' name: '@Author::OALDERS/InstallGuide' version: '1.200014' - class: Dist::Zilla::Plugin::ExecDir name: '@Author::OALDERS/ExecDir' version: '6.024' - class: Dist::Zilla::Plugin::MojibakeTests name: '@Author::OALDERS/MojibakeTests' version: '0.8' - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@Author::OALDERS/PodSyntaxTests' version: '6.024' - class: Dist::Zilla::Plugin::Test::CPAN::Changes config: Dist::Zilla::Plugin::Test::CPAN::Changes: changelog: Changes name: '@Author::OALDERS/Test::CPAN::Changes' version: '0.012' - class: Dist::Zilla::Plugin::Test::Portability config: Dist::Zilla::Plugin::Test::Portability: options: '' name: '@Author::OALDERS/Test::Portability' version: '2.001000' - class: Dist::Zilla::Plugin::TestRelease name: '@Author::OALDERS/TestRelease' version: '6.024' - class: Dist::Zilla::Plugin::Test::ReportPrereqs name: '@Author::OALDERS/Test::ReportPrereqs' version: '0.028' - class: Dist::Zilla::Plugin::Test::Version name: '@Author::OALDERS/Test::Version' version: '1.09' - class: Dist::Zilla::Plugin::RunExtraTests config: Dist::Zilla::Role::TestRunner: default_jobs: '1' name: '@Author::OALDERS/RunExtraTests' version: '0.029' - class: Dist::Zilla::Plugin::MinimumPerl name: '@Author::OALDERS/MinimumPerl' version: '1.006' - class: Dist::Zilla::Plugin::PodWeaver config: Dist::Zilla::Plugin::PodWeaver: finder: - ':InstallModules' - ':ExecFiles' plugins: - class: Pod::Weaver::Plugin::EnsurePod5 name: '@CorePrep/EnsurePod5' version: '4.015' - class: Pod::Weaver::Plugin::H1Nester name: '@CorePrep/H1Nester' version: '4.015' - class: Pod::Weaver::Plugin::SingleEncoding name: '@Default/SingleEncoding' version: '4.015' - class: Pod::Weaver::Section::Name name: '@Default/Name' version: '4.015' - class: Pod::Weaver::Section::Version name: '@Default/Version' version: '4.015' - class: Pod::Weaver::Section::Region name: '@Default/prelude' version: '4.015' - class: Pod::Weaver::Section::Generic name: SYNOPSIS version: '4.015' - class: Pod::Weaver::Section::Generic name: DESCRIPTION version: '4.015' - class: Pod::Weaver::Section::Generic name: OVERVIEW version: '4.015' - class: Pod::Weaver::Section::Collect name: ATTRIBUTES version: '4.015' - class: Pod::Weaver::Section::Collect name: METHODS version: '4.015' - class: Pod::Weaver::Section::Collect name: FUNCTIONS version: '4.015' - class: Pod::Weaver::Section::Leftovers name: '@Default/Leftovers' version: '4.015' - class: Pod::Weaver::Section::Region name: '@Default/postlude' version: '4.015' - class: Pod::Weaver::Section::Authors name: '@Default/Authors' version: '4.015' - class: Pod::Weaver::Section::Legal name: '@Default/Legal' version: '4.015' name: '@Author::OALDERS/PodWeaver' version: '4.009' - class: Dist::Zilla::Plugin::PruneCruft name: '@Author::OALDERS/PruneCruft' version: '6.024' - class: Dist::Zilla::Plugin::CopyFilesFromBuild name: '@Author::OALDERS/CopyFilesFromBuild' version: '0.170880' - class: Dist::Zilla::Plugin::GithubMeta name: '@Author::OALDERS/GithubMeta' version: '0.58' - class: Dist::Zilla::Plugin::Git::GatherDir config: Dist::Zilla::Plugin::GatherDir: exclude_filename: - Install - LICENSE - META.json - Makefile.PL - README.md - cpanfile exclude_match: [] follow_symlinks: 0 include_dotfiles: 0 prefix: '' prune_directory: [] root: . Dist::Zilla::Plugin::Git::GatherDir: include_untracked: 0 name: '@Author::OALDERS/Git::GatherDir' version: '2.048' - class: Dist::Zilla::Plugin::CopyFilesFromRelease config: Dist::Zilla::Plugin::CopyFilesFromRelease: filename: - Install match: [] name: '@Author::OALDERS/CopyFilesFromRelease' version: '0.007' - class: Dist::Zilla::Plugin::Git::Check config: Dist::Zilla::Plugin::Git::Check: untracked_files: die Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - Install - LICENSE - META.json - Makefile.PL - README.md - cpanfile - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . name: '@Author::OALDERS/Git::Check' version: '2.048' - class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: git_version: 2.34.1 include_authors: 0 include_releaser: 1 order_by: name paths: [] name: '@Author::OALDERS/Git::Contributors' version: '0.036' - class: Dist::Zilla::Plugin::ReadmeAnyFromPod config: Dist::Zilla::Role::FileWatcher: version: '0.006' name: '@Author::OALDERS/ReadmeMdInBuild' version: '0.163250' - class: Dist::Zilla::Plugin::StaticInstall config: Dist::Zilla::Plugin::StaticInstall: dry_run: 0 mode: on name: '@Author::OALDERS/StaticInstall' version: '0.012' - class: Dist::Zilla::Plugin::ShareDir name: '@Author::OALDERS/ShareDir' version: '6.024' - class: Dist::Zilla::Plugin::CheckIssues name: '@Author::OALDERS/CheckIssues' version: '0.011' - class: Dist::Zilla::Plugin::ConfirmRelease name: '@Author::OALDERS/ConfirmRelease' version: '6.024' - class: Dist::Zilla::Plugin::UploadToCPAN name: '@Author::OALDERS/UploadToCPAN' version: '6.024' - class: Dist::Zilla::Plugin::RewriteVersion::Transitional config: Dist::Zilla::Plugin::RewriteVersion: add_tarball_name: 0 finders: - ':ExecFiles' - ':InstallModules' global: 0 skip_version_provider: 0 Dist::Zilla::Plugin::RewriteVersion::Transitional: {} name: '@Author::OALDERS/@Git::VersionManager/RewriteVersion::Transitional' version: '0.009' - class: Dist::Zilla::Plugin::MetaProvides::Update name: '@Author::OALDERS/@Git::VersionManager/MetaProvides::Update' version: '0.007' - class: Dist::Zilla::Plugin::CopyFilesFromRelease config: Dist::Zilla::Plugin::CopyFilesFromRelease: filename: - Changes match: [] name: '@Author::OALDERS/@Git::VersionManager/CopyFilesFromRelease' version: '0.007' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] commit_msg: v%V%n%n%c signoff: 0 Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - Install - LICENSE - META.json - Makefile.PL - README.md - cpanfile - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Author::OALDERS/@Git::VersionManager/release snapshot' version: '2.048' - class: Dist::Zilla::Plugin::Git::Tag config: Dist::Zilla::Plugin::Git::Tag: branch: ~ changelog: Changes signed: 0 tag: v6.36 tag_format: v%V tag_message: v%V Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Author::OALDERS/@Git::VersionManager/Git::Tag' version: '2.048' - class: Dist::Zilla::Plugin::BumpVersionAfterRelease::Transitional config: Dist::Zilla::Plugin::BumpVersionAfterRelease: finders: - ':ExecFiles' - ':InstallModules' global: 0 munge_makefile_pl: 1 Dist::Zilla::Plugin::BumpVersionAfterRelease::Transitional: {} name: '@Author::OALDERS/@Git::VersionManager/BumpVersionAfterRelease::Transitional' version: '0.009' - class: Dist::Zilla::Plugin::NextRelease name: '@Author::OALDERS/@Git::VersionManager/NextRelease' version: '6.024' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] commit_msg: 'increment $VERSION after %v release' signoff: 0 Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Build.PL - Changes - Makefile.PL allow_dirty_match: - (?^:^lib/.*\.pm$) changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Author::OALDERS/@Git::VersionManager/post-release commit' version: '2.048' - class: Dist::Zilla::Plugin::Git::Push config: Dist::Zilla::Plugin::Git::Push: push_to: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . name: '@Author::OALDERS/Git::Push' version: '2.048' - class: Dist::Zilla::Plugin::Prereqs::Soften config: Dist::Zilla::Plugin::Prereqs::Soften: copy_to: - develop.requires modules: - Clone modules_from_features: ~ to_relationship: suggests name: Prereqs::Soften version: '0.006003' - class: Dist::Zilla::Plugin::Test::Compile config: Dist::Zilla::Plugin::Test::Compile: bail_out_on_fail: '1' fail_on_warning: author fake_home: 0 filename: xt/author/00-compile.t module_finder: - ':InstallModules' needs_display: 0 phase: develop script_finder: - ':PerlExecFiles' skips: [] switch: [] name: Test::Compile version: '2.058' - class: Dist::Zilla::Plugin::Test::ChangesHasContent name: Test::ChangesHasContent version: '0.011' - class: Dist::Zilla::Plugin::Substitute name: Substitute version: '0.006' - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: '6.024' - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: '6.024' - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: '6.024' - class: Dist::Zilla::Plugin::FinderCode name: ':ExtraTestFiles' version: '6.024' - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: '6.024' - class: Dist::Zilla::Plugin::FinderCode name: ':PerlExecFiles' version: '6.024' - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: '6.024' - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: '6.024' - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' version: '6.024' - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' version: '6.024' zilla: class: Dist::Zilla::Dist::Builder config: is_trial: '0' version: '6.024' x_contributors: - 'Adam Kennedy ' - 'Adam Sjogren ' - 'Alexey Tourbin ' - 'Alex Kapranoff ' - 'amire80 ' - 'Andreas J. Koenig ' - 'Andrei Grechkin ' - 'Bill Mann ' - 'Brendan Byrd ' - 'Bron Gondwana ' - 'Chase Whitener ' - 'Christopher J. Madsen ' - 'chromatic ' - 'Dan Book ' - 'Daniel Hedlund ' - 'David E. Wheeler ' - 'DAVIDRW ' - 'David Steinbrunner ' - 'Dorian Taylor ' - 'Eric Wastl ' - 'Father Chrysostomos ' - 'Felipe Gasper ' - 'FWILES ' - 'Galen Huntington ' - 'Gavin Peters ' - 'Gisle Aas ' - 'Graeme Thompson ' - 'Graham Knop ' - 'Håkon Hægland ' - 'Hans-H. Froehlich ' - 'Ian Kilgore ' - 'Jacob J ' - 'Jakub Wilk ' - 'jefflee ' - 'Jerome Eteve ' - 'john9art ' - 'jonasbn ' - 'Karen Etheridge ' - 'Lars Dɪᴇᴄᴋᴏᴡ 迪拉斯 ' - 'Mark Overmeer ' - 'Mark Stosberg ' - 'Martin H. Sluka ' - 'Matthew Chae ' - 'Max Maischein ' - 'Michael Schout ' - 'Michal Josef Špaček ' - 'Mickey Nasriachi ' - 'Mike Schilli ' - 'murphy ' - 'nanto_vi, TOYAMA Nao ' - 'Olaf Alders ' - 'Olivier Mengué ' - 'Ondrej Hanak ' - 'openstrike ' - 'Peter Rabbitson ' - 'phrstbrn ' - 'Robert Rothenberg ' - 'Robert Rothenberg ' - 'Robert Stone ' - 'Rolf Grossmann ' - 'ruff ' - 'sasao ' - 'Saturday Walkers Club ' - 'Sean M. Burke ' - 'simbabque ' - 'Slaven Rezic ' - 'Spiros Denaxas ' - 'Steve Hay ' - 'Tatsuhiko Miyagawa ' - 'Tatsuhiko Miyagawa ' - 'Theo van Hoesel ' - 'Tigran ' - 'Tobias Leich ' - 'Todd Lipcon ' - 'tokuhirom ' - 'Tom Hukins ' - 'Tony Finch ' - 'Toru Yamaguchi ' - 'tzccinct ' - 'uid39246 ' - 'Ville Skyttä ' - 'Vít Strádal ' - 'William Storey ' - 'Yuri Karaban ' - 'Zakariyya Mughal ' - 'Zefram ' x_generated_by_perl: v5.30.2 x_serialization_backend: 'YAML::Tiny version 1.73' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' x_static_install: 1 HTTP-Message-6.36/CONTRIBUTORS000644 000765 000024 00000003624 14165326704 015572 0ustar00olafstaff000000 000000 # HTTP-MESSAGE CONTRIBUTORS # This is the (likely incomplete) list of people who have helped make this distribution what it is, either via code contributions, patches, bug reports, help with troubleshooting, etc. A huge 'thank you' to all of them. * Adam Kennedy * Adam Sjogren * Alexey Tourbin * Alex Kapranoff * amire80 * Andreas J. Koenig * Andrei Grechkin * Bill Mann * Brendan Byrd * Bron Gondwana * Chase Whitener * Christopher J. Madsen * chromatic * Dan Book * Daniel Hedlund * David E. Wheeler * DAVIDRW * David Steinbrunner * Dorian Taylor * Eric Wastl * Father Chrysostomos * Felipe Gasper * FWILES * Galen Huntington * Gavin Peters * Gisle Aas * Graeme Thompson * Graham Knop * Håkon Hægland * Hans-H. Froehlich * Ian Kilgore * Jacob J * Jakub Wilk * jefflee * Jerome Eteve * john9art * jonasbn * Karen Etheridge * Lars Dɪᴇᴄᴋᴏᴡ 迪拉斯 * Mark Overmeer * Mark Stosberg * Martin H. Sluka * Matthew Chae * Max Maischein * Michael Schout * Michal Josef Špaček * Mickey Nasriachi * Mike Schilli * murphy * nanto_vi, TOYAMA Nao * Olaf Alders * Olivier Mengué * Ondrej Hanak * openstrike * Peter Rabbitson * phrstbrn * Robert Rothenberg * Robert Rothenberg * Robert Stone * Rolf Grossmann * ruff * sasao * Saturday Walkers Club * Sean M. Burke * simbabque * Slaven Rezic * Spiros Denaxas * Steve Hay * Tatsuhiko Miyagawa * Tatsuhiko Miyagawa * Theo van Hoesel * Tigran * Tobias Leich * Todd Lipcon * tokuhirom * Tom Hukins * Tony Finch * Toru Yamaguchi * tzccinct * uid39246 * Ville Skyttä * Vít Strádal * William Storey * Yuri Karaban * Zakariyya Mughal * Zefram HTTP-Message-6.36/META.json000644 000765 000024 00000075017 14165326704 015340 0ustar00olafstaff000000 000000 { "abstract" : "HTTP style message (base class)", "author" : [ "Gisle Aas " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.024, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "HTTP-Message", "no_index" : { "directory" : [ "examples", "t", "xt" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "perl" : "5.006" }, "suggests" : { "JSON::PP" : "2.27300" } }, "develop" : { "requires" : { "Clone" : "0", "File::Spec" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Test::CPAN::Changes" : "0.19", "Test::Mojibake" : "0", "Test::More" : "0.96", "Test::Pod" : "1.41", "Test::Portability::Files" : "0", "Test::Version" : "1", "perl" : "5.006" } }, "runtime" : { "requires" : { "Carp" : "0", "Compress::Raw::Zlib" : "0", "Encode" : "3.01", "Encode::Locale" : "1", "Exporter" : "5.57", "File::Spec" : "0", "HTTP::Date" : "6", "IO::Compress::Bzip2" : "2.021", "IO::Compress::Deflate" : "0", "IO::Compress::Gzip" : "0", "IO::HTML" : "0", "IO::Uncompress::Bunzip2" : "2.021", "IO::Uncompress::Gunzip" : "0", "IO::Uncompress::Inflate" : "0", "IO::Uncompress::RawInflate" : "0", "LWP::MediaTypes" : "6", "MIME::Base64" : "2.1", "MIME::QuotedPrint" : "0", "URI" : "1.10", "base" : "0", "perl" : "5.008001", "strict" : "0", "warnings" : "0" }, "suggests" : { "Clone" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "File::Temp" : "0", "PerlIO::encoding" : "0", "Test::More" : "0.88", "Time::Local" : "0", "Try::Tiny" : "0", "URI::URL" : "0", "lib" : "0", "overload" : "0", "perl" : "5.008001" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/libwww-perl/HTTP-Message/issues" }, "homepage" : "https://github.com/libwww-perl/HTTP-Message", "repository" : { "type" : "git", "url" : "https://github.com/libwww-perl/HTTP-Message.git", "web" : "https://github.com/libwww-perl/HTTP-Message" }, "x_IRC" : "irc://irc.perl.org/#lwp", "x_MailingList" : "mailto:libwww@perl.org" }, "version" : "6.36", "x_Dist_Zilla" : { "perl" : { "version" : "5.030002" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "MetaResources", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "runtime", "type" : "requires" } }, "name" : "Prereqs", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : 0, "check_all_prereqs" : 0, "modules" : [ "Dist::Zilla::PluginBundle::Author::OALDERS" ], "phase" : "build", "run_under_travis" : 0, "skip" : [] } }, "name" : "@Author::OALDERS/stale modules, build", "version" : "0.057" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : 1, "check_all_prereqs" : 1, "modules" : [], "phase" : "release", "run_under_travis" : 0, "skip" : [] } }, "name" : "@Author::OALDERS/stale modules, release", "version" : "0.057" }, { "class" : "Dist::Zilla::Plugin::OALDERS::TidyAll", "name" : "@Author::OALDERS/OALDERS::TidyAll", "version" : "0.000029" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "@Author::OALDERS/AutoPrereqs", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::CheckChangesHasContent", "name" : "@Author::OALDERS/CheckChangesHasContent", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : "1" } }, "name" : "@Author::OALDERS/MakeMaker", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::CPANFile", "name" : "@Author::OALDERS/CPANFile", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::ContributorsFile", "name" : "@Author::OALDERS/ContributorsFile", "version" : "0.3.0" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@Author::OALDERS/MetaJSON", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@Author::OALDERS/MetaYAML", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@Author::OALDERS/Manifest", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::MetaNoIndex", "name" : "@Author::OALDERS/MetaNoIndex", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@Author::OALDERS/MetaConfig", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "@Author::OALDERS/MetaResources", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@Author::OALDERS/License", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::InstallGuide", "config" : { "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000037", "version" : "0.006" } }, "name" : "@Author::OALDERS/InstallGuide", "version" : "1.200014" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@Author::OALDERS/ExecDir", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::MojibakeTests", "name" : "@Author::OALDERS/MojibakeTests", "version" : "0.8" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@Author::OALDERS/PodSyntaxTests", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::Test::CPAN::Changes", "config" : { "Dist::Zilla::Plugin::Test::CPAN::Changes" : { "changelog" : "Changes" } }, "name" : "@Author::OALDERS/Test::CPAN::Changes", "version" : "0.012" }, { "class" : "Dist::Zilla::Plugin::Test::Portability", "config" : { "Dist::Zilla::Plugin::Test::Portability" : { "options" : "" } }, "name" : "@Author::OALDERS/Test::Portability", "version" : "2.001000" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@Author::OALDERS/TestRelease", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::Test::ReportPrereqs", "name" : "@Author::OALDERS/Test::ReportPrereqs", "version" : "0.028" }, { "class" : "Dist::Zilla::Plugin::Test::Version", "name" : "@Author::OALDERS/Test::Version", "version" : "1.09" }, { "class" : "Dist::Zilla::Plugin::RunExtraTests", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : "1" } }, "name" : "@Author::OALDERS/RunExtraTests", "version" : "0.029" }, { "class" : "Dist::Zilla::Plugin::MinimumPerl", "name" : "@Author::OALDERS/MinimumPerl", "version" : "1.006" }, { "class" : "Dist::Zilla::Plugin::PodWeaver", "config" : { "Dist::Zilla::Plugin::PodWeaver" : { "finder" : [ ":InstallModules", ":ExecFiles" ], "plugins" : [ { "class" : "Pod::Weaver::Plugin::EnsurePod5", "name" : "@CorePrep/EnsurePod5", "version" : "4.015" }, { "class" : "Pod::Weaver::Plugin::H1Nester", "name" : "@CorePrep/H1Nester", "version" : "4.015" }, { "class" : "Pod::Weaver::Plugin::SingleEncoding", "name" : "@Default/SingleEncoding", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Name", "name" : "@Default/Name", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Version", "name" : "@Default/Version", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@Default/prelude", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "SYNOPSIS", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "DESCRIPTION", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "OVERVIEW", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "ATTRIBUTES", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "METHODS", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "FUNCTIONS", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Leftovers", "name" : "@Default/Leftovers", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@Default/postlude", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Authors", "name" : "@Default/Authors", "version" : "4.015" }, { "class" : "Pod::Weaver::Section::Legal", "name" : "@Default/Legal", "version" : "4.015" } ] } }, "name" : "@Author::OALDERS/PodWeaver", "version" : "4.009" }, { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "@Author::OALDERS/PruneCruft", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::CopyFilesFromBuild", "name" : "@Author::OALDERS/CopyFilesFromBuild", "version" : "0.170880" }, { "class" : "Dist::Zilla::Plugin::GithubMeta", "name" : "@Author::OALDERS/GithubMeta", "version" : "0.58" }, { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "config" : { "Dist::Zilla::Plugin::GatherDir" : { "exclude_filename" : [ "Install", "LICENSE", "META.json", "Makefile.PL", "README.md", "cpanfile" ], "exclude_match" : [], "follow_symlinks" : 0, "include_dotfiles" : 0, "prefix" : "", "prune_directory" : [], "root" : "." }, "Dist::Zilla::Plugin::Git::GatherDir" : { "include_untracked" : 0 } }, "name" : "@Author::OALDERS/Git::GatherDir", "version" : "2.048" }, { "class" : "Dist::Zilla::Plugin::CopyFilesFromRelease", "config" : { "Dist::Zilla::Plugin::CopyFilesFromRelease" : { "filename" : [ "Install" ], "match" : [] } }, "name" : "@Author::OALDERS/CopyFilesFromRelease", "version" : "0.007" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "config" : { "Dist::Zilla::Plugin::Git::Check" : { "untracked_files" : "die" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "Install", "LICENSE", "META.json", "Makefile.PL", "README.md", "cpanfile", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." } }, "name" : "@Author::OALDERS/Git::Check", "version" : "2.048" }, { "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { "git_version" : "2.34.1", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", "paths" : [] } }, "name" : "@Author::OALDERS/Git::Contributors", "version" : "0.036" }, { "class" : "Dist::Zilla::Plugin::ReadmeAnyFromPod", "config" : { "Dist::Zilla::Role::FileWatcher" : { "version" : "0.006" } }, "name" : "@Author::OALDERS/ReadmeMdInBuild", "version" : "0.163250" }, { "class" : "Dist::Zilla::Plugin::StaticInstall", "config" : { "Dist::Zilla::Plugin::StaticInstall" : { "dry_run" : 0, "mode" : "on" } }, "name" : "@Author::OALDERS/StaticInstall", "version" : "0.012" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@Author::OALDERS/ShareDir", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::CheckIssues", "name" : "@Author::OALDERS/CheckIssues", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@Author::OALDERS/ConfirmRelease", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@Author::OALDERS/UploadToCPAN", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::RewriteVersion::Transitional", "config" : { "Dist::Zilla::Plugin::RewriteVersion" : { "add_tarball_name" : 0, "finders" : [ ":ExecFiles", ":InstallModules" ], "global" : 0, "skip_version_provider" : 0 }, "Dist::Zilla::Plugin::RewriteVersion::Transitional" : {} }, "name" : "@Author::OALDERS/@Git::VersionManager/RewriteVersion::Transitional", "version" : "0.009" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Update", "name" : "@Author::OALDERS/@Git::VersionManager/MetaProvides::Update", "version" : "0.007" }, { "class" : "Dist::Zilla::Plugin::CopyFilesFromRelease", "config" : { "Dist::Zilla::Plugin::CopyFilesFromRelease" : { "filename" : [ "Changes" ], "match" : [] } }, "name" : "@Author::OALDERS/@Git::VersionManager/CopyFilesFromRelease", "version" : "0.007" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], "commit_msg" : "v%V%n%n%c", "signoff" : 0 }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "Install", "LICENSE", "META.json", "Makefile.PL", "README.md", "cpanfile", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Author::OALDERS/@Git::VersionManager/release snapshot", "version" : "2.048" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "config" : { "Dist::Zilla::Plugin::Git::Tag" : { "branch" : null, "changelog" : "Changes", "signed" : 0, "tag" : "v6.36", "tag_format" : "v%V", "tag_message" : "v%V" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Author::OALDERS/@Git::VersionManager/Git::Tag", "version" : "2.048" }, { "class" : "Dist::Zilla::Plugin::BumpVersionAfterRelease::Transitional", "config" : { "Dist::Zilla::Plugin::BumpVersionAfterRelease" : { "finders" : [ ":ExecFiles", ":InstallModules" ], "global" : 0, "munge_makefile_pl" : 1 }, "Dist::Zilla::Plugin::BumpVersionAfterRelease::Transitional" : {} }, "name" : "@Author::OALDERS/@Git::VersionManager/BumpVersionAfterRelease::Transitional", "version" : "0.009" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@Author::OALDERS/@Git::VersionManager/NextRelease", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], "commit_msg" : "increment $VERSION after %v release", "signoff" : 0 }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Build.PL", "Changes", "Makefile.PL" ], "allow_dirty_match" : [ "(?^:^lib/.*\\.pm$)" ], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Author::OALDERS/@Git::VersionManager/post-release commit", "version" : "2.048" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "config" : { "Dist::Zilla::Plugin::Git::Push" : { "push_to" : [ "origin" ], "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." } }, "name" : "@Author::OALDERS/Git::Push", "version" : "2.048" }, { "class" : "Dist::Zilla::Plugin::Prereqs::Soften", "config" : { "Dist::Zilla::Plugin::Prereqs::Soften" : { "copy_to" : [ "develop.requires" ], "modules" : [ "Clone" ], "modules_from_features" : null, "to_relationship" : "suggests" } }, "name" : "Prereqs::Soften", "version" : "0.006003" }, { "class" : "Dist::Zilla::Plugin::Test::Compile", "config" : { "Dist::Zilla::Plugin::Test::Compile" : { "bail_out_on_fail" : "1", "fail_on_warning" : "author", "fake_home" : 0, "filename" : "xt/author/00-compile.t", "module_finder" : [ ":InstallModules" ], "needs_display" : 0, "phase" : "develop", "script_finder" : [ ":PerlExecFiles" ], "skips" : [], "switch" : [] } }, "name" : "Test::Compile", "version" : "2.058" }, { "class" : "Dist::Zilla::Plugin::Test::ChangesHasContent", "name" : "Test::ChangesHasContent", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::Substitute", "name" : "Substitute", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExtraTestFiles", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":PerlExecFiles", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", "version" : "6.024" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", "version" : "6.024" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : 0 }, "version" : "6.024" } }, "x_contributors" : [ "Adam Kennedy ", "Adam Sjogren ", "Alexey Tourbin ", "Alex Kapranoff ", "amire80 ", "Andreas J. Koenig ", "Andrei Grechkin ", "Bill Mann ", "Brendan Byrd ", "Bron Gondwana ", "Chase Whitener ", "Christopher J. Madsen ", "chromatic ", "Dan Book ", "Daniel Hedlund ", "David E. Wheeler ", "DAVIDRW ", "David Steinbrunner ", "Dorian Taylor ", "Eric Wastl ", "Father Chrysostomos ", "Felipe Gasper ", "FWILES ", "Galen Huntington ", "Gavin Peters ", "Gisle Aas ", "Graeme Thompson ", "Graham Knop ", "H\u00e5kon H\u00e6gland ", "Hans-H. Froehlich ", "Ian Kilgore ", "Jacob J ", "Jakub Wilk ", "jefflee ", "Jerome Eteve ", "john9art ", "jonasbn ", "Karen Etheridge ", "Lars D\u026a\u1d07\u1d04\u1d0b\u1d0f\u1d21 \u8fea\u62c9\u65af ", "Mark Overmeer ", "Mark Stosberg ", "Martin H. Sluka ", "Matthew Chae ", "Max Maischein ", "Michael Schout ", "Michal Josef \u0160pa\u010dek ", "Mickey Nasriachi ", "Mike Schilli ", "murphy ", "nanto_vi, TOYAMA Nao ", "Olaf Alders ", "Olivier Mengu\u00e9 ", "Ondrej Hanak ", "openstrike ", "Peter Rabbitson ", "phrstbrn ", "Robert Rothenberg ", "Robert Rothenberg ", "Robert Stone ", "Rolf Grossmann ", "ruff ", "sasao ", "Saturday Walkers Club ", "Sean M. Burke ", "simbabque ", "Slaven Rezic ", "Spiros Denaxas ", "Steve Hay ", "Tatsuhiko Miyagawa ", "Tatsuhiko Miyagawa ", "Theo van Hoesel ", "Tigran ", "Tobias Leich ", "Todd Lipcon ", "tokuhirom ", "Tom Hukins ", "Tony Finch ", "Toru Yamaguchi ", "tzccinct ", "uid39246 ", "Ville Skytt\u00e4 ", "V\u00edt Str\u00e1dal ", "William Storey ", "Yuri Karaban ", "Zakariyya Mughal ", "Zefram " ], "x_generated_by_perl" : "v5.30.2", "x_serialization_backend" : "Cpanel::JSON::XS version 4.26", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later", "x_static_install" : 1 } HTTP-Message-6.36/CONTRIBUTING.md000644 000765 000024 00000011427 14165326704 016143 0ustar00olafstaff000000 000000 # HOW TO CONTRIBUTE Thank you for considering contributing to this distribution. This file contains instructions that will help you work with the source code. The distribution is managed with [Dist::Zilla](https://metacpan.org/pod/Dist::Zilla). This means that many of the usual files you might expect are not in the repository, but are generated at release time. Some generated files are kept in the repository as a convenience (Makefile.PL, META.json, and cpanfile). Generally, **you do not need Dist::Zilla to contribute patches**. You may need Dist::Zilla to create a tarball. See below for guidance. ## Getting dependencies If you have App::cpanminus 1.6 or later installed, you can use [cpanm](https://metacpan.org/pod/cpanm) to satisfy dependencies like this: $ cpanm --installdeps --with-develop . You can also run this command (or any other cpanm command) without installing App::cpanminus first, using the fatpacked `cpanm` script via curl or wget: $ curl -L https://cpanmin.us | perl - --installdeps --with-develop . $ wget -qO - https://cpanmin.us | perl - --installdeps --with-develop . Otherwise, look for either a `cpanfile` or `META.json` file for a list of dependencies to satisfy. ## Running tests You can run tests directly using the `prove` tool: $ prove -l $ prove -lv t/some_test_file.t ## Code style and tidying This distribution contains a `.perltidyrc` file in the root of the repository. Please install Perl::Tidy and use `perltidy` before submitting patches. However, as this is an old distribution and styling has changed somewhat over the years, please keep your tidying constrained to the portion of code or function in which you're patching. $ perltidy -pro=perltidyrc lib/HTTP/Status.pm -o my_tidy_copy.pm ... $ rm my_tidy_copy.pm The above command, for example, would provide you with a copy of `Status.pm` that has been cleaned according to our `.perltidyrc` settings. You'd then look at the newly created `my_tidy_copy.pm` in the dist root and replace your work with the cleaned up copy if there are differences. This may seem like an arbitrary thing, but it is immensely helpful if all code is written in a singular style. If everything were tidy, it'd look like one single person wrote the code rather than a mish-mash. ## Installing and using Dist::Zilla [Dist::Zilla](https://metacpan.org/pod/Dist::Zilla) is a very powerful authoring tool, optimized for maintaining a large number of distributions with a high degree of automation, but it has a large dependency chain, a bit of a learning curve and requires a number of author-specific plugins. To install it from CPAN, I recommend one of the following approaches for the quickest installation: # using CPAN.pm, but bypassing non-functional pod tests $ cpan TAP::Harness::Restricted $ PERL_MM_USE_DEFAULT=1 HARNESS_CLASS=TAP::Harness::Restricted cpan Dist::Zilla # using cpanm, bypassing *all* tests $ cpanm -n Dist::Zilla In either case, it's probably going to take about 10 minutes. Go for a walk, go get a cup of your favorite beverage, take a bathroom break, or whatever. When you get back, Dist::Zilla should be ready for you. Then you need to install any plugins specific to this distribution: $ dzil authordeps --missing | cpanm You can use Dist::Zilla to install the distribution's dependencies if you haven't already installed them with cpanm: $ dzil listdeps --missing --develop | cpanm Once everything is installed, here are some dzil commands you might try: $ dzil build $ dzil test $ dzil regenerate You can learn more about Dist::Zilla at http://dzil.org/ ## Other notes This distribution maintains the generated `META.json` and `Makefile.PL` in the repository. This allows two things: [Travis CI](https://travis-ci.org/) can build and test the distribution without requiring Dist::Zilla, and the distribution can be installed directly from Github or a local git repository using `cpanm` for testing (again, not requiring Dist::Zilla). $ cpanm git://github.com/Author/Distribution-Name.git $ cd Distribution-Name; cpanm . Contributions are preferred in the form of a Github pull request. See [Using pull requests](https://help.github.com/articles/using-pull-requests/) for further information. You can use the Github issue tracker to report issues without an accompanying patch. # CREDITS This file was adapted from an initial `CONTRIBUTING.mkdn` file from David Golden under the terms of the [CC0](https://creativecommons.org/share-your-work/public-domain/cc0/), with inspiration from the contributing documents from [Dist::Zilla::Plugin::Author::KENTNL::CONTRIBUTING](https://metacpan.org/pod/Dist::Zilla::Plugin::Author::KENTNL::CONTRIBUTING) and [Dist::Zilla::PluginBundle::Author::ETHER](https://metacpan.org/pod/Dist::Zilla::PluginBundle::Author::ETHER). HTTP-Message-6.36/README.md000644 000765 000024 00000027056 14165326704 015176 0ustar00olafstaff000000 000000 # NAME HTTP::Message - HTTP style message (base class) # VERSION version 6.36 # SYNOPSIS use base 'HTTP::Message'; # DESCRIPTION An `HTTP::Message` object contains some headers and a content body. The following methods are available: - $mess = HTTP::Message->new - $mess = HTTP::Message->new( $headers ) - $mess = HTTP::Message->new( $headers, $content ) This constructs a new message object. Normally you would want construct `HTTP::Request` or `HTTP::Response` objects instead. The optional $header argument should be a reference to an `HTTP::Headers` object or a plain array reference of key/value pairs. If an `HTTP::Headers` object is provided then a copy of it will be embedded into the constructed message, i.e. it will not be owned and can be modified afterwards without affecting the message. The optional $content argument should be a string of bytes. - $mess = HTTP::Message->parse( $str ) This constructs a new message object by parsing the given string. - $mess->headers Returns the embedded `HTTP::Headers` object. - $mess->headers\_as\_string - $mess->headers\_as\_string( $eol ) Call the as\_string() method for the headers in the message. This will be the same as $mess->headers->as_string but it will make your program a whole character shorter :-) - $mess->content - $mess->content( $bytes ) The content() method sets the raw content if an argument is given. If no argument is given the content is not touched. In either case the original raw content is returned. If the `undef` argument is given, the content is reset to its default value, which is an empty string. Note that the content should be a string of bytes. Strings in perl can contain characters outside the range of a byte. The `Encode` module can be used to turn such strings into a string of bytes. - $mess->add\_content( $bytes ) The add\_content() methods appends more data bytes to the end of the current content buffer. - $mess->add\_content\_utf8( $string ) The add\_content\_utf8() method appends the UTF-8 bytes representing the string to the end of the current content buffer. - $mess->content\_ref - $mess->content\_ref( \\$bytes ) The content\_ref() method will return a reference to content buffer string. It can be more efficient to access the content this way if the content is huge, and it can even be used for direct manipulation of the content, for instance: ${$res->content_ref} =~ s/\bfoo\b/bar/g; This example would modify the content buffer in-place. If an argument is passed it will setup the content to reference some external source. The content() and add\_content() methods will automatically dereference scalar references passed this way. For other references content() will return the reference itself and add\_content() will refuse to do anything. - $mess->content\_charset This returns the charset used by the content in the message. The charset is either found as the charset attribute of the `Content-Type` header or by guessing. See [http://www.w3.org/TR/REC-html40/charset.html#spec-char-encoding](http://www.w3.org/TR/REC-html40/charset.html#spec-char-encoding) for details about how charset is determined. - $mess->decoded\_content( %options ) Returns the content with any `Content-Encoding` undone and, for textual content (`Content-Type` values starting with `text/`, exactly matching `application/xml`, or ending with `+xml`), the raw content's character set decoded into Perl's Unicode string format. Note that this [does not currently](https://github.com/libwww-perl/HTTP-Message/pull/99) attempt to decode declared character sets for any other content types like `application/json` or `application/javascript`. If the `Content-Encoding` or `charset` of the message is unknown, this method will fail by returning `undef`. The following options can be specified. - `charset` This override the charset parameter for text content. The value `none` can used to suppress decoding of the charset. - `default_charset` This override the default charset guessed by content\_charset() or if that fails "ISO-8859-1". - `alt_charset` If decoding fails because the charset specified in the Content-Type header isn't recognized by Perl's Encode module, then try decoding using this charset instead of failing. The `alt_charset` might be specified as `none` to simply return the string without any decoding of charset as alternative. - `charset_strict` Abort decoding if malformed characters is found in the content. By default you get the substitution character ("\\x{FFFD}") in place of malformed characters. - `raise_error` If TRUE then raise an exception if not able to decode content. Reason might be that the specified `Content-Encoding` or `charset` is not supported. If this option is FALSE, then decoded\_content() will return `undef` on errors, but will still set $@. - `ref` If TRUE then a reference to decoded content is returned. This might be more efficient in cases where the decoded content is identical to the raw content as no data copying is required in this case. - $mess->decodable - HTTP::Message::decodable() This returns the encoding identifiers that decoded\_content() can process. In scalar context returns a comma separated string of identifiers. This value is suitable for initializing the `Accept-Encoding` request header field. - $mess->decode This method tries to replace the content of the message with the decoded version and removes the `Content-Encoding` header. Returns TRUE if successful and FALSE if not. If the message does not have a `Content-Encoding` header this method does nothing and returns TRUE. Note that the content of the message is still bytes after this method has been called and you still need to call decoded\_content() if you want to process its content as a string. - $mess->encode( $encoding, ... ) Apply the given encodings to the content of the message. Returns TRUE if successful. The "identity" (non-)encoding is always supported; other currently supported encodings, subject to availability of required additional modules, are "gzip", "deflate", "x-bzip2" and "base64". A successful call to this function will set the `Content-Encoding` header. Note that `multipart/*` or `message/*` messages can't be encoded and this method will croak if you try. - $mess->parts - $mess->parts( @parts ) - $mess->parts( \\@parts ) Messages can be composite, i.e. contain other messages. The composite messages have a content type of `multipart/*` or `message/*`. This method give access to the contained messages. The argumentless form will return a list of `HTTP::Message` objects. If the content type of $msg is not `multipart/*` or `message/*` then this will return the empty list. In scalar context only the first object is returned. The returned message parts should be regarded as read-only (future versions of this library might make it possible to modify the parent by modifying the parts). If the content type of $msg is `message/*` then there will only be one part returned. If the content type is `message/http`, then the return value will be either an `HTTP::Request` or an `HTTP::Response` object. If a @parts argument is given, then the content of the message will be modified. The array reference form is provided so that an empty list can be provided. The @parts array should contain `HTTP::Message` objects. The @parts objects are owned by $mess after this call and should not be modified or made part of other messages. When updating the message with this method and the old content type of $mess is not `multipart/*` or `message/*`, then the content type is set to `multipart/mixed` and all other content headers are cleared. This method will croak if the content type is `message/*` and more than one part is provided. - $mess->add\_part( $part ) This will add a part to a message. The $part argument should be another `HTTP::Message` object. If the previous content type of $mess is not `multipart/*` then the old content (together with all content headers) will be made part #1 and the content type made `multipart/mixed` before the new part is added. The $part object is owned by $mess after this call and should not be modified or made part of other messages. There is no return value. - $mess->clear Will clear the headers and set the content to the empty string. There is no return value - $mess->protocol - $mess->protocol( $proto ) Sets the HTTP protocol used for the message. The protocol() is a string like `HTTP/1.0` or `HTTP/1.1`. - $mess->clone Returns a copy of the message object. - $mess->as\_string - $mess->as\_string( $eol ) Returns the message formatted as a single string. The optional $eol parameter specifies the line ending sequence to use. The default is "\\n". If no $eol is given then as\_string will ensure that the returned string is newline terminated (even when the message content is not). No extra newline is appended if an explicit $eol is passed. - $mess->dump( %opt ) Returns the message formatted as a string. In void context print the string. This differs from `$mess->as_string` in that it escapes the bytes of the content so that it's safe to print them and it limits how much content to print. The escapes syntax used is the same as for Perl's double quoted strings. If there is no content the string "(no content)" is shown in its place. Options to influence the output can be passed as key/value pairs. The following options are recognized: - maxlength => $num How much of the content to show. The default is 512. Set this to 0 for unlimited. If the content is longer then the string is chopped at the limit and the string "...\\n(### more bytes not shown)" appended. - no\_content => $str Replaces the "(no content)" marker. - prefix => $str A string that will be prefixed to each line of the dump. All methods unknown to `HTTP::Message` itself are delegated to the `HTTP::Headers` object that is part of every message. This allows convenient access to these methods. Refer to [HTTP::Headers](https://metacpan.org/pod/HTTP%3A%3AHeaders) for details of these methods: $mess->header( $field => $val ) $mess->push_header( $field => $val ) $mess->init_header( $field => $val ) $mess->remove_header( $field ) $mess->remove_content_headers $mess->header_field_names $mess->scan( \&doit ) $mess->date $mess->expires $mess->if_modified_since $mess->if_unmodified_since $mess->last_modified $mess->content_type $mess->content_encoding $mess->content_length $mess->content_language $mess->title $mess->user_agent $mess->server $mess->from $mess->referer $mess->www_authenticate $mess->authorization $mess->proxy_authorization $mess->authorization_basic $mess->proxy_authorization_basic # AUTHOR Gisle Aas # COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. HTTP-Message-6.36/tidyall.ini000644 000765 000024 00000000471 14165326704 016052 0ustar00olafstaff000000 000000 [PerlTidy] select = **/*.{pl,pm,t,psgi} ignore = .build/**/* ignore = HTTP-Message-*/**/* ignore = blib/**/* ignore = t/00-* ignore = t/author-* ignore = t/release-* ignore = t/zzz-* ignore = xt/**/* argv = --profile=$ROOT/perltidyrc [SortLines::Naturally] select = .gitignore [UniqueLines] select = .gitignore HTTP-Message-6.36/lib/000755 000765 000024 00000000000 14165326704 014453 5ustar00olafstaff000000 000000 HTTP-Message-6.36/Makefile.PL000644 000765 000024 00000005012 14165326704 015655 0ustar00olafstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.024. use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "HTTP style message (base class)", "AUTHOR" => "Gisle Aas ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "HTTP-Message", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008001", "NAME" => "HTTP::Message", "PREREQ_PM" => { "Carp" => 0, "Compress::Raw::Zlib" => 0, "Encode" => "3.01", "Encode::Locale" => 1, "Exporter" => "5.57", "File::Spec" => 0, "HTTP::Date" => 6, "IO::Compress::Bzip2" => "2.021", "IO::Compress::Deflate" => 0, "IO::Compress::Gzip" => 0, "IO::HTML" => 0, "IO::Uncompress::Bunzip2" => "2.021", "IO::Uncompress::Gunzip" => 0, "IO::Uncompress::Inflate" => 0, "IO::Uncompress::RawInflate" => 0, "LWP::MediaTypes" => 6, "MIME::Base64" => "2.1", "MIME::QuotedPrint" => 0, "URI" => "1.10", "base" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "File::Temp" => 0, "PerlIO::encoding" => 0, "Test::More" => "0.88", "Time::Local" => 0, "Try::Tiny" => 0, "URI::URL" => 0, "lib" => 0, "overload" => 0 }, "VERSION" => "6.36", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Compress::Raw::Zlib" => 0, "Encode" => "3.01", "Encode::Locale" => 1, "Exporter" => "5.57", "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "File::Temp" => 0, "HTTP::Date" => 6, "IO::Compress::Bzip2" => "2.021", "IO::Compress::Deflate" => 0, "IO::Compress::Gzip" => 0, "IO::HTML" => 0, "IO::Uncompress::Bunzip2" => "2.021", "IO::Uncompress::Gunzip" => 0, "IO::Uncompress::Inflate" => 0, "IO::Uncompress::RawInflate" => 0, "LWP::MediaTypes" => 6, "MIME::Base64" => "2.1", "MIME::QuotedPrint" => 0, "PerlIO::encoding" => 0, "Test::More" => "0.88", "Time::Local" => 0, "Try::Tiny" => 0, "URI" => "1.10", "URI::URL" => 0, "base" => 0, "lib" => 0, "overload" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); HTTP-Message-6.36/dist.ini000644 000765 000024 00000002500 14165326704 015346 0ustar00olafstaff000000 000000 name = HTTP-Message author = Gisle Aas license = Perl_5 main_module = lib/HTTP/Message.pm copyright_holder = Gisle Aas copyright_year = 1994 [MetaResources] x_IRC = irc://irc.perl.org/#lwp x_MailingList = mailto:libwww@perl.org [Prereqs] Compress::Raw::Zlib = 0 Encode = 3.01 Encode::Locale = 1 Exporter = 5.57 HTTP::Date = 6 IO::Compress::Bzip2 = 2.021 IO::Uncompress::Bunzip2 = 2.021 LWP::MediaTypes = 6 MIME::Base64 = 2.1 perl = 5.008001 URI = 1.10 [@Author::OALDERS] ; all these tests are TODO -remove = Prereqs -remove = Test::EOL -remove = Test::Perl::Critic -remove = Test::Pod::Coverage::Configurable -remove = Test::PodSpelling -remove = Test::Synopsis -remove = Test::TidyAll StaticInstall.mode = on StaticInstall.dry_run = 0 [Prereqs::Soften] to_relationship = suggests copy_to = develop.requires module = Clone [Test::Compile] bail_out_on_fail = 1 xt_mode = 1 [Test::ChangesHasContent] [Substitute] file = xt/release/changes_has_content.t code = s{^(note 'Checking Changes')}{if \(\(\$ENV\{TRAVIS_PULL_REQUEST\} \|\| '') eq 'false'\) \{\n chomp\(my \$branch_name = \(\$ENV\{TRAVIS_BRANCH\} || \`git rev-parse --abbrev-ref HEAD\`\)\);\n \$TODO = 'Changes need not have content for this release yet if this is only the master branch'\n if \(\$branch_name \|\| ''\) eq 'master';\n\}\n\n$1} HTTP-Message-6.36/lib/HTTP/000755 000765 000024 00000000000 14165326704 015232 5ustar00olafstaff000000 000000 HTTP-Message-6.36/lib/HTTP/Status.pm000644 000765 000024 00000031303 14165326704 017053 0ustar00olafstaff000000 000000 package HTTP::Status; use strict; use warnings; our $VERSION = '6.36'; use Exporter 5.57 'import'; our @EXPORT = qw(is_info is_success is_redirect is_error status_message); our @EXPORT_OK = qw(is_client_error is_server_error is_cacheable_by_default); # Note also addition of mnemonics to @EXPORT below # Unmarked codes are from RFC 7231 (2017-12-20) # See also: # https://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml my %StatusCode = ( 100 => 'Continue', 101 => 'Switching Protocols', 102 => 'Processing', # RFC 2518: WebDAV 103 => 'Early Hints', # RFC 8297: Indicating Hints # 104 .. 199 200 => 'OK', 201 => 'Created', 202 => 'Accepted', 203 => 'Non-Authoritative Information', 204 => 'No Content', 205 => 'Reset Content', 206 => 'Partial Content', # RFC 7233: Range Requests 207 => 'Multi-Status', # RFC 4918: WebDAV 208 => 'Already Reported', # RFC 5842: WebDAV bindings # 209 .. 225 226 => 'IM Used', # RFC 3229: Delta encoding # 227 .. 299 300 => 'Multiple Choices', 301 => 'Moved Permanently', 302 => 'Found', 303 => 'See Other', 304 => 'Not Modified', # RFC 7232: Conditional Request 305 => 'Use Proxy', 307 => 'Temporary Redirect', 308 => 'Permanent Redirect', # RFC 7528: Permanent Redirect # 309 .. 399 400 => 'Bad Request', 401 => 'Unauthorized', # RFC 7235: Authentication 402 => 'Payment Required', 403 => 'Forbidden', 404 => 'Not Found', 405 => 'Method Not Allowed', 406 => 'Not Acceptable', 407 => 'Proxy Authentication Required', # RFC 7235: Authentication 408 => 'Request Timeout', 409 => 'Conflict', 410 => 'Gone', 411 => 'Length Required', 412 => 'Precondition Failed', # RFC 7232: Conditional Request 413 => 'Payload Too Large', 414 => 'URI Too Long', 415 => 'Unsupported Media Type', 416 => 'Range Not Satisfiable', # RFC 7233: Range Requests 417 => 'Expectation Failed', # 418 .. 420 421 => 'Misdirected Request', # RFC 7540: HTTP/2 422 => 'Unprocessable Entity', # RFC 4918: WebDAV 423 => 'Locked', # RFC 4918: WebDAV 424 => 'Failed Dependency', # RFC 4918: WebDAV 425 => 'Too Early', # RFC 8470: Using Early Data in HTTP 426 => 'Upgrade Required', # 427 428 => 'Precondition Required', # RFC 6585: Additional Codes 429 => 'Too Many Requests', # RFC 6585: Additional Codes # 430 431 => 'Request Header Fields Too Large', # RFC 6585: Additional Codes # 432 .. 450 451 => 'Unavailable For Legal Reasons', # RFC 7725: Legal Obstacles # 452 .. 499 500 => 'Internal Server Error', 501 => 'Not Implemented', 502 => 'Bad Gateway', 503 => 'Service Unavailable', 504 => 'Gateway Timeout', 505 => 'HTTP Version Not Supported', 506 => 'Variant Also Negotiates', # RFC 2295: Transparant Ngttn 507 => 'Insufficient Storage', # RFC 4918: WebDAV 508 => 'Loop Detected', # RFC 5842: WebDAV bindings # 509 510 => 'Not Extended', # RFC 2774: Extension Framework 511 => 'Network Authentication Required', # RFC 6585: Additional Codes ); # keep some unofficial codes that used to be in this distribution %StatusCode = ( %StatusCode, 418 => 'I\'m a teapot', # RFC 2324: HTCPC/1.0 1-april 449 => 'Retry with', # microsoft 509 => 'Bandwidth Limit Exceeded', # Apache / cPanel ); my $mnemonicCode = ''; my ($code, $message); while (($code, $message) = each %StatusCode) { # create mnemonic subroutines $message =~ s/I'm/I am/; $message =~ tr/a-z \-/A-Z__/; $mnemonicCode .= "sub HTTP_$message () { $code }\n"; $mnemonicCode .= "*RC_$message = \\&HTTP_$message;\n"; # legacy $mnemonicCode .= "push(\@EXPORT_OK, 'HTTP_$message');\n"; $mnemonicCode .= "push(\@EXPORT, 'RC_$message');\n"; } eval $mnemonicCode; # only one eval for speed die if $@; # backwards compatibility *RC_MOVED_TEMPORARILY = \&RC_FOUND; # 302 was renamed in the standard push(@EXPORT, "RC_MOVED_TEMPORARILY"); my %compat = ( REQUEST_ENTITY_TOO_LARGE => \&HTTP_PAYLOAD_TOO_LARGE, REQUEST_URI_TOO_LARGE => \&HTTP_URI_TOO_LONG, REQUEST_RANGE_NOT_SATISFIABLE => \&HTTP_RANGE_NOT_SATISFIABLE, NO_CODE => \&HTTP_TOO_EARLY, UNORDERED_COLLECTION => \&HTTP_TOO_EARLY, ); foreach my $name (keys %compat) { push(@EXPORT, "RC_$name"); push(@EXPORT_OK, "HTTP_$name"); no strict 'refs'; *{"RC_$name"} = $compat{$name}; *{"HTTP_$name"} = $compat{$name}; } our %EXPORT_TAGS = ( constants => [grep /^HTTP_/, @EXPORT_OK], is => [grep /^is_/, @EXPORT, @EXPORT_OK], ); sub status_message ($) { $StatusCode{$_[0]}; } sub is_info ($) { $_[0] && $_[0] >= 100 && $_[0] < 200; } sub is_success ($) { $_[0] && $_[0] >= 200 && $_[0] < 300; } sub is_redirect ($) { $_[0] && $_[0] >= 300 && $_[0] < 400; } sub is_error ($) { $_[0] && $_[0] >= 400 && $_[0] < 600; } sub is_client_error ($) { $_[0] && $_[0] >= 400 && $_[0] < 500; } sub is_server_error ($) { $_[0] && $_[0] >= 500 && $_[0] < 600; } sub is_cacheable_by_default ($) { $_[0] && ( $_[0] == 200 # OK || $_[0] == 203 # Non-Authoritative Information || $_[0] == 204 # No Content || $_[0] == 206 # Not Acceptable || $_[0] == 300 # Multiple Choices || $_[0] == 301 # Moved Permanently || $_[0] == 308 # Permanent Redirect || $_[0] == 404 # Not Found || $_[0] == 405 # Method Not Allowed || $_[0] == 410 # Gone || $_[0] == 414 # Request-URI Too Large || $_[0] == 451 # Unavailable For Legal Reasons || $_[0] == 501 # Not Implemented ); } 1; =pod =encoding UTF-8 =head1 NAME HTTP::Status - HTTP Status code processing =head1 VERSION version 6.36 =head1 SYNOPSIS use HTTP::Status qw(:constants :is status_message); if ($rc != HTTP_OK) { print status_message($rc), "\n"; } if (is_success($rc)) { ... } if (is_error($rc)) { ... } if (is_redirect($rc)) { ... } =head1 DESCRIPTION I is a library of routines for defining and classifying HTTP status codes for libwww-perl. Status codes are used to encode the overall outcome of an HTTP response message. Codes correspond to those defined in RFC 2616 and RFC 2518. =head1 CONSTANTS The following constant functions can be used as mnemonic status code names. None of these are exported by default. Use the C<:constants> tag to import them all. HTTP_CONTINUE (100) HTTP_SWITCHING_PROTOCOLS (101) HTTP_PROCESSING (102) HTTP_EARLY_HINTS (103) HTTP_OK (200) HTTP_CREATED (201) HTTP_ACCEPTED (202) HTTP_NON_AUTHORITATIVE_INFORMATION (203) HTTP_NO_CONTENT (204) HTTP_RESET_CONTENT (205) HTTP_PARTIAL_CONTENT (206) HTTP_MULTI_STATUS (207) HTTP_ALREADY_REPORTED (208) HTTP_IM_USED (226) HTTP_MULTIPLE_CHOICES (300) HTTP_MOVED_PERMANENTLY (301) HTTP_FOUND (302) HTTP_SEE_OTHER (303) HTTP_NOT_MODIFIED (304) HTTP_USE_PROXY (305) HTTP_TEMPORARY_REDIRECT (307) HTTP_PERMANENT_REDIRECT (308) HTTP_BAD_REQUEST (400) HTTP_UNAUTHORIZED (401) HTTP_PAYMENT_REQUIRED (402) HTTP_FORBIDDEN (403) HTTP_NOT_FOUND (404) HTTP_METHOD_NOT_ALLOWED (405) HTTP_NOT_ACCEPTABLE (406) HTTP_PROXY_AUTHENTICATION_REQUIRED (407) HTTP_REQUEST_TIMEOUT (408) HTTP_CONFLICT (409) HTTP_GONE (410) HTTP_LENGTH_REQUIRED (411) HTTP_PRECONDITION_FAILED (412) HTTP_PAYLOAD_TOO_LARGE (413) HTTP_URI_TOO_LONG (414) HTTP_UNSUPPORTED_MEDIA_TYPE (415) HTTP_RANGE_NOT_SATISFIABLE (416) HTTP_EXPECTATION_FAILED (417) HTTP_MISDIRECTED REQUEST (421) HTTP_UNPROCESSABLE_ENTITY (422) HTTP_LOCKED (423) HTTP_FAILED_DEPENDENCY (424) HTTP_TOO_EARLY (425) HTTP_UPGRADE_REQUIRED (426) HTTP_PRECONDITION_REQUIRED (428) HTTP_TOO_MANY_REQUESTS (429) HTTP_REQUEST_HEADER_FIELDS_TOO_LARGE (431) HTTP_UNAVAILABLE_FOR_LEGAL_REASONS (451) HTTP_INTERNAL_SERVER_ERROR (500) HTTP_NOT_IMPLEMENTED (501) HTTP_BAD_GATEWAY (502) HTTP_SERVICE_UNAVAILABLE (503) HTTP_GATEWAY_TIMEOUT (504) HTTP_HTTP_VERSION_NOT_SUPPORTED (505) HTTP_VARIANT_ALSO_NEGOTIATES (506) HTTP_INSUFFICIENT_STORAGE (507) HTTP_LOOP_DETECTED (508) HTTP_NOT_EXTENDED (510) HTTP_NETWORK_AUTHENTICATION_REQUIRED (511) =head1 FUNCTIONS The following additional functions are provided. Most of them are exported by default. The C<:is> import tag can be used to import all the classification functions. =over 4 =item status_message( $code ) The status_message() function will translate status codes to human readable strings. The string is the same as found in the constant names above. If the $code is not registered in the L then C is returned. =item is_info( $code ) Return TRUE if C<$code> is an I status code (1xx). This class of status code indicates a provisional response which can't have any content. =item is_success( $code ) Return TRUE if C<$code> is a I status code (2xx). =item is_redirect( $code ) Return TRUE if C<$code> is a I status code (3xx). This class of status code indicates that further action needs to be taken by the user agent in order to fulfill the request. =item is_error( $code ) Return TRUE if C<$code> is an I status code (4xx or 5xx). The function returns TRUE for both client and server error status codes. =item is_client_error( $code ) Return TRUE if C<$code> is a I status code (4xx). This class of status code is intended for cases in which the client seems to have erred. This function is B exported by default. =item is_server_error( $code ) Return TRUE if C<$code> is a I status code (5xx). This class of status codes is intended for cases in which the server is aware that it has erred or is incapable of performing the request. This function is B exported by default. =item is_cacheable_by_default( $code ) Return TRUE if C<$code> indicates that a response is cacheable by default, and it can be reused by a cache with heuristic expiration. All other status codes are not cacheable by default. See L. This function is B exported by default. =back =head1 SEE ALSO L =head1 BUGS For legacy reasons all the C constants are exported by default with the prefix C. It's recommended to use explicit imports and the C<:constants> tag instead of relying on this. =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #ABSTRACT: HTTP Status code processing HTTP-Message-6.36/lib/HTTP/Request.pm000644 000765 000024 00000021346 14165326704 017226 0ustar00olafstaff000000 000000 package HTTP::Request; use strict; use warnings; our $VERSION = '6.36'; use base 'HTTP::Message'; sub new { my($class, $method, $uri, $header, $content) = @_; my $self = $class->SUPER::new($header, $content); $self->method($method); $self->uri($uri); $self; } sub parse { my($class, $str) = @_; Carp::carp('Undefined argument to parse()') if $^W && ! defined $str; my $request_line; if (defined $str && $str =~ s/^(.*)\n//) { $request_line = $1; } else { $request_line = $str; $str = ""; } my $self = $class->SUPER::parse($str); if (defined $request_line) { my($method, $uri, $protocol) = split(' ', $request_line); $self->method($method); $self->uri($uri) if defined($uri); $self->protocol($protocol) if $protocol; } $self; } sub clone { my $self = shift; my $clone = bless $self->SUPER::clone, ref($self); $clone->method($self->method); $clone->uri($self->uri); $clone; } sub method { shift->_elem('_method', @_); } sub uri { my $self = shift; my $old = $self->{'_uri'}; if (@_) { my $uri = shift; if (!defined $uri) { # that's ok } elsif (ref $uri) { Carp::croak("A URI can't be a " . ref($uri) . " reference") if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY'; Carp::croak("Can't use a " . ref($uri) . " object as a URI") unless $uri->can('scheme') && $uri->can('canonical'); $uri = $uri->clone; unless ($HTTP::URI_CLASS eq "URI") { # Argh!! Hate this... old LWP legacy! eval { local $SIG{__DIE__}; $uri = $uri->abs; }; die $@ if $@ && $@ !~ /Missing base argument/; } } else { $uri = $HTTP::URI_CLASS->new($uri); } $self->{'_uri'} = $uri; delete $self->{'_uri_canonical'}; } $old; } *url = \&uri; # legacy sub uri_canonical { my $self = shift; my $uri = $self->{_uri}; if (defined (my $canon = $self->{_uri_canonical})) { # early bailout if these are the exact same string; # rely on stringification of the URI objects return $canon if $canon eq $uri; } # otherwise we need to refresh the memoized value $self->{_uri_canonical} = $uri->canonical; } sub accept_decodable { my $self = shift; $self->header("Accept-Encoding", scalar($self->decodable)); } sub as_string { my $self = shift; my($eol) = @_; $eol = "\n" unless defined $eol; my $req_line = $self->method || "-"; my $uri = $self->uri; $uri = (defined $uri) ? $uri->as_string : "-"; $req_line .= " $uri"; my $proto = $self->protocol; $req_line .= " $proto" if $proto; return join($eol, $req_line, $self->SUPER::as_string(@_)); } sub dump { my $self = shift; my @pre = ($self->method || "-", $self->uri || "-"); if (my $prot = $self->protocol) { push(@pre, $prot); } return $self->SUPER::dump( preheader => join(" ", @pre), @_, ); } 1; =pod =encoding UTF-8 =head1 NAME HTTP::Request - HTTP style request message =head1 VERSION version 6.36 =head1 SYNOPSIS require HTTP::Request; $request = HTTP::Request->new(GET => 'http://www.example.com/'); and usually used like this: $ua = LWP::UserAgent->new; $response = $ua->request($request); =head1 DESCRIPTION C is a class encapsulating HTTP style requests, consisting of a request line, some headers, and a content body. Note that the LWP library uses HTTP style requests even for non-HTTP protocols. Instances of this class are usually passed to the request() method of an C object. C is a subclass of C and therefore inherits its methods. The following additional methods are available: =over 4 =item $r = HTTP::Request->new( $method, $uri ) =item $r = HTTP::Request->new( $method, $uri, $header ) =item $r = HTTP::Request->new( $method, $uri, $header, $content ) Constructs a new C object describing a request on the object $uri using method $method. The $method argument must be a string. The $uri argument can be either a string, or a reference to a C object. The optional $header argument should be a reference to an C object or a plain array reference of key/value pairs. The optional $content argument should be a string of bytes. =item $r = HTTP::Request->parse( $str ) This constructs a new request object by parsing the given string. =item $r->method =item $r->method( $val ) This is used to get/set the method attribute. The method should be a short string like "GET", "HEAD", "PUT", "PATCH" or "POST". =item $r->uri =item $r->uri( $val ) This is used to get/set the uri attribute. The $val can be a reference to a URI object or a plain string. If a string is given, then it should be parsable as an absolute URI. =item $r->header( $field ) =item $r->header( $field => $value ) This is used to get/set header values and it is inherited from C via C. See L for details and other similar methods that can be used to access the headers. =item $r->accept_decodable This will set the C header to the list of encodings that decoded_content() can decode. =item $r->content =item $r->content( $bytes ) This is used to get/set the content and it is inherited from the C base class. See L for details and other methods that can be used to access the content. Note that the content should be a string of bytes. Strings in perl can contain characters outside the range of a byte. The C module can be used to turn such strings into a string of bytes. =item $r->as_string =item $r->as_string( $eol ) Method returning a textual representation of the request. =back =head1 EXAMPLES Creating requests to be sent with L or others can be easy. Here are a few examples. =head2 Simple POST Here, we'll create a simple POST request that could be used to send JSON data to an endpoint. #!/usr/bin/env perl use strict; use warnings; use HTTP::Request (); use JSON::MaybeXS qw(encode_json); my $url = 'https://www.example.com/api/user/123'; my $header = ['Content-Type' => 'application/json; charset=UTF-8']; my $data = {foo => 'bar', baz => 'quux'}; my $encoded_data = encode_json($data); my $r = HTTP::Request->new('POST', $url, $header, $encoded_data); # at this point, we could send it via LWP::UserAgent # my $ua = LWP::UserAgent->new(); # my $res = $ua->request($r); =head2 Batch POST Request Some services, like Google, allow multiple requests to be sent in one batch. L for example. Using the C method from L makes this simple. #!/usr/bin/env perl use strict; use warnings; use HTTP::Request (); use JSON::MaybeXS qw(encode_json); my $auth_token = 'auth_token'; my $batch_url = 'https://www.googleapis.com/batch'; my $url = 'https://www.googleapis.com/drive/v3/files/fileId/permissions?fields=id'; my $url_no_email = 'https://www.googleapis.com/drive/v3/files/fileId/permissions?fields=id&sendNotificationEmail=false'; # generate a JSON post request for one of the batch entries my $req1 = build_json_request($url, { emailAddress => 'example@appsrocks.com', role => "writer", type => "user", }); # generate a JSON post request for one of the batch entries my $req2 = build_json_request($url_no_email, { domain => "appsrocks.com", role => "reader", type => "domain", }); # generate a multipart request to send all of the other requests my $r = HTTP::Request->new('POST', $batch_url, [ 'Accept-Encoding' => 'gzip', # if we don't provide a boundary here, HTTP::Message will generate # one for us. We could use UUID::uuid() here if we wanted. 'Content-Type' => 'multipart/mixed; boundary=END_OF_PART' ]); # add the two POST requests to the main request $r->add_part($req1, $req2); # at this point, we could send it via LWP::UserAgent # my $ua = LWP::UserAgent->new(); # my $res = $ua->request($r); exit(); sub build_json_request { my ($url, $href) = @_; my $header = ['Authorization' => "Bearer $auth_token", 'Content-Type' => 'application/json; charset=UTF-8']; return HTTP::Request->new('POST', $url, $header, encode_json($href)); } =head1 SEE ALSO L, L, L, L =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #ABSTRACT: HTTP style request message HTTP-Message-6.36/lib/HTTP/Message.pm000644 000765 000024 00000075552 14165326704 017172 0ustar00olafstaff000000 000000 package HTTP::Message; use strict; use warnings; our $VERSION = '6.36'; require HTTP::Headers; require Carp; my $CRLF = "\015\012"; # "\r\n" is not portable unless ($HTTP::URI_CLASS) { if ($ENV{PERL_HTTP_URI_CLASS} && $ENV{PERL_HTTP_URI_CLASS} =~ /^([\w:]+)$/) { $HTTP::URI_CLASS = $1; } else { $HTTP::URI_CLASS = "URI"; } } eval "require $HTTP::URI_CLASS"; die $@ if $@; *_utf8_downgrade = defined(&utf8::downgrade) ? sub { utf8::downgrade($_[0], 1) or Carp::croak("HTTP::Message content must be bytes") } : sub { }; sub new { my($class, $header, $content) = @_; if (defined $header) { Carp::croak("Bad header argument") unless ref $header; if (ref($header) eq "ARRAY") { $header = HTTP::Headers->new(@$header); } else { $header = $header->clone; } } else { $header = HTTP::Headers->new; } if (defined $content) { _utf8_downgrade($content); } else { $content = ''; } bless { '_headers' => $header, '_content' => $content, }, $class; } sub parse { my($class, $str) = @_; my @hdr; while (1) { if ($str =~ s/^([^\s:]+)[ \t]*: ?(.*)\n?//) { push(@hdr, $1, $2); $hdr[-1] =~ s/\r\z//; } elsif (@hdr && $str =~ s/^([ \t].*)\n?//) { $hdr[-1] .= "\n$1"; $hdr[-1] =~ s/\r\z//; } else { $str =~ s/^\r?\n//; last; } } local $HTTP::Headers::TRANSLATE_UNDERSCORE; new($class, \@hdr, $str); } sub clone { my $self = shift; my $clone = HTTP::Message->new($self->headers, $self->content); $clone->protocol($self->protocol); $clone; } sub clear { my $self = shift; $self->{_headers}->clear; $self->content(""); delete $self->{_parts}; return; } sub protocol { shift->_elem('_protocol', @_); } sub headers { my $self = shift; # recalculation of _content might change headers, so we # need to force it now $self->_content unless exists $self->{_content}; $self->{_headers}; } sub headers_as_string { shift->headers->as_string(@_); } sub content { my $self = $_[0]; if (defined(wantarray)) { $self->_content unless exists $self->{_content}; my $old = $self->{_content}; $old = $$old if ref($old) eq "SCALAR"; &_set_content if @_ > 1; return $old; } if (@_ > 1) { &_set_content; } else { Carp::carp("Useless content call in void context") if $^W; } } sub _set_content { my $self = $_[0]; _utf8_downgrade($_[1]); if (!ref($_[1]) && ref($self->{_content}) eq "SCALAR") { ${$self->{_content}} = defined( $_[1] ) ? $_[1] : ''; } else { die "Can't set content to be a scalar reference" if ref($_[1]) eq "SCALAR"; $self->{_content} = defined( $_[1] ) ? $_[1] : ''; delete $self->{_content_ref}; } delete $self->{_parts} unless $_[2]; } sub add_content { my $self = shift; $self->_content unless exists $self->{_content}; my $chunkref = \$_[0]; $chunkref = $$chunkref if ref($$chunkref); # legacy _utf8_downgrade($$chunkref); my $ref = ref($self->{_content}); if (!$ref) { $self->{_content} .= $$chunkref; } elsif ($ref eq "SCALAR") { ${$self->{_content}} .= $$chunkref; } else { Carp::croak("Can't append to $ref content"); } delete $self->{_parts}; } sub add_content_utf8 { my($self, $buf) = @_; utf8::upgrade($buf); utf8::encode($buf); $self->add_content($buf); } sub content_ref { my $self = shift; $self->_content unless exists $self->{_content}; delete $self->{_parts}; my $old = \$self->{_content}; my $old_cref = $self->{_content_ref}; if (@_) { my $new = shift; Carp::croak("Setting content_ref to a non-ref") unless ref($new); delete $self->{_content}; # avoid modifying $$old $self->{_content} = $new; $self->{_content_ref}++; } $old = $$old if $old_cref; return $old; } sub content_charset { my $self = shift; if (my $charset = $self->content_type_charset) { return $charset; } # time to start guessing my $cref = $self->decoded_content(ref => 1, charset => "none"); # Unicode BOM for ($$cref) { return "UTF-8" if /^\xEF\xBB\xBF/; return "UTF-32LE" if /^\xFF\xFE\x00\x00/; return "UTF-32BE" if /^\x00\x00\xFE\xFF/; return "UTF-16LE" if /^\xFF\xFE/; return "UTF-16BE" if /^\xFE\xFF/; } if ($self->content_is_xml) { # http://www.w3.org/TR/2006/REC-xml-20060816/#sec-guessing # XML entity not accompanied by external encoding information and not # in UTF-8 or UTF-16 encoding must begin with an XML encoding declaration, # in which the first characters must be ')/) { if ($1 =~ /\sencoding\s*=\s*(["'])(.*?)\1/) { my $enc = $2; $enc =~ s/^\s+//; $enc =~ s/\s+\z//; return $enc if $enc; } } } return "UTF-8"; } elsif ($self->content_is_html) { # look for or # http://dev.w3.org/html5/spec/Overview.html#determining-the-character-encoding require IO::HTML; # Use relaxed search to match previous versions of HTTP::Message: my $encoding = IO::HTML::find_charset_in($$cref, { encoding => 1, need_pragma => 0 }); return $encoding->mime_name if $encoding; } elsif ($self->content_type eq "application/json") { for ($$cref) { # RFC 4627, ch 3 return "UTF-32BE" if /^\x00\x00\x00./s; return "UTF-32LE" if /^.\x00\x00\x00/s; return "UTF-16BE" if /^\x00.\x00./s; return "UTF-16LE" if /^.\x00.\x00/s; return "UTF-8"; } } if ($self->content_type =~ /^text\//) { for ($$cref) { if (length) { return "US-ASCII" unless /[\x80-\xFF]/; require Encode; eval { Encode::decode_utf8($_, Encode::FB_CROAK() | Encode::LEAVE_SRC()); }; return "UTF-8" unless $@; return "ISO-8859-1"; } } } return undef; } sub decoded_content { my($self, %opt) = @_; my $content_ref; my $content_ref_iscopy; eval { $content_ref = $self->content_ref; die "Can't decode ref content" if ref($content_ref) ne "SCALAR"; if (my $h = $self->header("Content-Encoding")) { $h =~ s/^\s+//; $h =~ s/\s+$//; for my $ce (reverse split(/\s*,\s*/, lc($h))) { next unless $ce; next if $ce eq "identity" || $ce eq "none"; if ($ce eq "gzip" || $ce eq "x-gzip") { require IO::Uncompress::Gunzip; my $output; IO::Uncompress::Gunzip::gunzip($content_ref, \$output, Transparent => 0) or die "Can't gunzip content: $IO::Uncompress::Gunzip::GunzipError"; $content_ref = \$output; $content_ref_iscopy++; } elsif ($ce eq "x-bzip2" or $ce eq "bzip2") { require IO::Uncompress::Bunzip2; my $output; IO::Uncompress::Bunzip2::bunzip2($content_ref, \$output, Transparent => 0) or die "Can't bunzip content: $IO::Uncompress::Bunzip2::Bunzip2Error"; $content_ref = \$output; $content_ref_iscopy++; } elsif ($ce eq "deflate") { require IO::Uncompress::Inflate; my $output; my $status = IO::Uncompress::Inflate::inflate($content_ref, \$output, Transparent => 0); my $error = $IO::Uncompress::Inflate::InflateError; unless ($status) { # "Content-Encoding: deflate" is supposed to mean the # "zlib" format of RFC 1950, but Microsoft got that # wrong, so some servers sends the raw compressed # "deflate" data. This tries to inflate this format. $output = undef; require IO::Uncompress::RawInflate; unless (IO::Uncompress::RawInflate::rawinflate($content_ref, \$output)) { $self->push_header("Client-Warning" => "Could not raw inflate content: $IO::Uncompress::RawInflate::RawInflateError"); $output = undef; } } die "Can't inflate content: $error" unless defined $output; $content_ref = \$output; $content_ref_iscopy++; } elsif ($ce eq "compress" || $ce eq "x-compress") { die "Can't uncompress content"; } elsif ($ce eq "base64") { # not really C-T-E, but should be harmless require MIME::Base64; $content_ref = \MIME::Base64::decode($$content_ref); $content_ref_iscopy++; } elsif ($ce eq "quoted-printable") { # not really C-T-E, but should be harmless require MIME::QuotedPrint; $content_ref = \MIME::QuotedPrint::decode($$content_ref); $content_ref_iscopy++; } else { die "Don't know how to decode Content-Encoding '$ce'"; } } } if ($self->content_is_text || (my $is_xml = $self->content_is_xml)) { my $charset = lc( $opt{charset} || $self->content_type_charset || $opt{default_charset} || $self->content_charset || "ISO-8859-1" ); if ($charset eq "none") { # leave it as is } elsif ($charset eq "us-ascii" || $charset eq "iso-8859-1") { if ($$content_ref =~ /[^\x00-\x7F]/ && defined &utf8::upgrade) { unless ($content_ref_iscopy) { my $copy = $$content_ref; $content_ref = \$copy; $content_ref_iscopy++; } utf8::upgrade($$content_ref); } } else { require Encode; eval { $content_ref = \Encode::decode($charset, $$content_ref, ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC()); }; if ($@) { my $retried; if ($@ =~ /^Unknown encoding/) { my $alt_charset = lc($opt{alt_charset} || ""); if ($alt_charset && $charset ne $alt_charset) { # Retry decoding with the alternative charset $content_ref = \Encode::decode($alt_charset, $$content_ref, ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC()) unless $alt_charset eq "none"; $retried++; } } die unless $retried; } die "Encode::decode() returned undef improperly" unless defined $$content_ref; if ($is_xml) { # Get rid of the XML encoding declaration if present $$content_ref =~ s/^\x{FEFF}//; if ($$content_ref =~ /^(\s*<\?xml[^\x00]*?\?>)/) { substr($$content_ref, 0, length($1)) =~ s/\sencoding\s*=\s*(["']).*?\1//; } } } } }; if ($@) { Carp::croak($@) if $opt{raise_error}; return undef; } return $opt{ref} ? $content_ref : $$content_ref; } sub decodable { # should match the Content-Encoding values that decoded_content can deal with my $self = shift; my @enc; local $@; # XXX preferably we should determine if the modules are available without loading # them here eval { require IO::Uncompress::Gunzip; push(@enc, "gzip", "x-gzip"); }; eval { require IO::Uncompress::Inflate; require IO::Uncompress::RawInflate; push(@enc, "deflate"); }; eval { require IO::Uncompress::Bunzip2; push(@enc, "x-bzip2", "bzip2"); }; # we don't care about announcing the 'identity', 'base64' and # 'quoted-printable' stuff return wantarray ? @enc : join(", ", @enc); } sub decode { my $self = shift; return 1 unless $self->header("Content-Encoding"); if (defined(my $content = $self->decoded_content(charset => "none"))) { $self->remove_header("Content-Encoding", "Content-Length", "Content-MD5"); $self->content($content); return 1; } return 0; } sub encode { my($self, @enc) = @_; Carp::croak("Can't encode multipart/* messages") if $self->content_type =~ m,^multipart/,; Carp::croak("Can't encode message/* messages") if $self->content_type =~ m,^message/,; return 1 unless @enc; # nothing to do my $content = $self->content; for my $encoding (@enc) { if ($encoding eq "identity" || $encoding eq "none") { # nothing to do } elsif ($encoding eq "base64") { require MIME::Base64; $content = MIME::Base64::encode($content); } elsif ($encoding eq "gzip" || $encoding eq "x-gzip") { require IO::Compress::Gzip; my $output; IO::Compress::Gzip::gzip(\$content, \$output, Minimal => 1) or die "Can't gzip content: $IO::Compress::Gzip::GzipError"; $content = $output; } elsif ($encoding eq "deflate") { require IO::Compress::Deflate; my $output; IO::Compress::Deflate::deflate(\$content, \$output) or die "Can't deflate content: $IO::Compress::Deflate::DeflateError"; $content = $output; } elsif ($encoding eq "x-bzip2" || $encoding eq "bzip2") { require IO::Compress::Bzip2; my $output; IO::Compress::Bzip2::bzip2(\$content, \$output) or die "Can't bzip2 content: $IO::Compress::Bzip2::Bzip2Error"; $content = $output; } elsif ($encoding eq "rot13") { # for the fun of it $content =~ tr/A-Za-z/N-ZA-Mn-za-m/; } else { return 0; } } my $h = $self->header("Content-Encoding"); unshift(@enc, $h) if $h; $self->header("Content-Encoding", join(", ", @enc)); $self->remove_header("Content-Length", "Content-MD5"); $self->content($content); return 1; } sub as_string { my($self, $eol) = @_; $eol = "\n" unless defined $eol; # The calculation of content might update the headers # so we need to do that first. my $content = $self->content; return join("", $self->{'_headers'}->as_string($eol), $eol, $content, (@_ == 1 && length($content) && $content !~ /\n\z/) ? "\n" : "", ); } sub dump { my($self, %opt) = @_; my $content = $self->content; my $chopped = 0; if (!ref($content)) { my $maxlen = $opt{maxlength}; $maxlen = 512 unless defined($maxlen); if ($maxlen && length($content) > $maxlen * 1.1 + 3) { $chopped = length($content) - $maxlen; $content = substr($content, 0, $maxlen) . "..."; } $content =~ s/\\/\\\\/g; $content =~ s/\t/\\t/g; $content =~ s/\r/\\r/g; # no need for 3 digits in escape for these $content =~ s/([\0-\11\13-\037])(?!\d)/sprintf('\\%o',ord($1))/eg; $content =~ s/([\0-\11\13-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg; $content =~ s/([^\12\040-\176])/sprintf('\\x{%X}',ord($1))/eg; # remaining whitespace $content =~ s/( +)\n/("\\40" x length($1)) . "\n"/eg; $content =~ s/(\n+)\n/("\\n" x length($1)) . "\n"/eg; $content =~ s/\n\z/\\n/; my $no_content = $opt{no_content}; $no_content = "(no content)" unless defined $no_content; if ($content eq $no_content) { # escape our $no_content marker $content =~ s/^(.)/sprintf('\\x%02X',ord($1))/eg; } elsif ($content eq "") { $content = $no_content; } } my @dump; push(@dump, $opt{preheader}) if $opt{preheader}; push(@dump, $self->{_headers}->as_string, $content); push(@dump, "(+ $chopped more bytes not shown)") if $chopped; my $dump = join("\n", @dump, ""); $dump =~ s/^/$opt{prefix}/gm if $opt{prefix}; print $dump unless defined wantarray; return $dump; } # allow subclasses to override what will handle individual parts sub _part_class { return __PACKAGE__; } sub parts { my $self = shift; if (defined(wantarray) && (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR")) { $self->_parts; } my $old = $self->{_parts}; if (@_) { my @parts = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_; my $ct = $self->content_type || ""; if ($ct =~ m,^message/,) { Carp::croak("Only one part allowed for $ct content") if @parts > 1; } elsif ($ct !~ m,^multipart/,) { $self->remove_content_headers; $self->content_type("multipart/mixed"); } $self->{_parts} = \@parts; _stale_content($self); } return @$old if wantarray; return $old->[0]; } sub add_part { my $self = shift; if (($self->content_type || "") !~ m,^multipart/,) { my $p = $self->_part_class->new( $self->remove_content_headers, $self->content(""), ); $self->content_type("multipart/mixed"); $self->{_parts} = []; if ($p->headers->header_field_names || $p->content ne "") { push(@{$self->{_parts}}, $p); } } elsif (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR") { $self->_parts; } push(@{$self->{_parts}}, @_); _stale_content($self); return; } sub _stale_content { my $self = shift; if (ref($self->{_content}) eq "SCALAR") { # must recalculate now $self->_content; } else { # just invalidate cache delete $self->{_content}; delete $self->{_content_ref}; } } # delegate all other method calls to the headers object. our $AUTOLOAD; sub AUTOLOAD { my ( $package, $method ) = $AUTOLOAD =~ m/\A(.+)::([^:]*)\z/; my $code = $_[0]->can($method); Carp::croak( qq(Can't locate object method "$method" via package "$package")) unless $code; goto &$code; } sub can { my ( $self, $method ) = @_; if ( my $own_method = $self->SUPER::can($method) ) { return $own_method; } my $headers = ref($self) ? $self->headers : 'HTTP::Headers'; if ( $headers->can($method) ) { # We create the function here so that it will not need to be # autoloaded or recreated the next time. no strict 'refs'; *$method = sub { local $Carp::Internal{ +__PACKAGE__ } = 1; shift->headers->$method(@_); }; return \&$method; } return undef; } sub DESTROY { } # avoid AUTOLOADing it # Private method to access members in %$self sub _elem { my $self = shift; my $elem = shift; my $old = $self->{$elem}; $self->{$elem} = $_[0] if @_; return $old; } # Create private _parts attribute from current _content sub _parts { my $self = shift; my $ct = $self->content_type; if ($ct =~ m,^multipart/,) { require HTTP::Headers::Util; my @h = HTTP::Headers::Util::split_header_words($self->header("Content-Type")); die "Assert" unless @h; my %h = @{$h[0]}; if (defined(my $b = $h{boundary})) { my $str = $self->content; $str =~ s/\r?\n--\Q$b\E--.*//s; if ($str =~ s/(^|.*?\r?\n)--\Q$b\E\r?\n//s) { $self->{_parts} = [map $self->_part_class->parse($_), split(/\r?\n--\Q$b\E\r?\n/, $str)] } } } elsif ($ct eq "message/http") { require HTTP::Request; require HTTP::Response; my $content = $self->content; my $class = ($content =~ m,^(HTTP/.*)\n,) ? "HTTP::Response" : "HTTP::Request"; $self->{_parts} = [$class->parse($content)]; } elsif ($ct =~ m,^message/,) { $self->{_parts} = [ $self->_part_class->parse($self->content) ]; } $self->{_parts} ||= []; } # Create private _content attribute from current _parts sub _content { my $self = shift; my $ct = $self->{_headers}->header("Content-Type") || "multipart/mixed"; if ($ct =~ m,^\s*message/,i) { _set_content($self, $self->{_parts}[0]->as_string($CRLF), 1); return; } require HTTP::Headers::Util; my @v = HTTP::Headers::Util::split_header_words($ct); Carp::carp("Multiple Content-Type headers") if @v > 1; @v = @{$v[0]}; my $boundary; my $boundary_index; for (my @tmp = @v; @tmp;) { my($k, $v) = splice(@tmp, 0, 2); if ($k eq "boundary") { $boundary = $v; $boundary_index = @v - @tmp - 1; last; } } my @parts = map $_->as_string($CRLF), @{$self->{_parts}}; my $bno = 0; $boundary = _boundary() unless defined $boundary; CHECK_BOUNDARY: { for (@parts) { if (index($_, $boundary) >= 0) { # must have a better boundary $boundary = _boundary(++$bno); redo CHECK_BOUNDARY; } } } if ($boundary_index) { $v[$boundary_index] = $boundary; } else { push(@v, boundary => $boundary); } $ct = HTTP::Headers::Util::join_header_words(@v); $self->{_headers}->header("Content-Type", $ct); _set_content($self, "--$boundary$CRLF" . join("$CRLF--$boundary$CRLF", @parts) . "$CRLF--$boundary--$CRLF", 1); } sub _boundary { my $size = shift || return "xYzZY"; require MIME::Base64; my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), ""); $b =~ s/[\W]/X/g; # ensure alnum only $b; } 1; =pod =encoding UTF-8 =head1 NAME HTTP::Message - HTTP style message (base class) =head1 VERSION version 6.36 =head1 SYNOPSIS use base 'HTTP::Message'; =head1 DESCRIPTION An C object contains some headers and a content body. The following methods are available: =over 4 =item $mess = HTTP::Message->new =item $mess = HTTP::Message->new( $headers ) =item $mess = HTTP::Message->new( $headers, $content ) This constructs a new message object. Normally you would want construct C or C objects instead. The optional $header argument should be a reference to an C object or a plain array reference of key/value pairs. If an C object is provided then a copy of it will be embedded into the constructed message, i.e. it will not be owned and can be modified afterwards without affecting the message. The optional $content argument should be a string of bytes. =item $mess = HTTP::Message->parse( $str ) This constructs a new message object by parsing the given string. =item $mess->headers Returns the embedded C object. =item $mess->headers_as_string =item $mess->headers_as_string( $eol ) Call the as_string() method for the headers in the message. This will be the same as $mess->headers->as_string but it will make your program a whole character shorter :-) =item $mess->content =item $mess->content( $bytes ) The content() method sets the raw content if an argument is given. If no argument is given the content is not touched. In either case the original raw content is returned. If the C argument is given, the content is reset to its default value, which is an empty string. Note that the content should be a string of bytes. Strings in perl can contain characters outside the range of a byte. The C module can be used to turn such strings into a string of bytes. =item $mess->add_content( $bytes ) The add_content() methods appends more data bytes to the end of the current content buffer. =item $mess->add_content_utf8( $string ) The add_content_utf8() method appends the UTF-8 bytes representing the string to the end of the current content buffer. =item $mess->content_ref =item $mess->content_ref( \$bytes ) The content_ref() method will return a reference to content buffer string. It can be more efficient to access the content this way if the content is huge, and it can even be used for direct manipulation of the content, for instance: ${$res->content_ref} =~ s/\bfoo\b/bar/g; This example would modify the content buffer in-place. If an argument is passed it will setup the content to reference some external source. The content() and add_content() methods will automatically dereference scalar references passed this way. For other references content() will return the reference itself and add_content() will refuse to do anything. =item $mess->content_charset This returns the charset used by the content in the message. The charset is either found as the charset attribute of the C header or by guessing. See L for details about how charset is determined. =item $mess->decoded_content( %options ) Returns the content with any C undone and, for textual content (C values starting with C, exactly matching C, or ending with C<+xml>), the raw content's character set decoded into Perl's Unicode string format. Note that this L attempt to decode declared character sets for any other content types like C or C. If the C or C of the message is unknown, this method will fail by returning C. The following options can be specified. =over =item C This override the charset parameter for text content. The value C can used to suppress decoding of the charset. =item C This override the default charset guessed by content_charset() or if that fails "ISO-8859-1". =item C If decoding fails because the charset specified in the Content-Type header isn't recognized by Perl's Encode module, then try decoding using this charset instead of failing. The C might be specified as C to simply return the string without any decoding of charset as alternative. =item C Abort decoding if malformed characters is found in the content. By default you get the substitution character ("\x{FFFD}") in place of malformed characters. =item C If TRUE then raise an exception if not able to decode content. Reason might be that the specified C or C is not supported. If this option is FALSE, then decoded_content() will return C on errors, but will still set $@. =item C If TRUE then a reference to decoded content is returned. This might be more efficient in cases where the decoded content is identical to the raw content as no data copying is required in this case. =back =item $mess->decodable =item HTTP::Message::decodable() This returns the encoding identifiers that decoded_content() can process. In scalar context returns a comma separated string of identifiers. This value is suitable for initializing the C request header field. =item $mess->decode This method tries to replace the content of the message with the decoded version and removes the C header. Returns TRUE if successful and FALSE if not. If the message does not have a C header this method does nothing and returns TRUE. Note that the content of the message is still bytes after this method has been called and you still need to call decoded_content() if you want to process its content as a string. =item $mess->encode( $encoding, ... ) Apply the given encodings to the content of the message. Returns TRUE if successful. The "identity" (non-)encoding is always supported; other currently supported encodings, subject to availability of required additional modules, are "gzip", "deflate", "x-bzip2" and "base64". A successful call to this function will set the C header. Note that C or C messages can't be encoded and this method will croak if you try. =item $mess->parts =item $mess->parts( @parts ) =item $mess->parts( \@parts ) Messages can be composite, i.e. contain other messages. The composite messages have a content type of C or C. This method give access to the contained messages. The argumentless form will return a list of C objects. If the content type of $msg is not C or C then this will return the empty list. In scalar context only the first object is returned. The returned message parts should be regarded as read-only (future versions of this library might make it possible to modify the parent by modifying the parts). If the content type of $msg is C then there will only be one part returned. If the content type is C, then the return value will be either an C or an C object. If a @parts argument is given, then the content of the message will be modified. The array reference form is provided so that an empty list can be provided. The @parts array should contain C objects. The @parts objects are owned by $mess after this call and should not be modified or made part of other messages. When updating the message with this method and the old content type of $mess is not C or C, then the content type is set to C and all other content headers are cleared. This method will croak if the content type is C and more than one part is provided. =item $mess->add_part( $part ) This will add a part to a message. The $part argument should be another C object. If the previous content type of $mess is not C then the old content (together with all content headers) will be made part #1 and the content type made C before the new part is added. The $part object is owned by $mess after this call and should not be modified or made part of other messages. There is no return value. =item $mess->clear Will clear the headers and set the content to the empty string. There is no return value =item $mess->protocol =item $mess->protocol( $proto ) Sets the HTTP protocol used for the message. The protocol() is a string like C or C. =item $mess->clone Returns a copy of the message object. =item $mess->as_string =item $mess->as_string( $eol ) Returns the message formatted as a single string. The optional $eol parameter specifies the line ending sequence to use. The default is "\n". If no $eol is given then as_string will ensure that the returned string is newline terminated (even when the message content is not). No extra newline is appended if an explicit $eol is passed. =item $mess->dump( %opt ) Returns the message formatted as a string. In void context print the string. This differs from C<< $mess->as_string >> in that it escapes the bytes of the content so that it's safe to print them and it limits how much content to print. The escapes syntax used is the same as for Perl's double quoted strings. If there is no content the string "(no content)" is shown in its place. Options to influence the output can be passed as key/value pairs. The following options are recognized: =over =item maxlength => $num How much of the content to show. The default is 512. Set this to 0 for unlimited. If the content is longer then the string is chopped at the limit and the string "...\n(### more bytes not shown)" appended. =item no_content => $str Replaces the "(no content)" marker. =item prefix => $str A string that will be prefixed to each line of the dump. =back =back All methods unknown to C itself are delegated to the C object that is part of every message. This allows convenient access to these methods. Refer to L for details of these methods: $mess->header( $field => $val ) $mess->push_header( $field => $val ) $mess->init_header( $field => $val ) $mess->remove_header( $field ) $mess->remove_content_headers $mess->header_field_names $mess->scan( \&doit ) $mess->date $mess->expires $mess->if_modified_since $mess->if_unmodified_since $mess->last_modified $mess->content_type $mess->content_encoding $mess->content_length $mess->content_language $mess->title $mess->user_agent $mess->server $mess->from $mess->referer $mess->www_authenticate $mess->authorization $mess->proxy_authorization $mess->authorization_basic $mess->proxy_authorization_basic =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #ABSTRACT: HTTP style message (base class) HTTP-Message-6.36/lib/HTTP/Headers/000755 000765 000024 00000000000 14165326704 016605 5ustar00olafstaff000000 000000 HTTP-Message-6.36/lib/HTTP/Headers.pm000644 000765 000024 00000061102 14165326704 017143 0ustar00olafstaff000000 000000 package HTTP::Headers; use strict; use warnings; our $VERSION = '6.36'; use Carp (); # The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used # as a replacement for '-' in header field names. our $TRANSLATE_UNDERSCORE = 1 unless defined $TRANSLATE_UNDERSCORE; # "Good Practice" order of HTTP message headers: # - General-Headers # - Request-Headers # - Response-Headers # - Entity-Headers my @general_headers = qw( Cache-Control Connection Date Pragma Trailer Transfer-Encoding Upgrade Via Warning ); my @request_headers = qw( Accept Accept-Charset Accept-Encoding Accept-Language Authorization Expect From Host If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since Max-Forwards Proxy-Authorization Range Referer TE User-Agent ); my @response_headers = qw( Accept-Ranges Age ETag Location Proxy-Authenticate Retry-After Server Vary WWW-Authenticate ); my @entity_headers = qw( Allow Content-Encoding Content-Language Content-Length Content-Location Content-MD5 Content-Range Content-Type Expires Last-Modified ); my %entity_header = map { lc($_) => 1 } @entity_headers; my @header_order = ( @general_headers, @request_headers, @response_headers, @entity_headers, ); # Make alternative representations of @header_order. This is used # for sorting and case matching. my %header_order; my %standard_case; { my $i = 0; for (@header_order) { my $lc = lc $_; $header_order{$lc} = ++$i; $standard_case{$lc} = $_; } } sub new { my($class) = shift; my $self = bless {}, $class; $self->header(@_) if @_; # set up initial headers $self; } sub header { my $self = shift; Carp::croak('Usage: $h->header($field, ...)') unless @_; my(@old); my %seen; while (@_) { my $field = shift; my $op = @_ ? ($seen{lc($field)}++ ? 'PUSH' : 'SET') : 'GET'; @old = $self->_header($field, shift, $op); } return @old if wantarray; return $old[0] if @old <= 1; join(", ", @old); } sub clear { my $self = shift; %$self = (); } sub push_header { my $self = shift; return $self->_header(@_, 'PUSH_H') if @_ == 2; while (@_) { $self->_header(splice(@_, 0, 2), 'PUSH_H'); } } sub init_header { Carp::croak('Usage: $h->init_header($field, $val)') if @_ != 3; shift->_header(@_, 'INIT'); } sub remove_header { my($self, @fields) = @_; my $field; my @values; foreach $field (@fields) { $field =~ tr/_/-/ if $field !~ /^:/ && $TRANSLATE_UNDERSCORE; my $v = delete $self->{lc $field}; push(@values, ref($v) eq 'ARRAY' ? @$v : $v) if defined $v; } return @values; } sub remove_content_headers { my $self = shift; unless (defined(wantarray)) { # fast branch that does not create return object delete @$self{grep $entity_header{$_} || /^content-/, keys %$self}; return; } my $c = ref($self)->new; for my $f (grep $entity_header{$_} || /^content-/, keys %$self) { $c->{$f} = delete $self->{$f}; } if (exists $self->{'::std_case'}) { $c->{'::std_case'} = $self->{'::std_case'}; } $c; } sub _header { my($self, $field, $val, $op) = @_; Carp::croak("Illegal field name '$field'") if rindex($field, ':') > 1 || !length($field); unless ($field =~ /^:/) { $field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE; my $old = $field; $field = lc $field; unless($standard_case{$field} || $self->{'::std_case'}{$field}) { # generate a %std_case entry for this field $old =~ s/\b(\w)/\u$1/g; $self->{'::std_case'}{$field} = $old; } } $op ||= defined($val) ? 'SET' : 'GET'; if ($op eq 'PUSH_H') { # Like PUSH but where we don't care about the return value if (exists $self->{$field}) { my $h = $self->{$field}; if (ref($h) eq 'ARRAY') { push(@$h, ref($val) eq "ARRAY" ? @$val : $val); } else { $self->{$field} = [$h, ref($val) eq "ARRAY" ? @$val : $val] } return; } $self->{$field} = $val; return; } my $h = $self->{$field}; my @old = ref($h) eq 'ARRAY' ? @$h : (defined($h) ? ($h) : ()); unless ($op eq 'GET' || ($op eq 'INIT' && @old)) { if (defined($val)) { my @new = ($op eq 'PUSH') ? @old : (); if (ref($val) ne 'ARRAY') { push(@new, $val); } else { push(@new, @$val); } $self->{$field} = @new > 1 ? \@new : $new[0]; } elsif ($op ne 'PUSH') { delete $self->{$field}; } } @old; } sub _sorted_field_names { my $self = shift; return [ sort { ($header_order{$a} || 999) <=> ($header_order{$b} || 999) || $a cmp $b } grep !/^::/, keys %$self ]; } sub header_field_names { my $self = shift; return map $standard_case{$_} || $self->{'::std_case'}{$_} || $_, @{ $self->_sorted_field_names }, if wantarray; return grep !/^::/, keys %$self; } sub scan { my($self, $sub) = @_; my $key; for $key (@{ $self->_sorted_field_names }) { my $vals = $self->{$key}; if (ref($vals) eq 'ARRAY') { my $val; for $val (@$vals) { $sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $val); } } else { $sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $vals); } } } sub flatten { my($self)=@_; ( map { my $k = $_; map { ( $k => $_ ) } $self->header($_); } $self->header_field_names ); } sub as_string { my($self, $endl) = @_; $endl = "\n" unless defined $endl; my @result = (); for my $key (@{ $self->_sorted_field_names }) { next if index($key, '_') == 0; my $vals = $self->{$key}; if ( ref($vals) eq 'ARRAY' ) { for my $val (@$vals) { $val = '' if not defined $val; my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key; $field =~ s/^://; if ( index($val, "\n") >= 0 ) { $val = _process_newline($val, $endl); } push @result, $field . ': ' . $val; } } else { $vals = '' if not defined $vals; my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key; $field =~ s/^://; if ( index($vals, "\n") >= 0 ) { $vals = _process_newline($vals, $endl); } push @result, $field . ': ' . $vals; } } join($endl, @result, ''); } sub _process_newline { local $_ = shift; my $endl = shift; # must handle header values with embedded newlines with care s/\s+$//; # trailing newlines and space must go s/\n(\x0d?\n)+/\n/g; # no empty lines s/\n([^\040\t])/\n $1/g; # initial space for continuation s/\n/$endl/g; # substitute with requested line ending $_; } if (eval { require Clone; 1 }) { *clone = \&Clone::clone; } else { *clone = sub { my $self = shift; my $clone = HTTP::Headers->new; $self->scan(sub { $clone->push_header(@_);} ); $clone; }; } sub _date_header { require HTTP::Date; my($self, $header, $time) = @_; my($old) = $self->_header($header); if (defined $time) { $self->_header($header, HTTP::Date::time2str($time)); } $old =~ s/;.*// if defined($old); HTTP::Date::str2time($old); } sub date { shift->_date_header('Date', @_); } sub expires { shift->_date_header('Expires', @_); } sub if_modified_since { shift->_date_header('If-Modified-Since', @_); } sub if_unmodified_since { shift->_date_header('If-Unmodified-Since', @_); } sub last_modified { shift->_date_header('Last-Modified', @_); } # This is used as a private LWP extension. The Client-Date header is # added as a timestamp to a response when it has been received. sub client_date { shift->_date_header('Client-Date', @_); } # The retry_after field is dual format (can also be a expressed as # number of seconds from now), so we don't provide an easy way to # access it until we have know how both these interfaces can be # addressed. One possibility is to return a negative value for # relative seconds and a positive value for epoch based time values. #sub retry_after { shift->_date_header('Retry-After', @_); } sub content_type { my $self = shift; my $ct = $self->{'content-type'}; $self->{'content-type'} = shift if @_; $ct = $ct->[0] if ref($ct) eq 'ARRAY'; return '' unless defined($ct) && length($ct); my @ct = split(/;\s*/, $ct, 2); for ($ct[0]) { s/\s+//g; $_ = lc($_); } wantarray ? @ct : $ct[0]; } sub content_type_charset { my $self = shift; require HTTP::Headers::Util; my $h = $self->{'content-type'}; $h = $h->[0] if ref($h); $h = "" unless defined $h; my @v = HTTP::Headers::Util::split_header_words($h); if (@v) { my($ct, undef, %ct_param) = @{$v[0]}; my $charset = $ct_param{charset}; if ($ct) { $ct = lc($ct); $ct =~ s/\s+//; } if ($charset) { $charset = uc($charset); $charset =~ s/^\s+//; $charset =~ s/\s+\z//; undef($charset) if $charset eq ""; } return $ct, $charset if wantarray; return $charset; } return undef, undef if wantarray; return undef; } sub content_is_text { my $self = shift; return $self->content_type =~ m,^text/,; } sub content_is_html { my $self = shift; return $self->content_type eq 'text/html' || $self->content_is_xhtml; } sub content_is_xhtml { my $ct = shift->content_type; return $ct eq "application/xhtml+xml" || $ct eq "application/vnd.wap.xhtml+xml"; } sub content_is_xml { my $ct = shift->content_type; return 1 if $ct eq "text/xml"; return 1 if $ct eq "application/xml"; return 1 if $ct =~ /\+xml$/; return 0; } sub referer { my $self = shift; if (@_ && $_[0] =~ /#/) { # Strip fragment per RFC 2616, section 14.36. my $uri = shift; if (ref($uri)) { $uri = $uri->clone; $uri->fragment(undef); } else { $uri =~ s/\#.*//; } unshift @_, $uri; } ($self->_header('Referer', @_))[0]; } *referrer = \&referer; # on tchrist's request sub title { (shift->_header('Title', @_))[0] } sub content_encoding { (shift->_header('Content-Encoding', @_))[0] } sub content_language { (shift->_header('Content-Language', @_))[0] } sub content_length { (shift->_header('Content-Length', @_))[0] } sub user_agent { (shift->_header('User-Agent', @_))[0] } sub server { (shift->_header('Server', @_))[0] } sub from { (shift->_header('From', @_))[0] } sub warning { (shift->_header('Warning', @_))[0] } sub www_authenticate { (shift->_header('WWW-Authenticate', @_))[0] } sub authorization { (shift->_header('Authorization', @_))[0] } sub proxy_authenticate { (shift->_header('Proxy-Authenticate', @_))[0] } sub proxy_authorization { (shift->_header('Proxy-Authorization', @_))[0] } sub authorization_basic { shift->_basic_auth("Authorization", @_) } sub proxy_authorization_basic { shift->_basic_auth("Proxy-Authorization", @_) } sub _basic_auth { require MIME::Base64; my($self, $h, $user, $passwd) = @_; my($old) = $self->_header($h); if (defined $user) { Carp::croak("Basic authorization user name can't contain ':'") if $user =~ /:/; $passwd = '' unless defined $passwd; $self->_header($h => 'Basic ' . MIME::Base64::encode("$user:$passwd", '')); } if (defined $old && $old =~ s/^\s*Basic\s+//) { my $val = MIME::Base64::decode($old); return $val unless wantarray; return split(/:/, $val, 2); } return; } 1; =pod =encoding UTF-8 =head1 NAME HTTP::Headers - Class encapsulating HTTP Message headers =head1 VERSION version 6.36 =head1 SYNOPSIS require HTTP::Headers; $h = HTTP::Headers->new; $h->header('Content-Type' => 'text/plain'); # set $ct = $h->header('Content-Type'); # get $h->remove_header('Content-Type'); # delete =head1 DESCRIPTION The C class encapsulates HTTP-style message headers. The headers consist of attribute-value pairs also called fields, which may be repeated, and which are printed in a particular order. The field names are cases insensitive. Instances of this class are usually created as member variables of the C and C classes, internal to the library. The following methods are available: =over 4 =item $h = HTTP::Headers->new Constructs a new C object. You might pass some initial attribute-value pairs as parameters to the constructor. I: $h = HTTP::Headers->new( Date => 'Thu, 03 Feb 1994 00:00:00 GMT', Content_Type => 'text/html; version=3.2', Content_Base => 'http://www.perl.org/'); The constructor arguments are passed to the C
method which is described below. =item $h->clone Returns a copy of this C object. =item $h->header( $field ) =item $h->header( $field => $value ) =item $h->header( $f1 => $v1, $f2 => $v2, ... ) Get or set the value of one or more header fields. The header field name ($field) is not case sensitive. To make the life easier for perl users who wants to avoid quoting before the => operator, you can use '_' as a replacement for '-' in header names. The header() method accepts multiple ($field => $value) pairs, which means that you can update several fields with a single invocation. The $value argument may be a plain string or a reference to an array of strings for a multi-valued field. If the $value is provided as C then the field is removed. If the $value is not given, then that header field will remain unchanged. In addition to being a string, $value may be something that stringifies. The old value (or values) of the last of the header fields is returned. If no such field exists C will be returned. A multi-valued field will be returned as separate values in list context and will be concatenated with ", " as separator in scalar context. The HTTP spec (RFC 2616) promises that joining multiple values in this way will not change the semantic of a header field, but in practice there are cases like old-style Netscape cookies (see L) where "," is used as part of the syntax of a single field value. Examples: $header->header(MIME_Version => '1.0', User_Agent => 'My-Web-Client/0.01'); $header->header(Accept => "text/html, text/plain, image/*"); $header->header(Accept => [qw(text/html text/plain image/*)]); @accepts = $header->header('Accept'); # get multiple values $accepts = $header->header('Accept'); # get values as a single string =item $h->push_header( $field => $value ) =item $h->push_header( $f1 => $v1, $f2 => $v2, ... ) Add a new field value for the specified header field. Previous values for the same field are retained. As for the header() method, the field name ($field) is not case sensitive and '_' can be used as a replacement for '-'. The $value argument may be a scalar or a reference to a list of scalars. $header->push_header(Accept => 'image/jpeg'); $header->push_header(Accept => [map "image/$_", qw(gif png tiff)]); =item $h->init_header( $field => $value ) Set the specified header to the given value, but only if no previous value for that field is set. The header field name ($field) is not case sensitive and '_' can be used as a replacement for '-'. The $value argument may be a scalar or a reference to a list of scalars. =item $h->remove_header( $field, ... ) This function removes the header fields with the specified names. The header field names ($field) are not case sensitive and '_' can be used as a replacement for '-'. The return value is the values of the fields removed. In scalar context the number of fields removed is returned. Note that if you pass in multiple field names then it is generally not possible to tell which of the returned values belonged to which field. =item $h->remove_content_headers This will remove all the header fields used to describe the content of a message. All header field names prefixed with C fall into this category, as well as C, C and C. RFC 2616 denotes these fields as I. The return value is a new C object that contains the removed headers only. =item $h->clear This will remove all header fields. =item $h->header_field_names Returns the list of distinct names for the fields present in the header. The field names have case as suggested by HTTP spec, and the names are returned in the recommended "Good Practice" order. In scalar context return the number of distinct field names. =item $h->scan( \&process_header_field ) Apply a subroutine to each header field in turn. The callback routine is called with two parameters; the name of the field and a single value (a string). If a header field is multi-valued, then the routine is called once for each value. The field name passed to the callback routine has case as suggested by HTTP spec, and the headers will be visited in the recommended "Good Practice" order. Any return values of the callback routine are ignored. The loop can be broken by raising an exception (C), but the caller of scan() would have to trap the exception itself. =item $h->flatten() Returns the list of pairs of keys and values. =item $h->as_string =item $h->as_string( $eol ) Return the header fields as a formatted MIME header. Since it internally uses the C method to build the string, the result will use case as suggested by HTTP spec, and it will follow recommended "Good Practice" of ordering the header fields. Long header values are not folded. The optional $eol parameter specifies the line ending sequence to use. The default is "\n". Embedded "\n" characters in header field values will be substituted with this line ending sequence. =back =head1 CONVENIENCE METHODS The most frequently used headers can also be accessed through the following convenience methods. Most of these methods can both be used to read and to set the value of a header. The header value is set if you pass an argument to the method. The old header value is always returned. If the given header did not exist then C is returned. Methods that deal with dates/times always convert their value to system time (seconds since Jan 1, 1970) and they also expect this kind of value when the header value is set. =over 4 =item $h->date This header represents the date and time at which the message was originated. I: $h->date(time); # set current date =item $h->expires This header gives the date and time after which the entity should be considered stale. =item $h->if_modified_since =item $h->if_unmodified_since These header fields are used to make a request conditional. If the requested resource has (or has not) been modified since the time specified in this field, then the server will return a C<304 Not Modified> response instead of the document itself. =item $h->last_modified This header indicates the date and time at which the resource was last modified. I: # check if document is more than 1 hour old if (my $last_mod = $h->last_modified) { if ($last_mod < time - 60*60) { ... } } =item $h->content_type The Content-Type header field indicates the media type of the message content. I: $h->content_type('text/html'); The value returned will be converted to lower case, and potential parameters will be chopped off and returned as a separate value if in an array context. If there is no such header field, then the empty string is returned. This makes it safe to do the following: if ($h->content_type eq 'text/html') { # we enter this place even if the real header value happens to # be 'TEXT/HTML; version=3.0' ... } =item $h->content_type_charset Returns the upper-cased charset specified in the Content-Type header. In list context return the lower-cased bare content type followed by the upper-cased charset. Both values will be C if not specified in the header. =item $h->content_is_text Returns TRUE if the Content-Type header field indicate that the content is textual. =item $h->content_is_html Returns TRUE if the Content-Type header field indicate that the content is some kind of HTML (including XHTML). This method can't be used to set Content-Type. =item $h->content_is_xhtml Returns TRUE if the Content-Type header field indicate that the content is XHTML. This method can't be used to set Content-Type. =item $h->content_is_xml Returns TRUE if the Content-Type header field indicate that the content is XML. This method can't be used to set Content-Type. =item $h->content_encoding The Content-Encoding header field is used as a modifier to the media type. When present, its value indicates what additional encoding mechanism has been applied to the resource. =item $h->content_length A decimal number indicating the size in bytes of the message content. =item $h->content_language The natural language(s) of the intended audience for the message content. The value is one or more language tags as defined by RFC 1766. Eg. "no" for some kind of Norwegian and "en-US" for English the way it is written in the US. =item $h->title The title of the document. In libwww-perl this header will be initialized automatically from the ETITLE>...E/TITLE> element of HTML documents. I =item $h->user_agent This header field is used in request messages and contains information about the user agent originating the request. I: $h->user_agent('Mozilla/5.0 (compatible; MSIE 7.0; Windows NT 6.0)'); =item $h->server The server header field contains information about the software being used by the originating server program handling the request. =item $h->from This header should contain an Internet e-mail address for the human user who controls the requesting user agent. The address should be machine-usable, as defined by RFC822. E.g.: $h->from('King Kong '); I =item $h->referer Used to specify the address (URI) of the document from which the requested resource address was obtained. The "Free On-line Dictionary of Computing" as this to say about the word I: A misspelling of "referrer" which somehow made it into the {HTTP} standard. A given {web page}'s referer (sic) is the {URL} of whatever web page contains the link that the user followed to the current page. Most browsers pass this information as part of a request. (1998-10-19) By popular demand C exists as an alias for this method so you can avoid this misspelling in your programs and still send the right thing on the wire. When setting the referrer, this method removes the fragment from the given URI if it is present, as mandated by RFC2616. Note that the removal does I happen automatically if using the header(), push_header() or init_header() methods to set the referrer. =item $h->www_authenticate This header must be included as part of a C<401 Unauthorized> response. The field value consist of a challenge that indicates the authentication scheme and parameters applicable to the requested URI. =item $h->proxy_authenticate This header must be included in a C<407 Proxy Authentication Required> response. =item $h->authorization =item $h->proxy_authorization A user agent that wishes to authenticate itself with a server or a proxy, may do so by including these headers. =item $h->authorization_basic This method is used to get or set an authorization header that use the "Basic Authentication Scheme". In array context it will return two values; the user name and the password. In scalar context it will return I<"uname:password"> as a single string value. When used to set the header value, it expects two arguments. I: $h->authorization_basic($uname, $password); The method will croak if the $uname contains a colon ':'. =item $h->proxy_authorization_basic Same as authorization_basic() but will set the "Proxy-Authorization" header instead. =back =head1 NON-CANONICALIZED FIELD NAMES The header field name spelling is normally canonicalized including the '_' to '-' translation. There are some application where this is not appropriate. Prefixing field names with ':' allow you to force a specific spelling. For example if you really want a header field name to show up as C instead of "Foo-Bar", you might set it like this: $h->header(":foo_bar" => 1); These field names are returned with the ':' intact for $h->header_field_names and the $h->scan callback, but the colons do not show in $h->as_string. =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #ABSTRACT: Class encapsulating HTTP Message headers HTTP-Message-6.36/lib/HTTP/Request/000755 000765 000024 00000000000 14165326704 016662 5ustar00olafstaff000000 000000 HTTP-Message-6.36/lib/HTTP/Response.pm000644 000765 000024 00000041036 14165326704 017372 0ustar00olafstaff000000 000000 package HTTP::Response; use strict; use warnings; our $VERSION = '6.36'; use base 'HTTP::Message'; use HTTP::Status (); sub new { my($class, $rc, $msg, $header, $content) = @_; my $self = $class->SUPER::new($header, $content); $self->code($rc); $self->message($msg); $self; } sub parse { my($class, $str) = @_; Carp::carp('Undefined argument to parse()') if $^W && ! defined $str; my $status_line; if (defined $str && $str =~ s/^(.*)\n//) { $status_line = $1; } else { $status_line = $str; $str = ""; } $status_line =~ s/\r\z// if defined $status_line; my $self = $class->SUPER::parse($str); if (defined $status_line) { my($protocol, $code, $message); if ($status_line =~ /^\d{3} /) { # Looks like a response created by HTTP::Response->new ($code, $message) = split(' ', $status_line, 2); } else { ($protocol, $code, $message) = split(' ', $status_line, 3); } $self->protocol($protocol) if $protocol; $self->code($code) if defined($code); $self->message($message) if defined($message); } $self; } sub clone { my $self = shift; my $clone = bless $self->SUPER::clone, ref($self); $clone->code($self->code); $clone->message($self->message); $clone->request($self->request->clone) if $self->request; # we don't clone previous $clone; } sub code { shift->_elem('_rc', @_); } sub message { shift->_elem('_msg', @_); } sub previous { shift->_elem('_previous',@_); } sub request { shift->_elem('_request', @_); } sub status_line { my $self = shift; my $code = $self->{'_rc'} || "000"; my $mess = $self->{'_msg'} || HTTP::Status::status_message($code) || "Unknown code"; return "$code $mess"; } sub base { my $self = shift; my $base = ( $self->header('Content-Base'), # used to be HTTP/1.1 $self->header('Content-Location'), # HTTP/1.1 $self->header('Base'), # HTTP/1.0 )[0]; if ($base && $base =~ /^$URI::scheme_re:/o) { # already absolute return $HTTP::URI_CLASS->new($base); } my $req = $self->request; if ($req) { # if $base is undef here, the return value is effectively # just a copy of $self->request->uri. return $HTTP::URI_CLASS->new_abs($base, $req->uri); } # can't find an absolute base return undef; } sub redirects { my $self = shift; my @r; my $r = $self; while (my $p = $r->previous) { push(@r, $p); $r = $p; } return @r unless wantarray; return reverse @r; } sub filename { my $self = shift; my $file; my $cd = $self->header('Content-Disposition'); if ($cd) { require HTTP::Headers::Util; if (my @cd = HTTP::Headers::Util::split_header_words($cd)) { my ($disposition, undef, %cd_param) = @{$cd[-1]}; $file = $cd_param{filename}; # RFC 2047 encoded? if ($file && $file =~ /^=\?(.+?)\?(.+?)\?(.+)\?=$/) { my $charset = $1; my $encoding = uc($2); my $encfile = $3; if ($encoding eq 'Q' || $encoding eq 'B') { local($SIG{__DIE__}); eval { if ($encoding eq 'Q') { $encfile =~ s/_/ /g; require MIME::QuotedPrint; $encfile = MIME::QuotedPrint::decode($encfile); } else { # $encoding eq 'B' require MIME::Base64; $encfile = MIME::Base64::decode($encfile); } require Encode; require Encode::Locale; Encode::from_to($encfile, $charset, "locale_fs"); }; $file = $encfile unless $@; } } } } unless (defined($file) && length($file)) { my $uri; if (my $cl = $self->header('Content-Location')) { $uri = URI->new($cl); } elsif (my $request = $self->request) { $uri = $request->uri; } if ($uri) { $file = ($uri->path_segments)[-1]; } } if ($file) { $file =~ s,.*[\\/],,; # basename } if ($file && !length($file)) { $file = undef; } $file; } sub as_string { my $self = shift; my($eol) = @_; $eol = "\n" unless defined $eol; my $status_line = $self->status_line; my $proto = $self->protocol; $status_line = "$proto $status_line" if $proto; return join($eol, $status_line, $self->SUPER::as_string(@_)); } sub dump { my $self = shift; my $status_line = $self->status_line; my $proto = $self->protocol; $status_line = "$proto $status_line" if $proto; return $self->SUPER::dump( preheader => $status_line, @_, ); } sub is_info { HTTP::Status::is_info (shift->{'_rc'}); } sub is_success { HTTP::Status::is_success (shift->{'_rc'}); } sub is_redirect { HTTP::Status::is_redirect (shift->{'_rc'}); } sub is_error { HTTP::Status::is_error (shift->{'_rc'}); } sub is_client_error { HTTP::Status::is_client_error (shift->{'_rc'}); } sub is_server_error { HTTP::Status::is_server_error (shift->{'_rc'}); } sub error_as_HTML { my $self = shift; my $title = 'An Error Occurred'; my $body = $self->status_line; $body =~ s/&/&/g; $body =~ s/ $title

$title

$body

EOM } sub current_age { my $self = shift; my $time = shift; # Implementation of RFC 2616 section 13.2.3 # (age calculations) my $response_time = $self->client_date; my $date = $self->date; my $age = 0; if ($response_time && $date) { $age = $response_time - $date; # apparent_age $age = 0 if $age < 0; } my $age_v = $self->header('Age'); if ($age_v && $age_v > $age) { $age = $age_v; # corrected_received_age } if ($response_time) { my $request = $self->request; if ($request) { my $request_time = $request->date; if ($request_time && $request_time < $response_time) { # Add response_delay to age to get 'corrected_initial_age' $age += $response_time - $request_time; } } $age += ($time || time) - $response_time; } return $age; } sub freshness_lifetime { my($self, %opt) = @_; # First look for the Cache-Control: max-age=n header for my $cc ($self->header('Cache-Control')) { for my $cc_dir (split(/\s*,\s*/, $cc)) { return $1 if $cc_dir =~ /^max-age\s*=\s*(\d+)/i; } } # Next possibility is to look at the "Expires" header my $date = $self->date || $self->client_date || $opt{time} || time; if (my $expires = $self->expires) { return $expires - $date; } # Must apply heuristic expiration return undef if exists $opt{heuristic_expiry} && !$opt{heuristic_expiry}; # Default heuristic expiration parameters $opt{h_min} ||= 60; $opt{h_max} ||= 24 * 3600; $opt{h_lastmod_fraction} ||= 0.10; # 10% since last-mod suggested by RFC2616 $opt{h_default} ||= 3600; # Should give a warning if more than 24 hours according to # RFC 2616 section 13.2.4. Here we just make this the default # maximum value. if (my $last_modified = $self->last_modified) { my $h_exp = ($date - $last_modified) * $opt{h_lastmod_fraction}; return $opt{h_min} if $h_exp < $opt{h_min}; return $opt{h_max} if $h_exp > $opt{h_max}; return $h_exp; } # default when all else fails return $opt{h_min} if $opt{h_min} > $opt{h_default}; return $opt{h_default}; } sub is_fresh { my($self, %opt) = @_; $opt{time} ||= time; my $f = $self->freshness_lifetime(%opt); return undef unless defined($f); return $f > $self->current_age($opt{time}); } sub fresh_until { my($self, %opt) = @_; $opt{time} ||= time; my $f = $self->freshness_lifetime(%opt); return undef unless defined($f); return $f - $self->current_age($opt{time}) + $opt{time}; } 1; =pod =encoding UTF-8 =head1 NAME HTTP::Response - HTTP style response message =head1 VERSION version 6.36 =head1 SYNOPSIS Response objects are returned by the request() method of the C: # ... $response = $ua->request($request); if ($response->is_success) { print $response->decoded_content; } else { print STDERR $response->status_line, "\n"; } =head1 DESCRIPTION The C class encapsulates HTTP style responses. A response consists of a response line, some headers, and a content body. Note that the LWP library uses HTTP style responses even for non-HTTP protocol schemes. Instances of this class are usually created and returned by the request() method of an C object. C is a subclass of C and therefore inherits its methods. The following additional methods are available: =over 4 =item $r = HTTP::Response->new( $code ) =item $r = HTTP::Response->new( $code, $msg ) =item $r = HTTP::Response->new( $code, $msg, $header ) =item $r = HTTP::Response->new( $code, $msg, $header, $content ) Constructs a new C object describing a response with response code $code and optional message $msg. The optional $header argument should be a reference to an C object or a plain array reference of key/value pairs. The optional $content argument should be a string of bytes. The meanings of these arguments are described below. =item $r = HTTP::Response->parse( $str ) This constructs a new response object by parsing the given string. =item $r->code =item $r->code( $code ) This is used to get/set the code attribute. The code is a 3 digit number that encode the overall outcome of an HTTP response. The C module provide constants that provide mnemonic names for the code attribute. =item $r->message =item $r->message( $message ) This is used to get/set the message attribute. The message is a short human readable single line string that explains the response code. =item $r->header( $field ) =item $r->header( $field => $value ) This is used to get/set header values and it is inherited from C via C. See L for details and other similar methods that can be used to access the headers. =item $r->content =item $r->content( $bytes ) This is used to get/set the raw content and it is inherited from the C base class. See L for details and other methods that can be used to access the content. =item $r->decoded_content( %options ) This will return the content after any C and charsets have been decoded. See L for details. =item $r->request =item $r->request( $request ) This is used to get/set the request attribute. The request attribute is a reference to the request that caused this response. It does not have to be the same request passed to the $ua->request() method, because there might have been redirects and authorization retries in between. =item $r->previous =item $r->previous( $response ) This is used to get/set the previous attribute. The previous attribute is used to link together chains of responses. You get chains of responses if the first response is redirect or unauthorized. The value is C if this is the first response in a chain. Note that the method $r->redirects is provided as a more convenient way to access the response chain. =item $r->status_line Returns the string "Ecode> Emessage>". If the message attribute is not set then the official name of Ecode> (see L) is substituted. =item $r->base Returns the base URI for this response. The return value will be a reference to a URI object. The base URI is obtained from one the following sources (in priority order): =over 4 =item 1. Embedded in the document content, for instance in HTML documents. =item 2. A "Content-Base:" or a "Content-Location:" header in the response. For backwards compatibility with older HTTP implementations we will also look for the "Base:" header. =item 3. The URI used to request this response. This might not be the original URI that was passed to $ua->request() method, because we might have received some redirect responses first. =back If none of these sources provide an absolute URI, undef is returned. When the LWP protocol modules produce the HTTP::Response object, then any base URI embedded in the document (step 1) will already have initialized the "Content-Base:" header. (See L). This means that this method only performs the last 2 steps (the content is not always available either). =item $r->filename Returns a filename for this response. Note that doing sanity checks on the returned filename (eg. removing characters that cannot be used on the target filesystem where the filename would be used, and laundering it for security purposes) are the caller's responsibility; the only related thing done by this method is that it makes a simple attempt to return a plain filename with no preceding path segments. The filename is obtained from one the following sources (in priority order): =over 4 =item 1. A "Content-Disposition:" header in the response. Proper decoding of RFC 2047 encoded filenames requires the C (for "Q" encoding), C (for "B" encoding), and C modules. =item 2. A "Content-Location:" header in the response. =item 3. The URI used to request this response. This might not be the original URI that was passed to $ua->request() method, because we might have received some redirect responses first. =back If a filename cannot be derived from any of these sources, undef is returned. =item $r->as_string =item $r->as_string( $eol ) Returns a textual representation of the response. =item $r->is_info =item $r->is_success =item $r->is_redirect =item $r->is_error =item $r->is_client_error =item $r->is_server_error These methods indicate if the response was informational, successful, a redirection, or an error. See L for the meaning of these. =item $r->error_as_HTML Returns a string containing a complete HTML document indicating what error occurred. This method should only be called when $r->is_error is TRUE. =item $r->redirects Returns the list of redirect responses that lead up to this response by following the $r->previous chain. The list order is oldest first. In scalar context return the number of redirect responses leading up to this one. =item $r->current_age Calculates the "current age" of the response as specified by RFC 2616 section 13.2.3. The age of a response is the time since it was sent by the origin server. The returned value is a number representing the age in seconds. =item $r->freshness_lifetime( %opt ) Calculates the "freshness lifetime" of the response as specified by RFC 2616 section 13.2.4. The "freshness lifetime" is the length of time between the generation of a response and its expiration time. The returned value is the number of seconds until expiry. If the response does not contain an "Expires" or a "Cache-Control" header, then this function will apply some simple heuristic based on the "Last-Modified" header to determine a suitable lifetime. The following options might be passed to control the heuristics: =over =item heuristic_expiry => $bool If passed as a FALSE value, don't apply heuristics and just return C when "Expires" or "Cache-Control" is lacking. =item h_lastmod_fraction => $num This number represent the fraction of the difference since the "Last-Modified" timestamp to make the expiry time. The default is C<0.10>, the suggested typical setting of 10% in RFC 2616. =item h_min => $sec This is the lower limit of the heuristic expiry age to use. The default is C<60> (1 minute). =item h_max => $sec This is the upper limit of the heuristic expiry age to use. The default is C<86400> (24 hours). =item h_default => $sec This is the expiry age to use when nothing else applies. The default is C<3600> (1 hour) or "h_min" if greater. =back =item $r->is_fresh( %opt ) Returns TRUE if the response is fresh, based on the values of freshness_lifetime() and current_age(). If the response is no longer fresh, then it has to be re-fetched or re-validated by the origin server. Options might be passed to control expiry heuristics, see the description of freshness_lifetime(). =item $r->fresh_until( %opt ) Returns the time (seconds since epoch) when this entity is no longer fresh. Options might be passed to control expiry heuristics, see the description of freshness_lifetime(). =back =head1 SEE ALSO L, L, L, L =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #ABSTRACT: HTTP style response message HTTP-Message-6.36/lib/HTTP/Config.pm000644 000765 000024 00000027045 14165326704 017005 0ustar00olafstaff000000 000000 package HTTP::Config; use strict; use warnings; our $VERSION = '6.36'; use URI; sub new { my $class = shift; return bless [], $class; } sub entries { my $self = shift; @$self; } sub empty { my $self = shift; not @$self; } sub add { if (@_ == 2) { my $self = shift; push(@$self, shift); return; } my($self, %spec) = @_; push(@$self, \%spec); return; } sub find2 { my($self, %spec) = @_; my @found; my @rest; ITEM: for my $item (@$self) { for my $k (keys %spec) { no warnings 'uninitialized'; if (!exists $item->{$k} || $spec{$k} ne $item->{$k}) { push(@rest, $item); next ITEM; } } push(@found, $item); } return \@found unless wantarray; return \@found, \@rest; } sub find { my $self = shift; my $f = $self->find2(@_); return @$f if wantarray; return $f->[0]; } sub remove { my($self, %spec) = @_; my($removed, $rest) = $self->find2(%spec); @$self = @$rest if @$removed; return @$removed; } my %MATCH = ( m_scheme => sub { my($v, $uri) = @_; return $uri->_scheme eq $v; # URI known to be canonical }, m_secure => sub { my($v, $uri) = @_; my $secure = $uri->can("secure") ? $uri->secure : $uri->_scheme eq "https"; return $secure == !!$v; }, m_host_port => sub { my($v, $uri) = @_; return unless $uri->can("host_port"); return $uri->host_port eq $v, 7; }, m_host => sub { my($v, $uri) = @_; return unless $uri->can("host"); return $uri->host eq $v, 6; }, m_port => sub { my($v, $uri) = @_; return unless $uri->can("port"); return $uri->port eq $v; }, m_domain => sub { my($v, $uri) = @_; return unless $uri->can("host"); my $h = $uri->host; $h = "$h.local" unless $h =~ /\./; $v = ".$v" unless $v =~ /^\./; return length($v), 5 if substr($h, -length($v)) eq $v; return 0; }, m_path => sub { my($v, $uri) = @_; return unless $uri->can("path"); return $uri->path eq $v, 4; }, m_path_prefix => sub { my($v, $uri) = @_; return unless $uri->can("path"); my $path = $uri->path; my $len = length($v); return $len, 3 if $path eq $v; return 0 if length($path) <= $len; $v .= "/" unless $v =~ m,/\z,,; return $len, 3 if substr($path, 0, length($v)) eq $v; return 0; }, m_path_match => sub { my($v, $uri) = @_; return unless $uri->can("path"); return $uri->path =~ $v; }, m_uri__ => sub { my($v, $k, $uri) = @_; return unless $uri->can($k); return 1 unless defined $v; return $uri->$k eq $v; }, m_method => sub { my($v, $uri, $request) = @_; return $request && $request->method eq $v; }, m_proxy => sub { my($v, $uri, $request) = @_; return $request && ($request->{proxy} || "") eq $v; }, m_code => sub { my($v, $uri, $request, $response) = @_; $v =~ s/xx\z//; return unless $response; return length($v), 2 if substr($response->code, 0, length($v)) eq $v; }, m_media_type => sub { # for request too?? my($v, $uri, $request, $response) = @_; return unless $response; return 1, 1 if $v eq "*/*"; my $ct = $response->content_type; return 2, 1 if $v =~ s,/\*\z,, && $ct =~ m,^\Q$v\E/,; return 3, 1 if $v eq "html" && $response->content_is_html; return 4, 1 if $v eq "xhtml" && $response->content_is_xhtml; return 10, 1 if $v eq $ct; return 0; }, m_header__ => sub { my($v, $k, $uri, $request, $response) = @_; return unless $request; my $req_header = $request->header($k); return 1 if defined($req_header) && $req_header eq $v; if ($response) { my $res_header = $response->header($k); return 1 if defined($res_header) && $res_header eq $v; } return 0; }, m_response_attr__ => sub { my($v, $k, $uri, $request, $response) = @_; return unless $response; return 1 if !defined($v) && exists $response->{$k}; return 0 unless exists $response->{$k}; return 1 if $response->{$k} eq $v; return 0; }, ); sub matching { my $self = shift; if (@_ == 1) { if ($_[0]->can("request")) { unshift(@_, $_[0]->request); unshift(@_, undef) unless defined $_[0]; } unshift(@_, $_[0]->uri_canonical) if $_[0] && $_[0]->can("uri_canonical"); } my($uri, $request, $response) = @_; $uri = URI->new($uri) unless ref($uri); my @m; ITEM: for my $item (@$self) { my $order; for my $ikey (keys %$item) { my $mkey = $ikey; my $k; $k = $1 if $mkey =~ s/__(.*)/__/; if (my $m = $MATCH{$mkey}) { #print "$ikey $mkey\n"; my($c, $o); my @arg = ( defined($k) ? $k : (), $uri, $request, $response ); my $v = $item->{$ikey}; $v = [$v] unless ref($v) eq "ARRAY"; for (@$v) { ($c, $o) = $m->($_, @arg); #print " - $_ ==> $c $o\n"; last if $c; } next ITEM unless $c; $order->[$o || 0] += $c; } } $order->[7] ||= 0; $item->{_order} = join(".", reverse map sprintf("%03d", $_ || 0), @$order); push(@m, $item); } @m = sort { $b->{_order} cmp $a->{_order} } @m; delete $_->{_order} for @m; return @m if wantarray; return $m[0]; } sub add_item { my $self = shift; my $item = shift; return $self->add(item => $item, @_); } sub remove_items { my $self = shift; return map $_->{item}, $self->remove(@_); } sub matching_items { my $self = shift; return map $_->{item}, $self->matching(@_); } 1; =pod =encoding UTF-8 =head1 NAME HTTP::Config - Configuration for request and response objects =head1 VERSION version 6.36 =head1 SYNOPSIS use HTTP::Config; my $c = HTTP::Config->new; $c->add(m_domain => ".example.com", m_scheme => "http", verbose => 1); use HTTP::Request; my $request = HTTP::Request->new(GET => "http://www.example.com"); if (my @m = $c->matching($request)) { print "Yadayada\n" if $m[0]->{verbose}; } =head1 DESCRIPTION An C object is a list of entries that can be matched against request or request/response pairs. Its purpose is to hold configuration data that can be looked up given a request or response object. Each configuration entry is a hash. Some keys specify matching to occur against attributes of request/response objects. Other keys can be used to hold user data. The following methods are provided: =over 4 =item $conf = HTTP::Config->new Constructs a new empty C object and returns it. =item $conf->entries Returns the list of entries in the configuration object. In scalar context returns the number of entries. =item $conf->empty Return true if there are no entries in the configuration object. This is just a shorthand for C<< not $conf->entries >>. =item $conf->add( %matchspec, %other ) =item $conf->add( \%entry ) Adds a new entry to the configuration. You can either pass separate key/value pairs or a hash reference. =item $conf->remove( %spec ) Removes (and returns) the entries that have matches for all the key/value pairs in %spec. If %spec is empty this will match all entries; so it will empty the configuration object. =item $conf->matching( $uri, $request, $response ) =item $conf->matching( $uri ) =item $conf->matching( $request ) =item $conf->matching( $response ) Returns the entries that match the given $uri, $request and $response triplet. If called with a single $request object then the $uri is obtained by calling its 'uri_canonical' method. If called with a single $response object, then the request object is obtained by calling its 'request' method; and then the $uri is obtained as if a single $request was provided. The entries are returned with the most specific matches first. In scalar context returns the most specific match or C in none match. =item $conf->add_item( $item, %matchspec ) =item $conf->remove_items( %spec ) =item $conf->matching_items( $uri, $request, $response ) Wrappers that hides the entries themselves. =back =head2 Matching The following keys on a configuration entry specify matching. For all of these you can provide an array of values instead of a single value. The entry matches if at least one of the values in the array matches. Entries that require match against a response object attribute will never match unless a response object was provided. =over =item m_scheme => $scheme Matches if the URI uses the specified scheme; e.g. "http". =item m_secure => $bool If $bool is TRUE; matches if the URI uses a secure scheme. If $bool is FALSE; matches if the URI does not use a secure scheme. An example of a secure scheme is "https". =item m_host_port => "$hostname:$port" Matches if the URI's host_port method return the specified value. =item m_host => $hostname Matches if the URI's host method returns the specified value. =item m_port => $port Matches if the URI's port method returns the specified value. =item m_domain => ".$domain" Matches if the URI's host method return a value that within the given domain. The hostname "www.example.com" will for instance match the domain ".com". =item m_path => $path Matches if the URI's path method returns the specified value. =item m_path_prefix => $path Matches if the URI's path is the specified path or has the specified path as prefix. =item m_path_match => $Regexp Matches if the regular expression matches the URI's path. Eg. qr/\.html$/. =item m_method => $method Matches if the request method matches the specified value. Eg. "GET" or "POST". =item m_code => $digit =item m_code => $status_code Matches if the response status code matches. If a single digit is specified; matches for all response status codes beginning with that digit. =item m_proxy => $url Matches if the request is to be sent to the given Proxy server. =item m_media_type => "*/*" =item m_media_type => "text/*" =item m_media_type => "html" =item m_media_type => "xhtml" =item m_media_type => "text/html" Matches if the response media type matches. With a value of "html" matches if $response->content_is_html returns TRUE. With a value of "xhtml" matches if $response->content_is_xhtml returns TRUE. =item m_uri__I<$method> => undef Matches if the URI object provides the method. =item m_uri__I<$method> => $string Matches if the URI's $method method returns the given value. =item m_header__I<$field> => $string Matches if either the request or the response have a header $field with the given value. =item m_response_attr__I<$key> => undef =item m_response_attr__I<$key> => $string Matches if the response object has that key, or the entry has the given value. =back =head1 SEE ALSO L, L, L =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #ABSTRACT: Configuration for request and response objects HTTP-Message-6.36/lib/HTTP/Request/Common.pm000644 000765 000024 00000037547 14165326704 020470 0ustar00olafstaff000000 000000 package HTTP::Request::Common; use strict; use warnings; our $VERSION = '6.36'; our $DYNAMIC_FILE_UPLOAD ||= 0; # make it defined (don't know why) use Exporter 5.57 'import'; our @EXPORT =qw(GET HEAD PUT PATCH POST OPTIONS); our @EXPORT_OK = qw($DYNAMIC_FILE_UPLOAD DELETE); require HTTP::Request; use Carp(); use File::Spec; my $CRLF = "\015\012"; # "\r\n" is not portable sub GET { _simple_req('GET', @_); } sub HEAD { _simple_req('HEAD', @_); } sub DELETE { _simple_req('DELETE', @_); } sub PATCH { request_type_with_data('PATCH', @_); } sub POST { request_type_with_data('POST', @_); } sub PUT { request_type_with_data('PUT', @_); } sub OPTIONS { request_type_with_data('OPTIONS', @_); } sub request_type_with_data { my $type = shift; my $url = shift; my $req = HTTP::Request->new($type => $url); my $content; $content = shift if @_ and ref $_[0]; my($k, $v); while (($k,$v) = splice(@_, 0, 2)) { if (lc($k) eq 'content') { $content = $v; } else { $req->push_header($k, $v); } } my $ct = $req->header('Content-Type'); unless ($ct) { $ct = 'application/x-www-form-urlencoded'; } elsif ($ct eq 'form-data') { $ct = 'multipart/form-data'; } if (ref $content) { if ($ct =~ m,^multipart/form-data\s*(;|$),i) { require HTTP::Headers::Util; my @v = HTTP::Headers::Util::split_header_words($ct); Carp::carp("Multiple Content-Type headers") if @v > 1; @v = @{$v[0]}; my $boundary; my $boundary_index; for (my @tmp = @v; @tmp;) { my($k, $v) = splice(@tmp, 0, 2); if ($k eq "boundary") { $boundary = $v; $boundary_index = @v - @tmp - 1; last; } } ($content, $boundary) = form_data($content, $boundary, $req); if ($boundary_index) { $v[$boundary_index] = $boundary; } else { push(@v, boundary => $boundary); } $ct = HTTP::Headers::Util::join_header_words(@v); } else { # We use a temporary URI object to format # the application/x-www-form-urlencoded content. require URI; my $url = URI->new('http:'); $url->query_form(ref($content) eq "HASH" ? %$content : @$content); $content = $url->query; # HTML/4.01 says that line breaks are represented as "CR LF" pairs (i.e., `%0D%0A') $content =~ s/(?header('Content-Type' => $ct); # might be redundant if (defined($content)) { $req->header('Content-Length' => length($content)) unless ref($content); $req->content($content); } else { $req->header('Content-Length' => 0); } $req; } sub _simple_req { my($method, $url) = splice(@_, 0, 2); my $req = HTTP::Request->new($method => $url); my($k, $v); my $content; while (($k,$v) = splice(@_, 0, 2)) { if (lc($k) eq 'content') { $req->add_content($v); $content++; } else { $req->push_header($k, $v); } } if ($content && !defined($req->header("Content-Length"))) { $req->header("Content-Length", length(${$req->content_ref})); } $req; } sub form_data # RFC1867 { my($data, $boundary, $req) = @_; my @data = ref($data) eq "HASH" ? %$data : @$data; # copy my $fhparts; my @parts; while (my ($k,$v) = splice(@data, 0, 2)) { if (!ref($v)) { $k =~ s/([\\\"])/\\$1/g; # escape quotes and backslashes no warnings 'uninitialized'; push(@parts, qq(Content-Disposition: form-data; name="$k"$CRLF$CRLF$v)); } else { my($file, $usename, @headers) = @$v; unless (defined $usename) { $usename = $file; $usename = (File::Spec->splitpath($usename))[-1] if defined($usename); } $k =~ s/([\\\"])/\\$1/g; my $disp = qq(form-data; name="$k"); if (defined($usename) and length($usename)) { $usename =~ s/([\\\"])/\\$1/g; $disp .= qq(; filename="$usename"); } my $content = ""; my $h = HTTP::Headers->new(@headers); if ($file) { open(my $fh, "<", $file) or Carp::croak("Can't open file $file: $!"); binmode($fh); if ($DYNAMIC_FILE_UPLOAD) { # will read file later, close it now in order to # not accumulate to many open file handles close($fh); $content = \$file; } else { local($/) = undef; # slurp files $content = <$fh>; close($fh); } unless ($h->header("Content-Type")) { require LWP::MediaTypes; LWP::MediaTypes::guess_media_type($file, $h); } } if ($h->header("Content-Disposition")) { # just to get it sorted first $disp = $h->header("Content-Disposition"); $h->remove_header("Content-Disposition"); } if ($h->header("Content")) { $content = $h->header("Content"); $h->remove_header("Content"); } my $head = join($CRLF, "Content-Disposition: $disp", $h->as_string($CRLF), ""); if (ref $content) { push(@parts, [$head, $$content]); $fhparts++; } else { push(@parts, $head . $content); } } } return ("", "none") unless @parts; my $content; if ($fhparts) { $boundary = boundary(10) # hopefully enough randomness unless $boundary; # add the boundaries to the @parts array for (1..@parts-1) { splice(@parts, $_*2-1, 0, "$CRLF--$boundary$CRLF"); } unshift(@parts, "--$boundary$CRLF"); push(@parts, "$CRLF--$boundary--$CRLF"); # See if we can generate Content-Length header my $length = 0; for (@parts) { if (ref $_) { my ($head, $f) = @$_; my $file_size; unless ( -f $f && ($file_size = -s _) ) { # The file is either a dynamic file like /dev/audio # or perhaps a file in the /proc file system where # stat may return a 0 size even though reading it # will produce data. So we cannot make # a Content-Length header. undef $length; last; } $length += $file_size + length $head; } else { $length += length; } } $length && $req->header('Content-Length' => $length); # set up a closure that will return content piecemeal $content = sub { for (;;) { unless (@parts) { defined $length && $length != 0 && Carp::croak "length of data sent did not match calculated Content-Length header. Probably because uploaded file changed in size during transfer."; return; } my $p = shift @parts; unless (ref $p) { $p .= shift @parts while @parts && !ref($parts[0]); defined $length && ($length -= length $p); return $p; } my($buf, $fh) = @$p; unless (ref($fh)) { my $file = $fh; undef($fh); open($fh, "<", $file) || Carp::croak("Can't open file $file: $!"); binmode($fh); } my $buflength = length $buf; my $n = read($fh, $buf, 2048, $buflength); if ($n) { $buflength += $n; unshift(@parts, ["", $fh]); } else { close($fh); } if ($buflength) { defined $length && ($length -= $buflength); return $buf } } }; } else { $boundary = boundary() unless $boundary; my $bno = 0; CHECK_BOUNDARY: { for (@parts) { if (index($_, $boundary) >= 0) { # must have a better boundary $boundary = boundary(++$bno); redo CHECK_BOUNDARY; } } last; } $content = "--$boundary$CRLF" . join("$CRLF--$boundary$CRLF", @parts) . "$CRLF--$boundary--$CRLF"; } wantarray ? ($content, $boundary) : $content; } sub boundary { my $size = shift || return "xYzZY"; require MIME::Base64; my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), ""); $b =~ s/[\W]/X/g; # ensure alnum only $b; } 1; =pod =encoding UTF-8 =head1 NAME HTTP::Request::Common - Construct common HTTP::Request objects =head1 VERSION version 6.36 =head1 SYNOPSIS use HTTP::Request::Common; $ua = LWP::UserAgent->new; $ua->request(GET 'http://www.sn.no/'); $ua->request(POST 'http://somewhere/foo', foo => bar, bar => foo); $ua->request(PATCH 'http://somewhere/foo', foo => bar, bar => foo); $ua->request(PUT 'http://somewhere/foo', foo => bar, bar => foo); $ua->request(OPTIONS 'http://somewhere/foo', foo => bar, bar => foo); =head1 DESCRIPTION This module provides functions that return newly created C objects. These functions are usually more convenient to use than the standard C constructor for the most common requests. Note that L has several convenience methods, including C, C, C, C and C. The following functions are provided: =over 4 =item GET $url =item GET $url, Header => Value,... The C function returns an L object initialized with the "GET" method and the specified URL. It is roughly equivalent to the following call HTTP::Request->new( GET => $url, HTTP::Headers->new(Header => Value,...), ) but is less cluttered. What is different is that a header named C will initialize the content part of the request instead of setting a header field. Note that GET requests should normally not have a content, so this hack makes more sense for the C, C and C functions described below. The C method of L exists as a shortcut for C<< $ua->request(GET ...) >>. =item HEAD $url =item HEAD $url, Header => Value,... Like GET() but the method in the request is "HEAD". The C method of L exists as a shortcut for C<< $ua->request(HEAD ...) >>. =item DELETE $url =item DELETE $url, Header => Value,... Like C but the method in the request is C. This function is not exported by default. =item PATCH $url =item PATCH $url, Header => Value,... =item PATCH $url, $form_ref, Header => Value,... =item PATCH $url, Header => Value,..., Content => $form_ref =item PATCH $url, Header => Value,..., Content => $content The same as C below, but the method in the request is C. =item PUT $url =item PUT $url, Header => Value,... =item PUT $url, $form_ref, Header => Value,... =item PUT $url, Header => Value,..., Content => $form_ref =item PUT $url, Header => Value,..., Content => $content The same as C below, but the method in the request is C =item OPTIONS $url =item OPTIONS $url, Header => Value,... =item OPTIONS $url, $form_ref, Header => Value,... =item OPTIONS $url, Header => Value,..., Content => $form_ref =item OPTIONS $url, Header => Value,..., Content => $content The same as C below, but the method in the request is C =item POST $url =item POST $url, Header => Value,... =item POST $url, $form_ref, Header => Value,... =item POST $url, Header => Value,..., Content => $form_ref =item POST $url, Header => Value,..., Content => $content C, C and C all work with the same parameters. %data = ( title => 'something', body => something else' ); $ua = LWP::UserAgent->new(); $request = HTTP::Request::Common::POST( $url, [ %data ] ); $response = $ua->request($request); They take a second optional array or hash reference parameter C<$form_ref>. The content can also be specified directly using the C pseudo-header, and you may also provide the C<$form_ref> this way. The C pseudo-header steals a bit of the header field namespace as there is no way to directly specify a header that is actually called "Content". If you really need this you must update the request returned in a separate statement. The C<$form_ref> argument can be used to pass key/value pairs for the form content. By default we will initialize a request using the C content type. This means that you can emulate an HTML Eform> POSTing like this: POST 'http://www.perl.org/survey.cgi', [ name => 'Gisle Aas', email => 'gisle@aas.no', gender => 'M', born => '1964', perc => '3%', ]; This will create an L object that looks like this: POST http://www.perl.org/survey.cgi Content-Length: 66 Content-Type: application/x-www-form-urlencoded name=Gisle%20Aas&email=gisle%40aas.no&gender=M&born=1964&perc=3%25 Multivalued form fields can be specified by either repeating the field name or by passing the value as an array reference. The POST method also supports the C content used for I as specified in RFC 1867. You trigger this content format by specifying a content type of C<'form-data'> as one of the request headers. If one of the values in the C<$form_ref> is an array reference, then it is treated as a file part specification with the following interpretation: [ $file, $filename, Header => Value... ] [ undef, $filename, Header => Value,..., Content => $content ] The first value in the array ($file) is the name of a file to open. This file will be read and its content placed in the request. The routine will croak if the file can't be opened. Use an C as $file value if you want to specify the content directly with a C header. The $filename is the filename to report in the request. If this value is undefined, then the basename of the $file will be used. You can specify an empty string as $filename if you want to suppress sending the filename when you provide a $file value. If a $file is provided by no C header, then C and C will be filled in automatically with the values returned by C Sending my F<~/.profile> to the survey used as example above can be achieved by this: POST 'http://www.perl.org/survey.cgi', Content_Type => 'form-data', Content => [ name => 'Gisle Aas', email => 'gisle@aas.no', gender => 'M', born => '1964', init => ["$ENV{HOME}/.profile"], ] This will create an L object that almost looks this (the boundary and the content of your F<~/.profile> is likely to be different): POST http://www.perl.org/survey.cgi Content-Length: 388 Content-Type: multipart/form-data; boundary="6G+f" --6G+f Content-Disposition: form-data; name="name" Gisle Aas --6G+f Content-Disposition: form-data; name="email" gisle@aas.no --6G+f Content-Disposition: form-data; name="gender" M --6G+f Content-Disposition: form-data; name="born" 1964 --6G+f Content-Disposition: form-data; name="init"; filename=".profile" Content-Type: text/plain PATH=/local/perl/bin:$PATH export PATH --6G+f-- If you set the C<$DYNAMIC_FILE_UPLOAD> variable (exportable) to some TRUE value, then you get back a request object with a subroutine closure as the content attribute. This subroutine will read the content of any files on demand and return it in suitable chunks. This allow you to upload arbitrary big files without using lots of memory. You can even upload infinite files like F if you wish; however, if the file is not a plain file, there will be no C header defined for the request. Not all servers (or server applications) like this. Also, if the file(s) change in size between the time the C is calculated and the time that the last chunk is delivered, the subroutine will C. The C method of L exists as a shortcut for C<< $ua->request(POST ...) >>. =back =head1 SEE ALSO L, L Also, there are some examples in L that you might find useful. For example, batch requests are explained there. =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #ABSTRACT: Construct common HTTP::Request objects HTTP-Message-6.36/lib/HTTP/Headers/Auth.pm000644 000765 000024 00000004456 14165326704 020055 0ustar00olafstaff000000 000000 package HTTP::Headers::Auth; use strict; use warnings; our $VERSION = '6.36'; use HTTP::Headers; package HTTP::Headers; BEGIN { # we provide a new (and better) implementations below undef(&www_authenticate); undef(&proxy_authenticate); } require HTTP::Headers::Util; sub _parse_authenticate { my @ret; for (HTTP::Headers::Util::split_header_words(@_)) { if (!defined($_->[1])) { # this is a new auth scheme push(@ret, shift(@$_) => {}); shift @$_; } if (@ret) { # this a new parameter pair for the last auth scheme while (@$_) { my $k = shift @$_; my $v = shift @$_; $ret[-1]{$k} = $v; } } else { # something wrong, parameter pair without any scheme seen # IGNORE } } @ret; } sub _authenticate { my $self = shift; my $header = shift; my @old = $self->_header($header); if (@_) { $self->remove_header($header); my @new = @_; while (@new) { my $a_scheme = shift(@new); if ($a_scheme =~ /\s/) { # assume complete valid value, pass it through $self->push_header($header, $a_scheme); } else { my @param; if (@new) { my $p = $new[0]; if (ref($p) eq "ARRAY") { @param = @$p; shift(@new); } elsif (ref($p) eq "HASH") { @param = %$p; shift(@new); } } my $val = ucfirst(lc($a_scheme)); if (@param) { my $sep = " "; while (@param) { my $k = shift @param; my $v = shift @param; if ($v =~ /[^0-9a-zA-Z]/ || lc($k) eq "realm") { # must quote the value $v =~ s,([\\\"]),\\$1,g; $v = qq("$v"); } $val .= "$sep$k=$v"; $sep = ", "; } } $self->push_header($header, $val); } } } return unless defined wantarray; wantarray ? _parse_authenticate(@old) : join(", ", @old); } sub www_authenticate { shift->_authenticate("WWW-Authenticate", @_) } sub proxy_authenticate { shift->_authenticate("Proxy-Authenticate", @_) } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTTP::Headers::Auth =head1 VERSION version 6.36 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Message-6.36/lib/HTTP/Headers/Util.pm000644 000765 000024 00000011740 14165326704 020063 0ustar00olafstaff000000 000000 package HTTP::Headers::Util; use strict; use warnings; our $VERSION = '6.36'; use Exporter 5.57 'import'; our @EXPORT_OK=qw(split_header_words _split_header_words join_header_words); sub split_header_words { my @res = &_split_header_words; for my $arr (@res) { for (my $i = @$arr - 2; $i >= 0; $i -= 2) { $arr->[$i] = lc($arr->[$i]); } } return @res; } sub _split_header_words { my(@val) = @_; my @res; for (@val) { my @cur; while (length) { if (s/^\s*(=*[^\s=;,]+)//) { # 'token' or parameter 'attribute' push(@cur, $1); # a quoted value if (s/^\s*=\s*\"([^\"\\]*(?:\\.[^\"\\]*)*)\"//) { my $val = $1; $val =~ s/\\(.)/$1/g; push(@cur, $val); # some unquoted value } elsif (s/^\s*=\s*([^;,\s]*)//) { my $val = $1; $val =~ s/\s+$//; push(@cur, $val); # no value, a lone token } else { push(@cur, undef); } } elsif (s/^\s*,//) { push(@res, [@cur]) if @cur; @cur = (); } elsif (s/^\s*;// || s/^\s+// || s/^=//) { # continue } else { die "This should not happen: '$_'"; } } push(@res, \@cur) if @cur; } @res; } sub join_header_words { @_ = ([@_]) if @_ && !ref($_[0]); my @res; for (@_) { my @cur = @$_; my @attr; while (@cur) { my $k = shift @cur; my $v = shift @cur; if (defined $v) { if ($v =~ /[\x00-\x20()<>@,;:\\\"\/\[\]?={}\x7F-\xFF]/ || !length($v)) { $v =~ s/([\"\\])/\\$1/g; # escape " and \ $k .= qq(="$v"); } else { # token $k .= "=$v"; } } push(@attr, $k); } push(@res, join("; ", @attr)) if @attr; } join(", ", @res); } 1; =pod =encoding UTF-8 =head1 NAME HTTP::Headers::Util - Header value parsing utility functions =head1 VERSION version 6.36 =head1 SYNOPSIS use HTTP::Headers::Util qw(split_header_words); @values = split_header_words($h->header("Content-Type")); =head1 DESCRIPTION This module provides a few functions that helps parsing and construction of valid HTTP header values. None of the functions are exported by default. The following functions are available: =over 4 =item split_header_words( @header_values ) This function will parse the header values given as argument into a list of anonymous arrays containing key/value pairs. The function knows how to deal with ",", ";" and "=" as well as quoted values after "=". A list of space separated tokens are parsed as if they were separated by ";". If the @header_values passed as argument contains multiple values, then they are treated as if they were a single value separated by comma ",". This means that this function is useful for parsing header fields that follow this syntax (BNF as from the HTTP/1.1 specification, but we relax the requirement for tokens). headers = #header header = (token | parameter) *( [";"] (token | parameter)) token = 1* separators = "(" | ")" | "<" | ">" | "@" | "," | ";" | ":" | "\" | <"> | "/" | "[" | "]" | "?" | "=" | "{" | "}" | SP | HT quoted-string = ( <"> *(qdtext | quoted-pair ) <"> ) qdtext = > quoted-pair = "\" CHAR parameter = attribute "=" value attribute = token value = token | quoted-string Each I
is represented by an anonymous array of key/value pairs. The keys will be all be forced to lower case. The value for a simple token (not part of a parameter) is C. Syntactically incorrect headers will not necessarily be parsed as you would want. This is easier to describe with some examples: split_header_words('foo="bar"; port="80,81"; DISCARD, BAR=baz'); split_header_words('text/html; charset="iso-8859-1"'); split_header_words('Basic realm="\\"foo\\\\bar\\""'); will return [foo=>'bar', port=>'80,81', discard=> undef], [bar=>'baz' ] ['text/html' => undef, charset => 'iso-8859-1'] [basic => undef, realm => "\"foo\\bar\""] If you don't want the function to convert tokens and attribute keys to lower case you can call it as C<_split_header_words> instead (with a leading underscore). =item join_header_words( @arrays ) This will do the opposite of the conversion done by split_header_words(). It takes a list of anonymous arrays as arguments (or a list of key/value pairs) and produces a single header value. Attribute values are quoted if needed. Example: join_header_words(["text/plain" => undef, charset => "iso-8859/1"]); join_header_words("text/plain" => undef, charset => "iso-8859/1"); will both return the string: text/plain; charset="iso-8859/1" =back =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #ABSTRACT: Header value parsing utility functions HTTP-Message-6.36/lib/HTTP/Headers/ETag.pm000644 000765 000024 00000004766 14165326704 020000 0ustar00olafstaff000000 000000 package HTTP::Headers::ETag; use strict; use warnings; our $VERSION = '6.36'; require HTTP::Date; require HTTP::Headers; package HTTP::Headers; sub _etags { my $self = shift; my $header = shift; my @old = _split_etag_list($self->_header($header)); if (@_) { $self->_header($header => join(", ", _split_etag_list(@_))); } wantarray ? @old : join(", ", @old); } sub etag { shift->_etags("ETag", @_); } sub if_match { shift->_etags("If-Match", @_); } sub if_none_match { shift->_etags("If-None-Match", @_); } sub if_range { # Either a date or an entity-tag my $self = shift; my @old = $self->_header("If-Range"); if (@_) { my $new = shift; if (!defined $new) { $self->remove_header("If-Range"); } elsif ($new =~ /^\d+$/) { $self->_date_header("If-Range", $new); } else { $self->_etags("If-Range", $new); } } return unless defined(wantarray); for (@old) { my $t = HTTP::Date::str2time($_); $_ = $t if $t; } wantarray ? @old : join(", ", @old); } # Split a list of entity tag values. The return value is a list # consisting of one element per entity tag. Suitable for parsing # headers like C, C. You might even want to # use it on C and C entity tag values, because it will # normalize them to the common form. # # entity-tag = [ weak ] opaque-tag # weak = "W/" # opaque-tag = quoted-string sub _split_etag_list { my(@val) = @_; my @res; for (@val) { while (length) { my $weak = ""; $weak = "W/" if s,^\s*[wW]/,,; my $etag = ""; if (s/^\s*(\"[^\"\\]*(?:\\.[^\"\\]*)*\")//) { push(@res, "$weak$1"); } elsif (s/^\s*,//) { push(@res, qq(W/"")) if $weak; } elsif (s/^\s*([^,\s]+)//) { $etag = $1; $etag =~ s/([\"\\])/\\$1/g; push(@res, qq($weak"$etag")); } elsif (s/^\s+// || !length) { push(@res, qq(W/"")) if $weak; } else { die "This should not happen: '$_'"; } } } @res; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTTP::Headers::ETag =head1 VERSION version 6.36 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP-Message-6.36/xt/author/000755 000765 000024 00000000000 14165326704 015642 5ustar00olafstaff000000 000000 HTTP-Message-6.36/xt/release/000755 000765 000024 00000000000 14165326704 015760 5ustar00olafstaff000000 000000 HTTP-Message-6.36/xt/release/changes_has_content.t000644 000765 000024 00000002534 14165326704 022146 0ustar00olafstaff000000 000000 use Test::More tests => 2; if (($ENV{TRAVIS_PULL_REQUEST} || '') eq 'false') { chomp(my $branch_name = ($ENV{TRAVIS_BRANCH} || `git rev-parse --abbrev-ref HEAD`)); $TODO = 'Changes need not have content for this release yet if this is only the master branch' if ($branch_name || '') eq 'master'; } note 'Checking Changes'; my $changes_file = 'Changes'; my $newver = '6.36'; my $trial_token = '-TRIAL'; my $encoding = 'UTF-8'; SKIP: { ok(-e $changes_file, "$changes_file file exists") or skip 'Changes is missing', 1; ok(_get_changes($newver), "$changes_file has content for $newver"); } done_testing; sub _get_changes { my $newver = shift; # parse changelog to find commit message open(my $fh, '<', $changes_file) or die "cannot open $changes_file: $!"; my $changelog = join('', <$fh>); if ($encoding) { require Encode; $changelog = Encode::decode($encoding, $changelog, Encode::FB_CROAK()); } close $fh; my @content = grep { /^$newver(?:$trial_token)?(?:\s+|$)/ ... /^\S/ } # from newver to un-indented split /\n/, $changelog; shift @content; # drop the version line # drop unindented last line and trailing blank lines pop @content while ( @content && $content[-1] =~ /^(?:\S|\s*$)/ ); # return number of non-blank lines return scalar @content; } HTTP-Message-6.36/xt/release/cpan-changes.t000644 000765 000024 00000000344 14165326704 020475 0ustar00olafstaff000000 000000 use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::CPAN::Changes 0.012 use Test::More 0.96 tests => 1; use Test::CPAN::Changes; subtest 'changes_ok' => sub { changes_file_ok('Changes'); }; HTTP-Message-6.36/xt/author/mojibake.t000644 000765 000024 00000000151 14165326704 017605 0ustar00olafstaff000000 000000 #!perl use strict; use warnings qw(all); use Test::More; use Test::Mojibake; all_files_encoding_ok(); HTTP-Message-6.36/xt/author/test-version.t000644 000765 000024 00000000637 14165326704 020477 0ustar00olafstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.09 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 0, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; HTTP-Message-6.36/xt/author/00-compile.t000644 000765 000024 00000003112 14165326704 017671 0ustar00olafstaff000000 000000 use 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More 0.94; plan tests => 11; my @module_files = ( 'HTTP/Config.pm', 'HTTP/Headers.pm', 'HTTP/Headers/Auth.pm', 'HTTP/Headers/ETag.pm', 'HTTP/Headers/Util.pm', 'HTTP/Message.pm', 'HTTP/Request.pm', 'HTTP/Request/Common.pm', 'HTTP/Response.pm', 'HTTP/Status.pm' ); # no fake home requested my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', explain(\@warnings); BAIL_OUT("Compilation problems") if !Test::More->builder->is_passing; HTTP-Message-6.36/xt/author/pod-syntax.t000644 000765 000024 00000000252 14165326704 020134 0ustar00olafstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); HTTP-Message-6.36/xt/author/portability.t000644 000765 000024 00000000267 14165326704 020376 0ustar00olafstaff000000 000000 use strict; use warnings; use Test::More; eval 'use Test::Portability::Files'; plan skip_all => 'Test::Portability::Files required for testing portability' if $@; run_tests(); HTTP-Message-6.36/t/common-req.t000644 000765 000024 00000016004 14165326704 016413 0ustar00olafstaff000000 000000 use strict; use warnings; use Test::More; plan tests => 71; use File::Spec; use File::Temp qw(tempfile); use HTTP::Request::Common; my $r = GET 'http://www.sn.no/'; note $r->as_string; is($r->method, "GET"); is($r->uri, "http://www.sn.no/"); $r = HEAD "http://www.sn.no/", If_Match => 'abc', From => 'aas@sn.no'; note $r->as_string; is($r->method, "HEAD"); ok($r->uri->eq("http://www.sn.no")); is($r->header('If-Match'), "abc"); is($r->header("from"), "aas\@sn.no"); $r = HEAD "http://www.sn.no/", Content => 'foo'; is($r->content, 'foo'); $r = HEAD "http://www.sn.no/", Content => 'foo', 'Content-Length' => 50; is($r->content, 'foo'); is($r->content_length, 50); $r = PUT "http://www.sn.no", Content => 'foo'; note $r->as_string, "\n"; is($r->method, "PUT"); is($r->uri->host, "www.sn.no"); ok(!defined($r->header("Content"))); is(${$r->content_ref}, "foo"); is($r->content, "foo"); is($r->content_length, 3); $r = PUT "http://www.sn.no", { foo => "bar" }; is($r->content, "foo=bar"); $r = OPTIONS "http://www.sn.no", Content => 'foo'; note $r->as_string, "\n"; is($r->method, "OPTIONS"); is($r->uri->host, "www.sn.no"); ok(!defined($r->header("Content"))); is(${$r->content_ref}, "foo"); is($r->content, "foo"); is($r->content_length, 3); $r = OPTIONS "http://www.sn.no", { foo => "bar" }; is($r->content, "foo=bar"); $r = PATCH "http://www.sn.no", { foo => "bar" }; is($r->content, "foo=bar"); #--- Test POST requests --- $r = POST "http://www.sn.no", [foo => 'bar;baz', baz => [qw(a b c)], foo => 'zoo=&', "space " => " + ", "nl" => "a\nb\r\nc\n", ], bar => 'foo'; note $r->as_string, "\n"; is($r->method, "POST"); is($r->content_type, "application/x-www-form-urlencoded"); is($r->content_length, 83); is($r->header("bar"), "foo"); is($r->content, "foo=bar%3Bbaz&baz=a&baz=b&baz=c&foo=zoo%3D%26&space+=+%2B+&nl=a%0D%0Ab%0D%0Ac%0D%0A"); $r = POST "http://example.com"; is($r->content_length, 0); is($r->content, ""); $r = POST "http://example.com", []; is($r->content_length, 0); is($r->content, ""); $r = POST "mailto:gisle\@aas.no", Subject => "Heisan", Content_Type => "text/plain", Content => "Howdy\n"; #note $r->as_string; is($r->method, "POST"); is($r->header("Subject"), "Heisan"); is($r->content, "Howdy\n"); is($r->content_type, "text/plain"); { my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_ }; $r = POST 'http://unf.ug/', []; is( "@warnings", '', 'empty POST' ); } # # POST for File upload # my (undef, $file) = tempfile(); my $form_file = (File::Spec->splitpath($file))[-1]; open(FILE, ">$file") or die "Can't create $file: $!"; print FILE "foo\nbar\nbaz\n"; close(FILE); $r = POST 'http://www.perl.org/survey.cgi', Content_Type => 'form-data', Content => [ name => 'Gisle Aas', email => 'gisle@aas.no', gender => 'm', born => '1964', file => [$file], ]; #note $r->as_string; unlink($file) or warn "Can't unlink $file: $!"; is($r->method, "POST"); is($r->uri->path, "/survey.cgi"); is($r->content_type, "multipart/form-data"); ok($r->header('Content_type') =~ /boundary="?([^"]+)"?/); my $boundary = $1; my $c = $r->content; $c =~ s/\r//g; my @c = split(/--\Q$boundary/, $c); note "$c[5]\n"; is(@c, 7); like($c[6], qr/^--\n/); # 5 parts + header & trailer ok($c[2] =~ /^Content-Disposition:\s*form-data;\s*name="email"/m); ok($c[2] =~ /^gisle\@aas.no$/m); ok($c[5] =~ /^Content-Disposition:\s*form-data;\s*name="file";\s*filename="$form_file"/m); ok($c[5] =~ /^Content-Type:\s*text\/plain$/m); ok($c[5] =~ /^foo\nbar\nbaz/m); $r = POST 'http://www.perl.org/survey.cgi', [ file => [ undef, "xxy\"", Content_type => "text/html", Content => "

Hello, world!

" ]], Content_type => 'multipart/form-data'; #note $r->as_string; ok($r->content =~ /^--\S+\015\012Content-Disposition:\s*form-data;\s*name="file";\s*filename="xxy\\"/m); ok($r->content =~ /^Content-Type: text\/html/m); ok($r->content =~ /^

Hello, world/m); $r = POST 'http://www.perl.org/survey.cgi', Content_type => 'multipart/form-data', Content => [ file => [ undef, undef, Content => "foo"]]; #note $r->as_string; unlike($r->content, qr/filename=/); # The POST routine can now also take a hash reference. my %hash = (foo => 42, bar => 24); $r = POST 'http://www.perl.org/survey.cgi', \%hash; #note $r->as_string, "\n"; like($r->content, qr/foo=42/); like($r->content, qr/bar=24/); is($r->content_type, "application/x-www-form-urlencoded"); is($r->content_length, 13); # # POST for File upload # use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD); (undef, $file) = tempfile(); open(FILE, ">$file") or die "Can't create $file: $!"; for (1..1000) { print FILE "a" .. "z"; } close(FILE); $DYNAMIC_FILE_UPLOAD++; $r = POST 'http://www.perl.org/survey.cgi', Content_Type => 'form-data', Content => [ name => 'Gisle Aas', email => 'gisle@aas.no', gender => 'm', born => '1964', file => [$file], ]; #note $r->as_string, "\n"; is($r->method, "POST"); is($r->uri->path, "/survey.cgi"); is($r->content_type, "multipart/form-data"); ok($r->header('Content_type') =~ qr/boundary="?([^"]+)"?/); $boundary = $1; is(ref($r->content), "CODE"); cmp_ok(length($boundary), '>', 10); my $code = $r->content; my $chunk; my @chunks; while (defined($chunk = &$code) && length $chunk) { push(@chunks, $chunk); } unlink($file) or warn "Can't unlink $file: $!"; $_ = join("", @chunks); #note int(@chunks), " chunks, total size is ", length($_), " bytes\n"; # should be close to expected size and number of chunks cmp_ok(abs(@chunks - 15), '<', 3); cmp_ok(abs(length($_) - 26589), '<', 20); $r = POST 'http://www.example.com'; is($r->as_string, < 'form-data', Content => []; is($r->as_string, < 'form-data'; #note $r->as_string; is($r->as_string, <method, "DELETE"); $r = HTTP::Request::Common::PUT 'http://www.example.com', 'Content-Type' => 'application/octet-steam', 'Content' => 'foobarbaz', 'Content-Length' => 12; # a slight lie is($r->header('Content-Length'), 9); $r = HTTP::Request::Common::PATCH 'http://www.example.com', 'Content-Type' => 'application/octet-steam', 'Content' => 'foobarbaz', 'Content-Length' => 12; # a slight lie is($r->header('Content-Length'), 9); HTTP-Message-6.36/t/message-old.t000644 000765 000024 00000005122 14165326704 016535 0ustar00olafstaff000000 000000 # This is the old message.t test. It is not maintained any more, # but kept around in case it happens to catch any mistakes. Please # add new tests to message.t instead. use strict; use warnings; use Test::More; plan tests => 20; require HTTP::Request; require HTTP::Response; require Time::Local if $^O eq "MacOS"; my $offset = ($^O eq "MacOS") ? Time::Local::timegm(0,0,0,1,0,1970) : 0; my $req = HTTP::Request->new(GET => "http://www.sn.no/"); $req->header( "if-modified-since" => "Thu, 03 Feb 1994 00:00:00 GMT", "mime-version" => "1.0"); ok($req->as_string =~ /^GET/m); is($req->header("MIME-Version"), "1.0"); is($req->if_modified_since, ((760233600 + $offset) || 0)); $req->content("gisle"); $req->add_content(" aas"); $req->add_content(\ " old interface is depreciated"); ${$req->content_ref} =~ s/\s+is\s+depreciated//; is($req->content, "gisle aas old interface"); my $time = time; $req->date($time); my $timestr = gmtime($time); my($month) = ($timestr =~ /^\S+\s+(\S+)/); # extract month; #print "These should represent the same time:\n\t", $req->header('Date'), "\n\t$timestr\n"; like($req->header('Date'), qr/\Q$month/); $req->authorization_basic("gisle", "passwd"); is($req->header("Authorization"), "Basic Z2lzbGU6cGFzc3dk"); my($user, $pass) = $req->authorization_basic; is($user, "gisle"); is($pass, "passwd"); # Check the response my $res = HTTP::Response->new(200, "This message"); ok($res->is_success); my $html = $res->error_as_HTML; ok($html =~ //i && $html =~ /This message/); $res->content_type("text/html;version=3.0"); $res->content("...\n"); my $res2 = $res->clone; is($res2->code, 200); is($res2->header("cOntent-TYPE"), "text/html;version=3.0"); like($res2->content, qr/>\.\.\.new(200, "This message"); is($res->base, undef); $res->request($req); $res->content_type("image/gif"); is($res->base, "http://www.sn.no/"); $res->header('Base', 'http://www.sn.no/xxx/'); is($res->base, "http://www.sn.no/xxx/"); # Check the AUTLOAD delegate method with regular expressions "This string contains text/html" =~ /(\w+\/\w+)/; $res->content_type($1); is($res->content_type, "text/html"); # Check what happens when passed a new URI object require URI; $req = HTTP::Request->new(GET => URI->new("http://localhost")); is($req->uri, "http://localhost"); $req = HTTP::Request->new(GET => "http://www.example.com", [ Foo => 1, bar => 2 ], "FooBar\n"); is($req->as_string, <clear; is($req->as_string, < 68; use HTTP::Date; use HTTP::Request; use HTTP::Response; # make sure we get no failures from undefined response values { my $req = HTTP::Response->new(); is($req->is_success(), undef, 'Empty res: is_success'); is($req->is_info(), undef, 'Empty res: is_info'); is($req->is_redirect(), undef, 'Empty res: is_redirect'); is($req->is_error(), undef, 'Empty res: is_error'); is($req->is_client_error(), undef, 'Empty res: is_client_error'); is($req->is_server_error(), undef, 'Empty res: is_server_error'); is($req->filename(), undef, 'Empty res: filename'); } my $time = time; my $req = HTTP::Request->new(GET => 'http://www.sn.no'); $req->date($time - 30); my $r = HTTP::Response->new(200, "OK"); $r->client_date($time - 20); $r->date($time - 25); $r->last_modified($time - 5000000); $r->request($req); #print $r->as_string; my $current_age = $r->current_age; ok($current_age >= 35 && $current_age <= 40); my $freshness_lifetime = $r->freshness_lifetime; ok($freshness_lifetime >= 12 * 3600); is($r->freshness_lifetime(heuristic_expiry => 0), undef); my $is_fresh = $r->is_fresh; ok($is_fresh); is($r->is_fresh(heuristic_expiry => 0), undef); print "# current_age = $current_age\n"; print "# freshness_lifetime = $freshness_lifetime\n"; print "# response is "; print " not " unless $is_fresh; print "fresh\n"; print "# it will be fresh for "; print $freshness_lifetime - $current_age; print " more seconds\n"; # OK, now we add an Expires header $r->expires($time); print "\n", $r->dump(prefix => "# "); $freshness_lifetime = $r->freshness_lifetime; is($freshness_lifetime, 25); $r->remove_header('expires'); # Now we try the 'Age' header and the Cache-Contol: $r->header('Age', 300); $r->push_header('Cache-Control', 'junk'); $r->push_header(Cache_Control => 'max-age = 10'); #print $r->as_string; $current_age = $r->current_age; $freshness_lifetime = $r->freshness_lifetime; print "# current_age = $current_age\n"; print "# freshness_lifetime = $freshness_lifetime\n"; ok($current_age >= 300); is($freshness_lifetime, 10); ok($r->fresh_until); # should return something ok($r->fresh_until(heuristic_expiry => 0)); # should return something my $r2 = HTTP::Response->parse($r->as_string( "\x0d\x0a")); is( $r2->message(), 'OK', 'message() returns as expected' ); my @h = $r2->header('Cache-Control'); is(@h, 2); $r->remove_header("Cache-Control"); ok($r->fresh_until); # should still return something is($r->fresh_until(heuristic_expiry => 0), undef); is($r->redirects, 0); $r->previous($r2); is($r->previous, $r2); is($r->redirects, 1); $r2->previous($r->clone); is($r->redirects, 2); for ($r->redirects) { ok($_->is_success); } is($r->base, $r->request->uri); $r->push_header("Content-Location", "/1/A/a"); is($r->base, "http://www.sn.no/1/A/a"); $r->push_header("Content-Base", "/2/;a=/foo/bar"); is($r->base, "http://www.sn.no/2/;a=/foo/bar"); $r->push_header("Content-Base", "/3/"); is($r->base, "http://www.sn.no/2/;a=/foo/bar"); { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; local $^W = 0; $r2 = HTTP::Response->parse( undef ); is($#warn, -1); local $^W = 1; $r2 = HTTP::Response->parse( undef ); is($#warn, 0); like($warn[0], qr/Undefined argument to parse\(\)/); } is($r2->code, undef); is($r2->message, undef); is($r2->protocol, undef); is($r2->status_line, "000 Unknown code"); $r2->protocol('HTTP/1.0'); is($r2->as_string("\n"), "HTTP/1.0 000 Unknown code\n\n"); is($r2->dump, "HTTP/1.0 000 Unknown code\n\n(no content)\n"); is($r2->current_age, 0); is($r2->freshness_lifetime, 3600); is($r2->freshness_lifetime(h_default => 900), 900); is($r2->freshness_lifetime(h_min => 7200), 7200); is($r2->freshness_lifetime(time => time), 3600); $r2->last_modified(time - 900); is($r2->freshness_lifetime, 90); is($r2->freshness_lifetime(h_lastmod_fraction => 0.2), 180); is($r2->freshness_lifetime(h_min => 300), 300); $r2->last_modified(time - 1000000); is($r2->freshness_lifetime(h_max => 7200), 7200); is($r2->freshness_lifetime(heuristic_expiry => 0), undef); is($r2->freshness_lifetime(heuristic_expiry => 1), 86400); ok($r2->is_fresh(time => time)); ok($r2->fresh_until(time => time + 10)); $r2->client_date(1); cmp_ok(abs(time - $r2->current_age), '<', 10); # Allow 10s for slow boxes is($r2->freshness_lifetime, 60); $r2->date(time); $r2->header(Age => -1); cmp_ok(abs(time - $r2->current_age), '<', 10); # Allow 10s for slow boxes is($r2->freshness_lifetime, 86400); $req = HTTP::Request->new; $r2->request($req); cmp_ok(abs(time - $r2->current_age), '<', 10); # Allow 10s for slow boxes $req->date(2); $r2->request($req); cmp_ok(abs(time - $r2->current_age), '<', 10); # Allow 10s for slow boxes $r2->header ('Content-Disposition' => "attachment; filename=foo.txt\n"); is($r2->filename(), 'foo.txt'); $r2->header ('Content-Disposition' => "attachment; filename=\n"); is($r2->filename(), ''); $r2->header ('Content-Disposition' => "attachment\n"); is($r2->filename(), undef); $r2->header ('Content-Disposition' => "attachment; filename==?US-ASCII?B?Zm9vLnR4dA==?=\n"); is($r2->filename(), 'foo.txt'); $r2->header ('Content-Disposition' => "attachment; filename==?NOT-A-CHARSET?B?Zm9vLnR4dA==?=\n"); is($r2->filename(), '=?NOT-A-CHARSET?B?Zm9vLnR4dA==?='); $r2->header ('Content-Disposition' => "attachment; filename==?US-ASCII?Z?Zm9vLnR4dA==?=\n"); is($r2->filename(), '=?US-ASCII?Z?Zm9vLnR4dA==?='); $r2->header ('Content-Disposition' => "attachment; filename==?US-ASCII?Q?foo.txt?=\n"); is($r2->filename(), 'foo.txt'); $r2->remove_header ('Content-Disposition'); $r2->header ('Content-Location' => '/tmp/baz.txt'); is($r2->filename(), 'baz.txt'); $r2->remove_header ('Content-Location'); $req->uri('http://www.example.com/bar.txt'); is($r2->filename(), 'bar.txt'); HTTP-Message-6.36/t/status.t000644 000765 000024 00000002647 14165326704 015671 0ustar00olafstaff000000 000000 use strict; use warnings; use Test::More; plan tests => 49; use HTTP::Status qw(:constants :is status_message); is(HTTP_OK, 200); ok(is_info(HTTP_CONTINUE)); ok(is_success(HTTP_ACCEPTED)); ok(is_error(HTTP_BAD_REQUEST)); ok(is_client_error(HTTP_I_AM_A_TEAPOT)); ok(is_redirect(HTTP_MOVED_PERMANENTLY)); ok(is_redirect(HTTP_PERMANENT_REDIRECT)); # renamed status constants ok(is_error(HTTP_REQUEST_ENTITY_TOO_LARGE)); ok(is_error(HTTP_PAYLOAD_TOO_LARGE)); ok(is_error(HTTP_REQUEST_URI_TOO_LARGE)); ok(is_error(HTTP_URI_TOO_LONG)); ok(is_error(HTTP_REQUEST_RANGE_NOT_SATISFIABLE)); ok(is_error(HTTP_RANGE_NOT_SATISFIABLE)); ok(is_error(HTTP_NO_CODE)); ok(is_error(HTTP_UNORDERED_COLLECTION)); ok(is_error(HTTP_TOO_EARLY)); ok(!is_success(HTTP_NOT_FOUND)); is(status_message( 0), undef); is(status_message(200), "OK"); is(status_message(404), "Not Found"); is(status_message(999), undef); ok(!is_info(HTTP_NOT_FOUND)); ok(!is_success(HTTP_NOT_FOUND)); ok(!is_redirect(HTTP_NOT_FOUND)); ok(!is_error(HTTP_CONTINUE)); ok(!is_client_error(HTTP_CONTINUE)); ok(!is_server_error(HTTP_NOT_FOUND)); ok(!is_server_error(999)); ok(!is_info(99)); ok(!is_success(99)); ok(!is_redirect(99)); ok(is_cacheable_by_default($_), "Cacheable by default [$_] " . status_message($_) ) for (200,203,204,206,300,301,308,404,405,410,414,451,501); ok(!is_cacheable_by_default($_), "... is not cacheable [$_] " . status_message($_) ) for (100,201,302,400,500); HTTP-Message-6.36/t/headers-etag.t000644 000765 000024 00000001311 14165326704 016662 0ustar00olafstaff000000 000000 use strict; use warnings; use Test::More; plan tests => 11; require HTTP::Headers::ETag; my $h = HTTP::Headers->new; $h->etag("tag1"); is($h->etag, qq("tag1")); $h->etag("w/tag2"); is($h->etag, qq(W/"tag2")); $h->etag(" w/, weaktag"); is($h->etag, qq(W/"", "weaktag")); my @list = $h->etag; is_deeply(\@list, ['W/""', '"weaktag"']); $h->etag(" w/"); is($h->etag, qq(W/"")); $h->etag(" "); is($h->etag, ""); $h->if_match(qq(W/"foo", bar, baz), "bar"); $h->if_none_match(333); $h->if_range("tag3"); is($h->if_range, qq("tag3")); my $t = time; $h->if_range($t); is($h->if_range, $t); note $h->as_string; @list = $h->if_range; is($#list, 0); is($list[0], $t); $h->if_range(undef); is($h->if_range, ''); HTTP-Message-6.36/t/message-decode-xml.t000644 000765 000024 00000001666 14165326704 020011 0ustar00olafstaff000000 000000 # https://rt.cpan.org/Public/Bug/Display.html?id=52572 use strict; use warnings; use Test::More; plan tests => 2; use Encode qw( encode ); use HTTP::Headers qw( ); use HTTP::Response qw( ); use PerlIO::encoding qw( ); { my $builder = Test::More->builder; local $PerlIO::encoding::fallback = Encode::PERLQQ(); binmode $builder->output, ":encoding(US-ASCII)"; binmode $builder->failure_output, ":encoding(US-ASCII)"; binmode $builder->todo_output, ":encoding(US-ASCII)"; } for my $enc (qw( UTF-8 UTF-16le )) { my $file = encode($enc, ($enc =~ /^UTF-/ ? "\x{FEFF}" : "") . qq{\n} . qq{\x{C9}ric\n} ); my $headers = HTTP::Headers->new(Content_Type => "application/xml"); my $response = HTTP::Response->new(200, "OK", $headers, $file); is($response->decoded_content, qq(\n\x{c9}ric\n), $enc); } HTTP-Message-6.36/t/message.t000644 000765 000024 00000034337 14165326704 015773 0ustar00olafstaff000000 000000 #! perl -w use strict; use warnings; use Test::More; plan tests => 208; require HTTP::Message; use Config qw(%Config); my($m, $m2, @parts); $m = HTTP::Message->new; ok($m); is(ref($m), "HTTP::Message"); is(ref($m->headers), "HTTP::Headers"); is($m->as_string, "\n"); is($m->headers->as_string, ""); is($m->headers_as_string, ""); is($m->content, ""); $m->header("Foo", 1); is($m->as_string, "Foo: 1\n\n"); { # A message with an undef set content # will stay consistent and have empty string # as a content my $m = HTTP::Message->new(); $m->content(undef); is($m->as_string, "\n"); is($m->content, ""); } $m2 = HTTP::Message->new($m->headers); $m2->header(bar => 2); is($m->as_string, "Foo: 1\n\n"); is($m2->as_string, "Bar: 2\nFoo: 1\n\n"); is($m2->dump, "Bar: 2\nFoo: 1\n\n(no content)\n"); is($m2->dump(no_content => ""), "Bar: 2\nFoo: 1\n\n\n"); is($m2->dump(no_content => "-"), "Bar: 2\nFoo: 1\n\n-\n"); $m2->content('0'); is($m2->dump(no_content => "-"), "Bar: 2\nFoo: 1\n\n0\n"); is($m2->dump(no_content => "0"), "Bar: 2\nFoo: 1\n\n\\x30\n"); $m2 = HTTP::Message->new($m->headers, "foo"); is($m2->as_string, "Foo: 1\n\nfoo\n"); is($m2->as_string("<<\n"), "Foo: 1<<\n<<\nfoo"); $m2 = HTTP::Message->new($m->headers, "foo\n"); is($m2->as_string, "Foo: 1\n\nfoo\n"); $m = HTTP::Message->new([a => 1, b => 2], "abc"); is($m->as_string, "A: 1\nB: 2\n\nabc\n"); $m = HTTP::Message->parse(""); is($m->as_string, "\n"); $m = HTTP::Message->parse("\n"); is($m->as_string, "\n"); $m = HTTP::Message->parse("\n\n"); is($m->as_string, "\n\n"); is($m->content, "\n"); $m = HTTP::Message->parse("foo"); is($m->as_string, "\nfoo\n"); $m = HTTP::Message->parse("foo: 1"); is($m->as_string, "Foo: 1\n\n"); $m = HTTP::Message->parse("foo_bar: 1"); is($m->as_string, "Foo_bar: 1\n\n"); $m = HTTP::Message->parse("foo: 1\n\nfoo"); is($m->as_string, "Foo: 1\n\nfoo\n"); $m = HTTP::Message->parse(<as_string, <parse(<content(""), <as_string, <parse(" abc\nfoo: 1\n"); is($m->as_string, "\n abc\nfoo: 1\n"); $m = HTTP::Message->parse(" foo : 1\n"); is($m->as_string, "\n foo : 1\n"); $m = HTTP::Message->parse("\nfoo: bar\n"); is($m->as_string, "\nfoo: bar\n"); $m = HTTP::Message->new([a => 1, b => 2], "abc"); is($m->content("foo\n"), "abc"); is($m->content, "foo\n"); $m->add_content("bar"); is($m->content, "foo\nbar"); $m->add_content(\"\n"); is($m->content, "foo\nbar\n"); is(ref($m->content_ref), "SCALAR"); is(${$m->content_ref}, "foo\nbar\n"); ${$m->content_ref} =~ s/[ao]/i/g; is($m->content, "fii\nbir\n"); $m->clear; is($m->headers->header_field_names, 0); is($m->content, ""); is($m->parts, undef); $m->parts(HTTP::Message->new, HTTP::Message->new([a => 1], "foo"), HTTP::Message->new(undef, "bar\n"), ); is($m->parts->as_string, "\n"); my $str = $m->as_string; $str =~ s/\r//g; is($str, < --xYzZY A: 1 foo --xYzZY bar --xYzZY-- EOT $m2 = HTTP::Message->new; $m2->parts($m); $str = $m2->as_string; $str =~ s/\r//g; ok($str =~ /boundary=(\S+)/); is($str, < Content-Type: multipart/mixed; boundary=xYzZY --xYzZY --xYzZY A: 1 foo --xYzZY bar --xYzZY-- --$1-- EOT @parts = $m2->parts; is(@parts, 1); @parts = $parts[0]->parts; is(@parts, 3); is($parts[1]->header("A"), 1); $m2->parts([HTTP::Message->new]); @parts = $m2->parts; is(@parts, 1); $m2->parts([]); @parts = $m2->parts; is(@parts, 0); $m->clear; $m2->clear; $m = HTTP::Message->new([content_type => "message/http; boundary=aaa", ], <parts; is(@parts, 1); $m2 = $parts[0]; is(ref($m2), "HTTP::Request"); is($m2->method, "GET"); is($m2->uri, "/"); is($m2->protocol, "HTTP/1.1"); is($m2->header("Host"), "www.example.com:8008"); is($m2->content, ""); $m->content(<parts; is(ref($m2), "HTTP::Response"); is($m2->protocol, "HTTP/1.0"); is($m2->code, "200"); is($m2->message, "OK"); is($m2->content_type, "text/plain"); is($m2->content, "Hello\n"); eval { $m->parts(HTTP::Message->new, HTTP::Message->new) }; ok($@); $m->add_part(HTTP::Message->new([a=>[1..3]], "a")); $str = $m->as_string; $str =~ s/\r//g; is($str, < Content-Type: message/http; boundary=aaa HTTP/1.0 200 OK Content-Type: text/plain Hello --xYzZY A: 1 A: 2 A: 3 a --xYzZY-- EOT $m->add_part(HTTP::Message->new([b=>[1..3]], "b")); $str = $m->as_string; $str =~ s/\r//g; is($str, < Content-Type: message/http; boundary=aaa HTTP/1.0 200 OK Content-Type: text/plain Hello --xYzZY A: 1 A: 2 A: 3 a --xYzZY B: 1 B: 2 B: 3 b --xYzZY-- EOT $m = HTTP::Message->new; $m->add_part(HTTP::Message->new([a=>[1..3]], "a")); is($m->header("Content-Type"), "multipart/mixed; boundary=xYzZY"); $str = $m->as_string; $str =~ s/\r//g; is($str, < A: 1 A: 2 A: 3 a --xYzZY-- EOT $m = HTTP::Message->new(['Content-Type' => 'multipart/mixed']); $m->add_part(HTTP::Message->new([], 'foo and a lot more content')); is($m->header("Content-Type"), "multipart/mixed; boundary=xYzZY"); @parts = $m->parts; is($parts[0]->content, 'foo and a lot more content'); like($parts[0]->dump(maxlength => 4), qr/foo \.\.\./); like($parts[0]->dump(maxlength => 0), qr/foo and a lot/); eval { $m->encode; }; like($@, qr/Can't encode multipart/); $m->content_type('message/http'); eval { $m->encode; }; like($@, qr/Can't encode message/); $m = HTTP::Message->new; $m->content_ref(\my $foo); is($m->content_ref, \$foo); $foo = "foo"; is($m->content, "foo"); $m->add_content("bar"); is($foo, "foobar"); is($m->as_string, "\nfoobar\n"); $m->content_type("message/foo"); $m->parts(HTTP::Message->new(["h", "v"], "C")); is($foo, "H: v\r\n\r\nC"); $foo =~ s/C/c/; $m2 = $m->parts; is($m2->content, "c"); $m = HTTP::Message->new; $foo = []; $m->content($foo); is($m->content, $foo); is(${$m->content_ref}, $foo); is(${$m->content_ref([])}, $foo); isnt($m->content_ref, $foo); eval {$m->add_content("x")}; like($@, qr/^Can't append to ARRAY content/); $foo = sub { "foo" }; $m->content($foo); is($m->content, $foo); is(${$m->content_ref}, $foo); $m->content_ref($foo); is($m->content, $foo); is($m->content_ref, $foo); eval {$m->content_ref("foo")}; like($@, qr/^Setting content_ref to a non-ref/); $m->content_ref(\"foo"); eval {$m->content("bar")}; like($@, qr/^Modification of a read-only value/); $foo = "foo"; $m->content_ref(\$foo); is($m->content("bar"), "foo"); is($foo, "bar"); is($m->content, "bar"); is($m->content_ref, \$foo); $m = HTTP::Message->new; $m->content("fo=6F"); is($m->decoded_content, "fo=6F"); $m->header("Content-Encoding", "quoted-printable"); is($m->decoded_content, "foo"); for my $encoding (qw/gzip x-gzip/) { $m = HTTP::Message->new; $m->header("Content-Encoding", "$encoding, base64"); $m->content_type("text/plain; charset=UTF-8"); $m->content("H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n"); $@ = ""; is(eval { $m->decoded_content }, "\x{FEFF}Hi there \x{263A}\n"); is($@ || "", ""); is($m->content, "H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n"); $m2 = $m->clone; ok($m2->decode); is($m2->header("Content-Encoding"), undef); like($m2->content, qr/Hi there/); ok(grep { $_ eq "$encoding" } $m->decodable); my $tmp = MIME::Base64::decode($m->content); $m->content($tmp); $m->header("Content-Encoding", "$encoding"); $@ = ""; is(eval { $m->decoded_content }, "\x{FEFF}Hi there \x{263A}\n"); is($@ || "", ""); is($m->content, $tmp); my $m2 = HTTP::Message->new([ "Content-Type" => "text/plain", ], "Hi there\n" ); ok($m2->encode($encoding)); is($m2->header("Content-Encoding"), $encoding); unlike($m2->content, qr/Hi there/); is($m2->decoded_content, "Hi there\n"); ok($m2->decode); is($m2->content, "Hi there\n"); } $m->remove_header("Content-Encoding"); $m->content("a\xFF"); is($m->decoded_content, "a\x{FFFD}"); is($m->decoded_content(charset_strict => 1), undef); $m->header("Content-Encoding", "foobar"); is($m->decoded_content, undef); like($@, qr/^Don't know how to decode Content-Encoding 'foobar'/); my $err = 0; eval { $m->decoded_content(raise_error => 1); $err++; }; like($@, qr/Don't know how to decode Content-Encoding 'foobar'/); is($err, 0); eval { HTTP::Message->new([], "\x{263A}"); }; like($@, qr/bytes/); $m = HTTP::Message->new; eval { $m->add_content("\x{263A}"); }; like($@, qr/bytes/); eval { $m->content("\x{263A}"); }; like($@, qr/bytes/); # test the add_content_utf8 method $m = HTTP::Message->new(["Content-Type", "text/plain; charset=UTF-8"]); $m->add_content_utf8("\x{263A}"); $m->add_content_utf8("-\xC5"); is($m->content, "\xE2\x98\xBA-\xC3\x85"); is($m->decoded_content, "\x{263A}-\x{00C5}"); $m = HTTP::Message->new([ "Content-Type", "text/plain", ], "Hello world!" ); $m->content_length(length $m->content); $m->encode("deflate"); $m->dump(prefix => "# "); is($m->dump(prefix => "| "), <<'EOT'); | Content-Encoding: deflate | Content-Type: text/plain | | x\x9C\xF3H\xCD\xC9\xC9W(\xCF/\xCAIQ\4\0\35\t\4^ EOT for my $encoding (qw/identity none/) { my $m2 = $m->clone; $m2->encode("base64", $encoding); is($m2->as_string, <<"EOT"); Content-Encoding: deflate, base64, $encoding Content-Type: text/plain eJzzSM3JyVcozy/KSVEEAB0JBF4= EOT is($m2->decoded_content, "Hello world!"); } # Raw RFC 1951 deflate $m = HTTP::Message->new([ "Content-Type" => "text/plain", "Content-Encoding" => "deflate, base64", ], "80jNyclXCM8vyklRBAA=" ); is($m->decoded_content, "Hello World!"); ok(!$m->header("Client-Warning")); if (eval "require IO::Uncompress::Bunzip2") { for my $encoding (qw/x-bzip2 bzip2/) { $m = HTTP::Message->new([ "Content-Type" => "text/plain", "Content-Encoding" => "$encoding, base64", ], "QlpoOTFBWSZTWcvLx0QAAAHVgAAQYAAAQAYEkIAgADEAMCBoYlnQeSEMvxdyRThQkMvLx0Q=\n" ); is($m->decoded_content, "Hello world!\n"); ok($m->decode); is($m->content, "Hello world!\n"); if (eval "require IO::Compress::Bzip2") { $m = HTTP::Message->new([ "Content-Type" => "text/plain", ], "Hello world!" ); ok($m->encode($encoding)); is($m->header("Content-Encoding"), $encoding); like($m->content, qr/^BZh.*\0/); is($m->decoded_content, "Hello world!"); ok($m->decode); is($m->content, "Hello world!"); } else { skip("Need IO::Compress::Bzip2", undef) for 1..6; } } } else { skip("Need IO::Uncompress::Bunzip2", undef) for 1..18; } # test decoding of XML content $m = HTTP::Message->new(["Content-Type", "application/xml"], "\xFF\xFE<\0?\0x\0m\0l\0 \0v\0e\0r\0s\0i\0o\0n\0=\0\"\x001\0.\x000\0\"\0 \0e\0n\0c\0o\0d\0i\0n\0g\0=\0\"\0U\0T\0F\0-\x001\x006\0l\0e\0\"\0?\0>\0\n\0<\0r\0o\0o\0t\0>\0\xC9\0r\0i\0c\0<\0/\0r\0o\0o\0t\0>\0\n\0"); is($m->decoded_content, "\n\xC9ric\n"); # DESTROY is a no-op $m->DESTROY; is($m->decoded_content, "\n\xC9ric\n"); $m = HTTP::Message->new([ "Content-Type" => "text/plain", ], "Hello World!\n" ); is($m->content, "Hello World!\n"); ok($m->encode()); is($m->content, "Hello World!\n"); is($m->encode("not-an-encoding"), 0); is($m->content, "Hello World!\n"); ok($m->encode("rot13")); is($m->header("Content-Encoding"), "rot13"); is($m->content, "Uryyb Jbeyq!\n"); for my $encoding (qw/compress x-compress/) { $m = HTTP::Message->new([ "Content-Type" => "text/plain", "Content-Encoding" => $encoding, ], "foo"); eval { $m->decoded_content(raise_error => 1); }; like($@, qr/Can't uncompress content/); } eval { $m = HTTP::Message->new('bad-header'); }; like($@, qr/Bad header argument/); $m = HTTP::Message->new(['Content-Encoding' => 'zog']); is($m->decode, 0); $m = HTTP::Message->new; ok($m->decode); { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; local $^W = 0; $m->content; is($#warn, -1); local $^W = 1; $m->content; is($#warn, 0); like($warn[0], qr/Useless content call in void context/); } is($m->content(undef), ''); eval { $m->content(\'foo'); }; like($@, qr/Can't set content to be a scalar reference/); $m = HTTP::Message->new (["Content-Type" => "text/plain",], "\xEF\xBB\xBFaa/"); is($m->content_charset, "UTF-8"); $m->content("\xFF\xFE\x00\x00aa/"); is($m->content_charset, "UTF-32LE"); $m->content("\x00\x00\xFE\xFFaa/"); is($m->content_charset, "UTF-32BE"); $m->content("\xFF\xFEaa/"); is($m->content_charset, "UTF-16LE"); $m->content("\xFE\xFFaa/"); is($m->content_charset, "UTF-16BE"); { $m = HTTP::Message->new; local $@ = 'pre-existing error'; $m->decodable; is($@, 'pre-existing error', 'decodable() does not overwrite $@'); } $m = HTTP::Message->new(["User-Agent" => "Mozilla/5.0", "Referer" => "https://example.com/"]); ok($m->can('content')); my $method = $m->can('user_agent'); is(ref($method), 'CODE'); is(HTTP::Message->can('user_agent'), $method); is($m->$method, "Mozilla/5.0"); ok(HTTP::Message->can('content')); $method = HTTP::Message->can('referrer'); is(ref($method), 'CODE'); is($m->can('referrer'), $method); is($m->$method, "https://example.com/"); eval { $m->unknown_method; }; like $@, qr/Can't locate object method "unknown_method" via package "HTTP::Message"/; is($m->can('unknown_method'), undef); eval { HTTP::Message->unknown_method; }; like $@, qr/Can't locate object method "unknown_method" via package "HTTP::Message"/; is(HTTP::Message->can('unknown_method'), undef); eval { my $empty = ""; $m->$empty; }; like $@, qr/Can't locate object method "" via package "HTTP::Message"/; HTTP-Message-6.36/t/headers.t000644 000765 000024 00000032012 14165326704 015746 0ustar00olafstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Secret (); use Test::More; plan tests => 189; my($h, $h2); sub j { join("|", @_) } require HTTP::Headers; $h = HTTP::Headers->new; ok($h); is(ref($h), "HTTP::Headers"); is($h->as_string, ""); $h = HTTP::Headers->new(foo => "bar", foo => "baaaaz", Foo => "baz"); is($h->as_string, "Foo: bar\nFoo: baaaaz\nFoo: baz\n"); $h = HTTP::Headers->new(foo => ["bar", "baz"]); is($h->as_string, "Foo: bar\nFoo: baz\n"); $h = HTTP::Headers->new(foo => 1, bar => 2, foo_bar => 3); is($h->as_string, "Bar: 2\nFoo: 1\nFoo-Bar: 3\n"); is($h->as_string(";"), "Bar: 2;Foo: 1;Foo-Bar: 3;"); is($h->header("Foo"), 1); is($h->header("FOO"), 1); is(j($h->header("foo")), 1); is($h->header("foo-bar"), 3); is($h->header("foo_bar"), 3); is($h->header("Not-There"), undef); is(j($h->header("Not-There")), ""); is(eval { $h->header }, undef); ok($@); is($h->header("Foo", 11), 1); is($h->header("Foo", [1, 1]), 11); is($h->header("Foo"), "1, 1"); is(j($h->header("Foo")), "1|1"); is($h->header(foo => 11, Foo => 12, bar => 22), 2); is($h->header("Foo"), "11, 12"); is($h->header("Bar"), 22); is($h->header("Bar", undef), 22); is(j($h->header("bar", 22)), ""); $h->push_header(Bar => 22); is($h->header("Bar"), "22, 22"); $h->push_header(Bar => [23 .. 25]); is($h->header("Bar"), "22, 22, 23, 24, 25"); is(j($h->header("Bar")), "22|22|23|24|25"); $h->clear; $h->header(Foo => 1); is($h->as_string, "Foo: 1\n"); $h->init_header(Foo => 2); $h->init_header(Bar => 2); is($h->as_string, "Bar: 2\nFoo: 1\n"); $h->init_header(Foo => [2, 3]); $h->init_header(Baz => [2, 3]); is($h->as_string, "Bar: 2\nBaz: 2\nBaz: 3\nFoo: 1\n"); eval { $h->init_header(A => 1, B => 2, C => 3) }; ok($@); is($h->as_string, "Bar: 2\nBaz: 2\nBaz: 3\nFoo: 1\n"); is($h->clone->remove_header("Foo"), 1); is($h->clone->remove_header("Bar"), 1); is($h->clone->remove_header("Baz"), 2); is($h->clone->remove_header(qw(Foo Bar Baz Not-There)), 4); is($h->clone->remove_header("Not-There"), 0); is(j($h->clone->remove_header("Foo")), 1); is(j($h->clone->remove_header("Bar")), 2); is(j($h->clone->remove_header("Baz")), "2|3"); is(j($h->clone->remove_header(qw(Foo Bar Baz Not-There))), "1|2|2|3"); is(j($h->clone->remove_header("Not-There")), ""); $h = HTTP::Headers->new( allow => "GET", content => "none", content_type => "text/html", content_md5 => "dummy", content_encoding => "gzip", content_foo => "bar", last_modified => "yesterday", expires => "tomorrow", etag => "abc", date => "today", user_agent => "libwww-perl", zoo => "foo", ); is($h->as_string, <clone; is($h->as_string, $h2->as_string); is($h->remove_content_headers->as_string, <as_string, <remove_content_headers; is($h->as_string, $h2->as_string); $h->clear; is($h->as_string, ""); undef($h2); $h = HTTP::Headers->new; is($h->header_field_names, 0); is(j($h->header_field_names), ""); $h = HTTP::Headers->new( etag => 1, foo => [2,3], content_type => "text/plain"); is($h->header_field_names, 3); is(j($h->header_field_names), "ETag|Content-Type|Foo"); { my @tmp; $h->scan(sub { push(@tmp, @_) }); is(j(@tmp), "ETag|1|Content-Type|text/plain|Foo|2|Foo|3"); @tmp = (); eval { $h->scan(sub { push(@tmp, @_); die if $_[0] eq "Content-Type" }) }; ok($@); is(j(@tmp), "ETag|1|Content-Type|text/plain"); @tmp = (); $h->scan(sub { push(@tmp, @_) }); is(j(@tmp), "ETag|1|Content-Type|text/plain|Foo|2|Foo|3"); } # CONVENIENCE METHODS $h = HTTP::Headers->new; is($h->date, undef); is($h->date(time), undef); is(j($h->header_field_names), "Date"); like($h->header("Date"), qr/^[A-Z][a-z][a-z], \d\d .* GMT$/); { my $off = time - $h->date; ok($off == 0 || $off == 1); } if ($] < 5.006) { Test::skip("Can't call variable method", 1) for 1..13; } else { # other date fields for my $field (qw(expires if_modified_since if_unmodified_since last_modified)) { eval <<'EOT'; die $@ if $@; is($h->$field, undef); is($h->$field(time), undef); like((time - $h->$field), qr/^[01]$/); EOT } is(j($h->header_field_names), "Date|If-Modified-Since|If-Unmodified-Since|Expires|Last-Modified"); } $h->clear; is($h->content_type, ""); is($h->content_type(""), ""); is($h->content_type("text/html"), ""); is($h->content_type, "text/html"); is($h->content_type(" TEXT / HTML ") , "text/html"); is($h->content_type, "text/html"); is(j($h->content_type), "text/html"); is($h->content_type("text/html;\n charSet = \"ISO-8859-1\"; Foo=1 "), "text/html"); is($h->content_type, "text/html"); is(j($h->content_type), "text/html|charSet = \"ISO-8859-1\"; Foo=1 "); is($h->header("content_type"), "text/html;\n charSet = \"ISO-8859-1\"; Foo=1 "); ok($h->content_is_html); ok(!$h->content_is_xhtml); ok(!$h->content_is_xml); $h->content_type("application/vnd.wap.xhtml+xml"); ok($h->content_is_html); ok($h->content_is_xhtml); ok($h->content_is_xml); $h->content_type("text/xml"); ok(!$h->content_is_html); ok(!$h->content_is_xhtml); ok($h->content_is_xml); $h->content_type("application/xhtml+xml"); ok($h->content_is_html); ok($h->content_is_xhtml); ok($h->content_is_xml); is($h->content_type("text/html;\n charSet = \"ISO-8859-1\"; Foo=1 "), "application/xhtml+xml"); is($h->content_encoding, undef); is($h->content_encoding("gzip"), undef); is($h->content_encoding, "gzip"); is(j($h->header_field_names), "Content-Encoding|Content-Type"); is($h->content_language, undef); is($h->content_language("no"), undef); is($h->content_language, "no"); is($h->title, undef); is($h->title("This is a test"), undef); is($h->title, "This is a test"); is($h->user_agent, undef); is($h->user_agent("Mozilla/1.2"), undef); is($h->user_agent, "Mozilla/1.2"); is($h->server, undef); is($h->server("Apache/2.1"), undef); is($h->server, "Apache/2.1"); is($h->from("Gisle\@ActiveState.com"), undef); ok($h->header("from", "Gisle\@ActiveState.com")); is($h->referer("http://www.example.com"), undef); is($h->referer, "http://www.example.com"); is($h->referrer, "http://www.example.com"); is($h->referer("http://www.example.com/#bar"), "http://www.example.com"); is($h->referer, "http://www.example.com/"); { require URI; my $u = URI->new("http://www.example.com#bar"); $h->referer($u); is($u->as_string, "http://www.example.com#bar"); is($h->referer->fragment, undef); is($h->referrer->as_string, "http://www.example.com"); } is($h->as_string, <clear; is($h->www_authenticate("foo"), undef); is($h->www_authenticate("bar"), "foo"); is($h->www_authenticate, "bar"); is($h->proxy_authenticate("foo"), undef); is($h->proxy_authenticate("bar"), "foo"); is($h->proxy_authenticate, "bar"); is($h->authorization_basic, undef); is($h->authorization_basic("u"), undef); is($h->authorization_basic("u", "p"), "u:"); is($h->authorization_basic, "u:p"); is(j($h->authorization_basic), "u|p"); is($h->authorization, "Basic dTpw"); is(eval { $h->authorization_basic("u2:p") }, undef); ok($@); is(j($h->authorization_basic), "u|p"); is($h->proxy_authorization_basic("u2", "p2"), undef); is(j($h->proxy_authorization_basic), "u2|p2"); is($h->proxy_authorization, "Basic dTI6cDI="); is($h->as_string, <new; eval { $line = __LINE__; $h->header('foo:', 1); }; like($@, qr/^Illegal field name 'foo:' at \Q$file\E line $line/); eval { $line = __LINE__; $h->header('', 2); }; like($@, qr/^Illegal field name '' at \Q$file\E line $line/); #---- old tests below ----- $h = HTTP::Headers->new( mime_version => "1.0", content_type => "text/html" ); $h->header(URI => "http://www.oslonett.no/"); is($h->header("MIME-Version"), "1.0"); is($h->header('Uri'), "http://www.oslonett.no/"); $h->header("MY-header" => "foo", "Date" => "somedate", "Accept" => ["text/plain", "image/*"], ); $h->push_header("accept" => "audio/basic"); is($h->header("date"), "somedate"); my @accept = $h->header("accept"); is(@accept, 3); $h->remove_header("uri", "date"); my $str = $h->as_string; my $lines = ($str =~ tr/\n/\n/); is($lines, 6); $h2 = $h->clone; $h->header("accept", "*/*"); $h->remove_header("my-header"); @accept = $h2->header("accept"); is(@accept, 3); @accept = $h->header("accept"); is(@accept, 1); # Check order of headers, but first remove this one $h2->remove_header('mime_version'); # and add this general header $h2->header(Connection => 'close'); my @x = (); $h2->scan(sub {push(@x, shift);}); is(join(";", @x), "Connection;Accept;Accept;Accept;Content-Type;MY-Header"); # Check headers with embedded newlines: $h = HTTP::Headers->new( a => "foo\n\n", b => "foo\nbar", c => "foo\n\nbar\n\n", d => "foo\n\tbar", e => "foo\n bar ", f => "foo\n bar\n baz\nbaz", ); is($h->as_string("<<\n"), <new( a => "foo\r\n\r\nevil body" , b => "foo\015\012\015\012evil body" , c => "foo\x0d\x0a\x0d\x0aevil body" , ); is ( $h->as_string(), "A: foo\r\n evil body\n". "B: foo\015\012 evil body\n" . "C: foo\x0d\x0a evil body\n" , "embedded CRLF are stripped out"); # Check with FALSE $HTML::Headers::TRANSLATE_UNDERSCORE { local($HTTP::Headers::TRANSLATE_UNDERSCORE); $HTTP::Headers::TRANSLATE_UNDERSCORE = undef; # avoid -w warning $h = HTTP::Headers->new; $h->header(abc_abc => "foo"); $h->header("abc-abc" => "bar"); is($h->header("ABC_ABC"), "foo"); is($h->header("ABC-ABC"),"bar"); ok($h->remove_header("Abc_Abc")); ok(!defined($h->header("abc_abc"))); is($h->header("ABC-ABC"), "bar"); } # Check if objects as header values works require URI; $h->header(URI => URI->new("http://www.perl.org")); is($h->header("URI")->scheme, "http"); $h->clear; is($h->as_string, ""); $h->content_type("text/plain"); $h->header(content_md5 => "dummy"); $h->header("Content-Foo" => "foo"); $h->header(Location => "http:", xyzzy => "plugh!"); is($h->as_string, <remove_content_headers; is($h->as_string, <as_string, <new; $h->content_type("text/plain"); $h->header(":foo_bar", 1); $h->push_header(":content_type", "text/html"); is(j($h->header_field_names), "Content-Type|:content_type|:foo_bar"); is($h->header('Content-Type'), "text/plain"); is($h->header(':Content_Type'), undef); is($h->header(':content_type'), "text/html"); is($h->as_string, <new; ok(!defined $h->warning('foo', 'INIT')); is($h->warning('bar'), 'foo'); is($h->warning('baz', 'GET'), 'bar'); is($h->as_string, <new; ok(!defined $h->header(':foo', 'bar')); ok(!defined $h->header(':zap', 'bang')); $h->push_header(':zap', ['kapow', 'shazam']); is(j($h->header_field_names), ':foo|:zap'); is(j($h->header_field_names), ':foo|:zap'); $h->scan(sub { $_[1] .= '!' }); is(j($h->header(':zap')), 'bang!|kapow!|shazam!'); is(j($h->header(':foo')), 'bar'); is($h->as_string, <remove_header(':zap')), 'bang!|kapow!|shazam!'); $h->push_header(':zap', 'whomp', ':foo', 'quux'); is(j($h->header(':foo')), 'bar|quux'); # [RT#30579] IE6 appens "; length = NNNN" on If-Modified-Since (can we handle it) $h = HTTP::Headers->new( if_modified_since => "Sat, 29 Oct 1994 19:43:31 GMT; length=34343" ); is(gmtime($h->if_modified_since), "Sat Oct 29 19:43:31 1994"); $h = HTTP::Headers->new(); $h->content_type('text/plain'); $h->content_length(4); $h->push_header('x-foo' => 'bar'); $h->push_header('x-foo' => 'baz'); is(0+$h->flatten, 8); is_deeply( [ $h->flatten ], [ 'Content-Length', 4, 'Content-Type', 'text/plain', 'X-Foo', 'bar', 'X-Foo', 'baz', ], ); subtest 'object that stringifies is a valid value' => sub { my $h = HTTP::Headers->new; $h->header('X-Password' => Secret->new('hunter2')); my $h2 = $h->clone; is($h2->as_string, "X-Password: hunter2\n", 'correct headers'); }; HTTP-Message-6.36/t/message-charset.t000644 000765 000024 00000006153 14165326704 017415 0ustar00olafstaff000000 000000 use strict; use warnings; use Test::More; plan tests => 43; use HTTP::Response; my $r = HTTP::Response->new(200, "OK"); is($r->content_charset, undef); is($r->content_type_charset, undef); $r->content_type("text/plain"); is($r->content_charset, undef); $r->content("abc"); is($r->content_charset, "US-ASCII"); $r->content("f\xE5rep\xF8lse\n"); is($r->content_charset, "ISO-8859-1"); $r->content("f\xC3\xA5rep\xC3\xB8lse\n"); is($r->content_charset, "UTF-8"); $r->content_type("text/html"); $r->content(<<'EOT'); EOT is($r->content_charset, "UTF-8"); $r->content(<<'EOT'); EOT is($r->content_charset, "UTF-8"); $r->content(<<'EOT');