HTTP-Message-7.01000755001750001750 015075217132 12632 5ustar00olafolaf000000000000LICENSE100644001750001750 4627015075217132 13751 0ustar00olafolaf000000000000HTTP-Message-7.01This 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. 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, see . 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 Moe Ghoul, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 1994 by Gisle Aas. This is free software, licensed under: The Perl 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 as specified below. "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 uunet.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) give non-standard executables non-standard names, and clearly document 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. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 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 whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. 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 INSTALL100644001750001750 455315075217132 13753 0ustar00olafolaf000000000000HTTP-Message-7.01This 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 Changes100644001750001750 2563215075217132 14236 0ustar00olafolaf000000000000HTTP-Message-7.01Revision history for HTTP-Message 7.01 2025-10-19 17:22:21Z - Fix HTTP::Response and HTTP::Request as_string/parse commutativity issue #62959 (GH#212) (Copilot) - Fix few minor typos (GH#202) (Yoshikazu Sawa) 7.00 2024-10-07 15:31:56Z - Stop transforming LF into CRLF. Fixes #69 (GH#196) (Olaf Alders) 6.46 2024-05-27 18:58:16Z - Update several status codes to RFC 9110 (GH#197) (Wesley Schwengle) 6.45 2023-09-27 14:27:31Z - Allow for file ownership conflicts with Docker and GitHub Actions (GH#193) (Olaf Alders) - Add the 'status_code' function for getting all status codes as hash (GH#194) (Dai Okabayashi) 6.44 2022-10-26 20:49:00Z - Made the Clone module a hard requirement, so we don't have to provide a fallback function for HTTP::Headers::clone(). We require at least Clone 0.46, as that release now supports Perl back to 5.8.1, just like us. (GH#184) (Neil Bowers) - Import clone from Clone rather than inheriting (GH#189) (Graham Knop) - Made the Compress::Raw::Zlib 2.062 module minimal required version. (GH#190) (Jakub 'q84fh' Skory) 6.43 2022-10-22 14:50:35Z - Remove dependency to IO::Uncompress::Bunzip2. (Michal Josef Spacek) - Remove dependency to IO::Uncompress::Gunzip. (Michal Josef Spacek) 6.42 2022-10-18 13:53:22Z - We now don't consider the Content-Location header when asked for the base URI. RFC 7231 says we shouldn't. (GH#51) (Neil Bowers) - Increased the (max) buffer size for read() when processing form data, from 2048 to 8192. This was suggested in RT#105184, as it improved performance for them. (GH#59) (Neil Bowers) 6.41 2022-10-12 15:57:40Z - Add maximum size for HTTP::Message->decoded_content This can be used to limit the size of a decompressed HTTP response, especially when making requests to untrusted or user-specified servers. The $HTTP::Message::MAXIMUM_BODY_SIZE variable and the ->max_body_size accessor can set this limit. (GH#181) (Max Maischein) 6.40 2022-10-12 15:45:52Z - Fixed two typos in the doc, originally reported by FatherC in RT#90716, ported over as GH#57. (GH#57) (Neil Bowers) 6.39 2022-10-08 13:48:26Z - Remove Travis config (GH#180) (Olaf Alders) - Added status_constant_name() which maps status code to the name of the corresponding constant. (GH#160) (Neil Bowers) - Updated the doc for status_message() to clarify that it returns "Not Found" and not "HTTP_NOT_FOUND". (GH#160) (Neil Bowers) 6.38 2022-10-06 21:48:18Z - Replace "base" with "parent" (GH#176) (James Raspass) - Replace "print" with "note" in tests (GH#178) (James Raspass) - Noted that OPTIONS supported was added in 6.1, to the doc for HTTP::Request::Common. Addresses GH#177. (GH#179) (Neil Bowers) 6.37 2022-06-14 14:08:55Z - Support for Brotli "br" encoding (GH#163) (trizen and Julien Fiegehenn) - Don't test Perl > 5.32 on Windows in GH Actions (GH#174) (Olaf Alders) 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) - Added support for OPTIONS requests. 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. cpanfile100644001750001750 414115075217132 14417 0ustar00olafolaf000000000000HTTP-Message-7.01# This file is generated by Dist::Zilla::Plugin::CPANFile v6.033 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Carp" => "0"; requires "Clone" => "0.46"; requires "Compress::Raw::Bzip2" => "0"; requires "Compress::Raw::Zlib" => "2.062"; 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::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 "parent" => "0"; requires "perl" => "5.008001"; requires "strict" => "0"; requires "warnings" => "0"; recommends "IO::Compress::Brotli" => "0.004001"; recommends "IO::Uncompress::Brotli" => "0.004001"; 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 "Test::Needs" => "0"; 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"; recommends "IO::Compress::Brotli" => "0.004001"; recommends "IO::Uncompress::Brotli" => "0.004001"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "perl" => "5.006"; }; on 'configure' => sub { suggests "JSON::PP" => "2.27300"; }; on 'develop' => sub { 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"; }; META.yml100644001750001750 5126015075217132 14210 0ustar00olafolaf000000000000HTTP-Message-7.01--- 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' Test::Needs: '0' 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.033, 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 recommends: IO::Compress::Brotli: '0.004001' IO::Uncompress::Brotli: '0.004001' requires: Carp: '0' Clone: '0.46' Compress::Raw::Bzip2: '0' Compress::Raw::Zlib: '2.062' 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::Inflate: '0' IO::Uncompress::RawInflate: '0' LWP::MediaTypes: '6' MIME::Base64: '2.1' MIME::QuotedPrint: '0' URI: '1.10' parent: '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: '7.01' x_Dist_Zilla: perl: version: '5.038002' plugins: - class: Dist::Zilla::Plugin::MetaResources name: MetaResources version: '6.033' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: runtime type: requires name: Prereqs version: '6.033' - 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.060' - 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.060' - class: Dist::Zilla::Plugin::AutoPrereqs name: '@Author::OALDERS/AutoPrereqs' version: '6.033' - class: Dist::Zilla::Plugin::CheckChangesHasContent name: '@Author::OALDERS/CheckChangesHasContent' version: '0.011' - class: Dist::Zilla::Plugin::MakeMaker config: Dist::Zilla::Role::TestRunner: default_jobs: '8' name: '@Author::OALDERS/MakeMaker' version: '6.033' - class: Dist::Zilla::Plugin::CPANFile name: '@Author::OALDERS/CPANFile' version: '6.033' - class: Dist::Zilla::Plugin::ContributorsFile name: '@Author::OALDERS/ContributorsFile' version: 0.3.0 - class: Dist::Zilla::Plugin::MetaJSON name: '@Author::OALDERS/MetaJSON' version: '6.033' - class: Dist::Zilla::Plugin::MetaYAML name: '@Author::OALDERS/MetaYAML' version: '6.033' - class: Dist::Zilla::Plugin::Manifest name: '@Author::OALDERS/Manifest' version: '6.033' - class: Dist::Zilla::Plugin::MetaNoIndex name: '@Author::OALDERS/MetaNoIndex' version: '6.033' - class: Dist::Zilla::Plugin::MetaConfig name: '@Author::OALDERS/MetaConfig' version: '6.033' - class: Dist::Zilla::Plugin::MetaResources name: '@Author::OALDERS/MetaResources' version: '6.033' - class: Dist::Zilla::Plugin::License name: '@Author::OALDERS/License' version: '6.033' - 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.033' - class: Dist::Zilla::Plugin::MojibakeTests name: '@Author::OALDERS/MojibakeTests' version: '0.8' - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@Author::OALDERS/PodSyntaxTests' version: '6.033' - class: Dist::Zilla::Plugin::Test::CPAN::Changes config: Dist::Zilla::Plugin::Test::CPAN::Changes: changelog: Changes filename: xt/release/cpan-changes.t name: '@Author::OALDERS/Test::CPAN::Changes' version: '0.013' - class: Dist::Zilla::Plugin::Test::Portability config: Dist::Zilla::Plugin::Test::Portability: options: '' name: '@Author::OALDERS/Test::Portability' version: '2.001003' - class: Dist::Zilla::Plugin::TestRelease name: '@Author::OALDERS/TestRelease' version: '6.033' - class: Dist::Zilla::Plugin::Test::ReportPrereqs name: '@Author::OALDERS/Test::ReportPrereqs' version: '0.029' - 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: '8' 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' - ':PerlExecFiles' plugins: - class: Pod::Weaver::Plugin::EnsurePod5 name: '@CorePrep/EnsurePod5' version: '4.020' - class: Pod::Weaver::Plugin::H1Nester name: '@CorePrep/H1Nester' version: '4.020' - class: Pod::Weaver::Plugin::SingleEncoding name: '@Default/SingleEncoding' version: '4.020' - class: Pod::Weaver::Section::Name name: '@Default/Name' version: '4.020' - class: Pod::Weaver::Section::Version name: '@Default/Version' version: '4.020' - class: Pod::Weaver::Section::Region name: '@Default/prelude' version: '4.020' - class: Pod::Weaver::Section::Generic name: SYNOPSIS version: '4.020' - class: Pod::Weaver::Section::Generic name: DESCRIPTION version: '4.020' - class: Pod::Weaver::Section::Generic name: OVERVIEW version: '4.020' - class: Pod::Weaver::Section::Collect name: ATTRIBUTES version: '4.020' - class: Pod::Weaver::Section::Collect name: METHODS version: '4.020' - class: Pod::Weaver::Section::Collect name: FUNCTIONS version: '4.020' - class: Pod::Weaver::Section::Leftovers name: '@Default/Leftovers' version: '4.020' - class: Pod::Weaver::Section::Region name: '@Default/postlude' version: '4.020' - class: Pod::Weaver::Section::Authors name: '@Default/Authors' version: '4.020' - class: Pod::Weaver::Section::Legal name: '@Default/Legal' version: '4.020' name: '@Author::OALDERS/PodWeaver' version: '4.010' - class: Dist::Zilla::Plugin::PruneCruft name: '@Author::OALDERS/PruneCruft' version: '6.033' - 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: [] include_dotfiles: 0 prefix: '' prune_directory: [] root: . Dist::Zilla::Plugin::Git::GatherDir: include_untracked: 0 name: '@Author::OALDERS/Git::GatherDir' version: '2.052' - 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.43.0 repo_root: . name: '@Author::OALDERS/Git::Check' version: '2.052' - class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: git_version: 2.43.0 include_authors: 0 include_releaser: 1 order_by: name paths: [] name: '@Author::OALDERS/Git::Contributors' version: '0.038' - 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.033' - class: Dist::Zilla::Plugin::CheckIssues name: '@Author::OALDERS/CheckIssues' version: '0.011' - class: Dist::Zilla::Plugin::ConfirmRelease name: '@Author::OALDERS/ConfirmRelease' version: '6.033' - class: Dist::Zilla::Plugin::UploadToCPAN name: '@Author::OALDERS/UploadToCPAN' version: '6.033' - 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.43.0 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Author::OALDERS/@Git::VersionManager/release snapshot' version: '2.052' - class: Dist::Zilla::Plugin::Git::Tag config: Dist::Zilla::Plugin::Git::Tag: branch: ~ changelog: Changes signed: 0 tag: v7.01 tag_format: v%V tag_message: v%V Dist::Zilla::Role::Git::Repo: git_version: 2.43.0 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Author::OALDERS/@Git::VersionManager/Git::Tag' version: '2.052' - 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.033' - 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.43.0 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Author::OALDERS/@Git::VersionManager/post-release commit' version: '2.052' - 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.43.0 repo_root: . name: '@Author::OALDERS/Git::Push' version: '2.052' - class: Dist::Zilla::Plugin::Prereqs::Soften config: Dist::Zilla::Plugin::Prereqs::Soften: copy_to: - test.recommends modules: - IO::Compress::Brotli - IO::Uncompress::Brotli modules_from_features: ~ to_relationship: recommends name: Brotli 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::FinderCode name: ':InstallModules' version: '6.033' - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: '6.033' - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: '6.033' - class: Dist::Zilla::Plugin::FinderCode name: ':ExtraTestFiles' version: '6.033' - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: '6.033' - class: Dist::Zilla::Plugin::FinderCode name: ':PerlExecFiles' version: '6.033' - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: '6.033' - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: '6.033' - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' version: '6.033' - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' version: '6.033' zilla: class: Dist::Zilla::Dist::Builder config: is_trial: 0 version: '6.033' x_contributors: - 'Adam Kennedy ' - 'Adam Sjogren ' - 'Alexey Tourbin ' - 'Alex Kapranoff ' - 'amire80 ' - 'Andreas J. Koenig ' - 'Andrei Grechkin ' - 'bayashi ' - 'Bill Mann ' - 'Brendan Byrd ' - 'Bron Gondwana ' - 'Chase Whitener ' - 'Christopher J. Madsen ' - 'chromatic ' - 'copilot-swe-agent[bot] <198982749+Copilot@users.noreply.github.com>' - 'Dan Book ' - 'Daniel Hedlund ' - 'Daniel Trizen ' - 'David E. Wheeler ' - 'DAVIDRW ' - 'David Steinbrunner ' - 'dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>' - '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 Skory ' - 'Jakub Wilk ' - 'James Raspass ' - 'jefflee ' - 'Jerome Eteve ' - 'john9art ' - 'jonasbn ' - 'Julien Fiegehenn ' - '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 ' - 'Neil Bowers ' - 'Olaf Alders ' - 'Olivier Mengué ' - 'Ondrej Hanak ' - 'openstrike ' - 'Peter Rabbitson ' - 'phrstbrn ' - 'Robert Rothenberg ' - 'Robert Stone ' - 'Rolf Grossmann ' - 'ruff ' - 'sasao ' - 'Saturday Walkers Club ' - 'Sean M. Burke ' - 'Slaven Rezic ' - 'Spiros Denaxas ' - 'Steve Hay ' - '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 ' - 'Wesley Schwengle ' - 'William Storey ' - 'yoshikazusawa <883514+yoshikazusawa@users.noreply.github.com>' - 'Yuri Karaban ' - 'Zakariyya Mughal ' - 'Zefram ' x_generated_by_perl: v5.38.2 x_serialization_backend: 'YAML::Tiny version 1.76' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' x_static_install: 1 MANIFEST100644001750001750 207415075217132 14047 0ustar00olafolaf000000000000HTTP-Message-7.01# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.033. 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-brotli.t t/message-charset.t t/message-decode-brotlibomb.t t/message-decode-bzipbomb.t t/message-decode-xml.t t/message-decode-zipbomb.t t/message-old.t t/message-parts.t t/message.t t/request-as-string-parse.t t/request.t t/request_type_with_data.t t/response-as-string-parse.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/cpan-changes.t dist.ini100644001750001750 176715075217132 14372 0ustar00olafolaf000000000000HTTP-Message-7.01name = 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 = 2.062 Encode = 3.01 Encode::Locale = 1 Exporter = 5.57 HTTP::Date = 6 IO::Compress::Brotli = 0.004001 IO::Compress::Bzip2 = 2.021 IO::Uncompress::Brotli = 0.004001 LWP::MediaTypes = 6 MIME::Base64 = 2.1 perl = 5.008001 URI = 1.10 Clone = 0.46 [@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 / Brotli] to_relationship = recommends copy_to = test.recommends module = IO::Compress::Brotli module = IO::Uncompress::Brotli [Test::Compile] bail_out_on_fail = 1 xt_mode = 1 META.json100644001750001750 7522115075217132 14363 0ustar00olafolaf000000000000HTTP-Message-7.01{ "abstract" : "HTTP style message (base class)", "author" : [ "Gisle Aas " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.033, 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" : { "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" : { "recommends" : { "IO::Compress::Brotli" : "0.004001", "IO::Uncompress::Brotli" : "0.004001" }, "requires" : { "Carp" : "0", "Clone" : "0.46", "Compress::Raw::Bzip2" : "0", "Compress::Raw::Zlib" : "2.062", "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::Inflate" : "0", "IO::Uncompress::RawInflate" : "0", "LWP::MediaTypes" : "6", "MIME::Base64" : "2.1", "MIME::QuotedPrint" : "0", "URI" : "1.10", "parent" : "0", "perl" : "5.008001", "strict" : "0", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900", "IO::Compress::Brotli" : "0.004001", "IO::Uncompress::Brotli" : "0.004001" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "File::Temp" : "0", "PerlIO::encoding" : "0", "Test::More" : "0.88", "Test::Needs" : "0", "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" : "7.01", "x_Dist_Zilla" : { "perl" : { "version" : "5.038002" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "MetaResources", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "runtime", "type" : "requires" } }, "name" : "Prereqs", "version" : "6.033" }, { "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.060" }, { "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.060" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "@Author::OALDERS/AutoPrereqs", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::CheckChangesHasContent", "name" : "@Author::OALDERS/CheckChangesHasContent", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : "8" } }, "name" : "@Author::OALDERS/MakeMaker", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::CPANFile", "name" : "@Author::OALDERS/CPANFile", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::ContributorsFile", "name" : "@Author::OALDERS/ContributorsFile", "version" : "0.3.0" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@Author::OALDERS/MetaJSON", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@Author::OALDERS/MetaYAML", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@Author::OALDERS/Manifest", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::MetaNoIndex", "name" : "@Author::OALDERS/MetaNoIndex", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@Author::OALDERS/MetaConfig", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "@Author::OALDERS/MetaResources", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@Author::OALDERS/License", "version" : "6.033" }, { "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.033" }, { "class" : "Dist::Zilla::Plugin::MojibakeTests", "name" : "@Author::OALDERS/MojibakeTests", "version" : "0.8" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@Author::OALDERS/PodSyntaxTests", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::Test::CPAN::Changes", "config" : { "Dist::Zilla::Plugin::Test::CPAN::Changes" : { "changelog" : "Changes", "filename" : "xt/release/cpan-changes.t" } }, "name" : "@Author::OALDERS/Test::CPAN::Changes", "version" : "0.013" }, { "class" : "Dist::Zilla::Plugin::Test::Portability", "config" : { "Dist::Zilla::Plugin::Test::Portability" : { "options" : "" } }, "name" : "@Author::OALDERS/Test::Portability", "version" : "2.001003" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@Author::OALDERS/TestRelease", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::Test::ReportPrereqs", "name" : "@Author::OALDERS/Test::ReportPrereqs", "version" : "0.029" }, { "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" : "8" } }, "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", ":PerlExecFiles" ], "plugins" : [ { "class" : "Pod::Weaver::Plugin::EnsurePod5", "name" : "@CorePrep/EnsurePod5", "version" : "4.020" }, { "class" : "Pod::Weaver::Plugin::H1Nester", "name" : "@CorePrep/H1Nester", "version" : "4.020" }, { "class" : "Pod::Weaver::Plugin::SingleEncoding", "name" : "@Default/SingleEncoding", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Name", "name" : "@Default/Name", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Version", "name" : "@Default/Version", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@Default/prelude", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "SYNOPSIS", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "DESCRIPTION", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "OVERVIEW", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "ATTRIBUTES", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "METHODS", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "FUNCTIONS", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Leftovers", "name" : "@Default/Leftovers", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@Default/postlude", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Authors", "name" : "@Default/Authors", "version" : "4.020" }, { "class" : "Pod::Weaver::Section::Legal", "name" : "@Default/Legal", "version" : "4.020" } ] } }, "name" : "@Author::OALDERS/PodWeaver", "version" : "4.010" }, { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "@Author::OALDERS/PruneCruft", "version" : "6.033" }, { "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" : [], "include_dotfiles" : 0, "prefix" : "", "prune_directory" : [], "root" : "." }, "Dist::Zilla::Plugin::Git::GatherDir" : { "include_untracked" : 0 } }, "name" : "@Author::OALDERS/Git::GatherDir", "version" : "2.052" }, { "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.43.0", "repo_root" : "." } }, "name" : "@Author::OALDERS/Git::Check", "version" : "2.052" }, { "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { "git_version" : "2.43.0", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", "paths" : [] } }, "name" : "@Author::OALDERS/Git::Contributors", "version" : "0.038" }, { "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.033" }, { "class" : "Dist::Zilla::Plugin::CheckIssues", "name" : "@Author::OALDERS/CheckIssues", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@Author::OALDERS/ConfirmRelease", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@Author::OALDERS/UploadToCPAN", "version" : "6.033" }, { "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.43.0", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Author::OALDERS/@Git::VersionManager/release snapshot", "version" : "2.052" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "config" : { "Dist::Zilla::Plugin::Git::Tag" : { "branch" : null, "changelog" : "Changes", "signed" : 0, "tag" : "v7.01", "tag_format" : "v%V", "tag_message" : "v%V" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.43.0", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Author::OALDERS/@Git::VersionManager/Git::Tag", "version" : "2.052" }, { "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.033" }, { "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.43.0", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Author::OALDERS/@Git::VersionManager/post-release commit", "version" : "2.052" }, { "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.43.0", "repo_root" : "." } }, "name" : "@Author::OALDERS/Git::Push", "version" : "2.052" }, { "class" : "Dist::Zilla::Plugin::Prereqs::Soften", "config" : { "Dist::Zilla::Plugin::Prereqs::Soften" : { "copy_to" : [ "test.recommends" ], "modules" : [ "IO::Compress::Brotli", "IO::Uncompress::Brotli" ], "modules_from_features" : null, "to_relationship" : "recommends" } }, "name" : "Brotli", "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::FinderCode", "name" : ":InstallModules", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExtraTestFiles", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":PerlExecFiles", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", "version" : "6.033" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", "version" : "6.033" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : 0 }, "version" : "6.033" } }, "x_contributors" : [ "Adam Kennedy ", "Adam Sjogren ", "Alexey Tourbin ", "Alex Kapranoff ", "amire80 ", "Andreas J. Koenig ", "Andrei Grechkin ", "bayashi ", "Bill Mann ", "Brendan Byrd ", "Bron Gondwana ", "Chase Whitener ", "Christopher J. Madsen ", "chromatic ", "copilot-swe-agent[bot] <198982749+Copilot@users.noreply.github.com>", "Dan Book ", "Daniel Hedlund ", "Daniel Trizen ", "David E. Wheeler ", "DAVIDRW ", "David Steinbrunner ", "dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>", "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 Skory ", "Jakub Wilk ", "James Raspass ", "jefflee ", "Jerome Eteve ", "john9art ", "jonasbn ", "Julien Fiegehenn ", "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 ", "Neil Bowers ", "Olaf Alders ", "Olivier Mengu\u00e9 ", "Ondrej Hanak ", "openstrike ", "Peter Rabbitson ", "phrstbrn ", "Robert Rothenberg ", "Robert Stone ", "Rolf Grossmann ", "ruff ", "sasao ", "Saturday Walkers Club ", "Sean M. Burke ", "Slaven Rezic ", "Spiros Denaxas ", "Steve Hay ", "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 ", "Wesley Schwengle ", "William Storey ", "yoshikazusawa <883514+yoshikazusawa@users.noreply.github.com>", "Yuri Karaban ", "Zakariyya Mughal ", "Zefram " ], "x_generated_by_perl" : "v5.38.2", "x_serialization_backend" : "Cpanel::JSON::XS version 4.40", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later", "x_static_install" : 1 } README.md100644001750001750 2707015075217132 14220 0ustar00olafolaf000000000000HTTP-Message-7.01# NAME HTTP::Message - HTTP style message (base class) # VERSION version 7.01 # SYNOPSIS use parent '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 overrides the charset parameter for text content. The value `none` can used to suppress decoding of the charset. - `default_charset` This overrides 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", "base64" and "br". 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. perltidyrc100644001750001750 33015075217132 14773 0ustar00olafolaf000000000000HTTP-Message-7.01--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=" t000755001750001750 015075217132 13016 5ustar00olafolaf000000000000HTTP-Message-7.01status.t100644001750001750 353515075217132 14674 0ustar00olafolaf000000000000HTTP-Message-7.01/tuse strict; use warnings; use Test::More; use HTTP::Status qw(:constants :is status_message status_constant_name status_codes); is(HTTP_OK, 200); ok(is_info(HTTP_CONTINUE)); ok(is_success(HTTP_ACCEPTED)); ok(is_error(HTTP_BAD_REQUEST)); 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_error(HTTP_UNPROCESSABLE_ENTITY)); ok(is_error(HTTP_PAYLOAD_TOO_LARGE)); # Have a sip and a great day ok(is_client_error(HTTP_I_AM_A_TEAPOT)); ok(is_error(HTTP_I_AM_A_TEAPOT)); is(status_message(418), "I'm a teapot"); 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); is(status_constant_name(HTTP_OK), "HTTP_OK"); is(status_constant_name(404), "HTTP_NOT_FOUND"); is(status_constant_name(999), undef); my %status_codes = status_codes(); is($status_codes{200}, status_message(200)); done_testing; Makefile.PL100644001750001750 503615075217132 14671 0ustar00olafolaf000000000000HTTP-Message-7.01# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.033. 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, "Clone" => "0.46", "Compress::Raw::Bzip2" => 0, "Compress::Raw::Zlib" => "2.062", "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::Inflate" => 0, "IO::Uncompress::RawInflate" => 0, "LWP::MediaTypes" => 6, "MIME::Base64" => "2.1", "MIME::QuotedPrint" => 0, "URI" => "1.10", "parent" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "File::Temp" => 0, "PerlIO::encoding" => 0, "Test::More" => "0.88", "Test::Needs" => 0, "Time::Local" => 0, "Try::Tiny" => 0, "URI::URL" => 0, "lib" => 0, "overload" => 0 }, "VERSION" => "7.01", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Clone" => "0.46", "Compress::Raw::Bzip2" => 0, "Compress::Raw::Zlib" => "2.062", "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::Inflate" => 0, "IO::Uncompress::RawInflate" => 0, "LWP::MediaTypes" => 6, "MIME::Base64" => "2.1", "MIME::QuotedPrint" => 0, "PerlIO::encoding" => 0, "Test::More" => "0.88", "Test::Needs" => 0, "Time::Local" => 0, "Try::Tiny" => 0, "URI" => "1.10", "URI::URL" => 0, "lib" => 0, "overload" => 0, "parent" => 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); headers.t100644001750001750 3201315075217132 14775 0ustar00olafolaf000000000000HTTP-Message-7.01/tuse 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 appends "; 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'); }; message.t100644001750001750 3433115075217132 15013 0ustar00olafolaf000000000000HTTP-Message-7.01/t#! 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 Compress::Raw::Bzip2") { 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 Compress::Raw::Bzip2", 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"/; request.t100644001750001750 1027015075217132 15053 0ustar00olafolaf000000000000HTTP-Message-7.01/t# Test extra HTTP::Request methods. Basic operation is tested in the # message.t test suite. use strict; use warnings; use Test::More; plan tests => 39; use HTTP::Request; use Try::Tiny qw( catch try ); my $req = HTTP::Request->new( GET => "http://www.example.com" ); $req->accept_decodable; is( $req->method, "GET" ); is( $req->uri, "http://www.example.com" ); like( $req->header("Accept-Encoding"), qr/\bgzip\b/ ) ; # assuming Compress::Raw::Zlib is there $req->dump( prefix => "# " ); is( $req->method("DELETE"), "GET" ); is( $req->method, "DELETE" ); is( $req->uri("http:"), "http://www.example.com" ); is( $req->uri, "http:" ); $req->protocol("HTTP/1.1"); my $r2 = HTTP::Request->parse( $req->as_string ); is( $r2->method, "DELETE" ); is( $r2->uri, "http:" ); is( $r2->protocol, "HTTP/1.1" ); is( $r2->header("Accept-Encoding"), $req->header("Accept-Encoding") ); # Test objects which are accepted as URI-like { package Foo::URI; use strict; use warnings; sub new { return bless {}, shift; } sub clone { return shift } sub scheme { } 1; package Foo::URI::WithCanonical; sub new { return bless {}, shift; } sub clone { return shift } sub scheme { } sub canonical { } 1; package Foo::URI::WithoutScheme; sub new { return bless {}, shift; } sub clone { return shift } 1; package main; ok( Foo::URI->new->can('scheme'), 'Object can scheme()' ); ok( !do { try { HTTP::Request->new( GET => Foo::URI->new ); return 1; } catch { return 0 }; }, 'Object without canonical method triggers an exception' ); ok( Foo::URI::WithCanonical->new->can('canonical'), 'Object can canonical()' ); ok( do { try { HTTP::Request->new( GET => Foo::URI::WithCanonical->new ); return 1; } catch { return 0 }; }, 'Object with canonical method does not trigger an exception' ); ok( !Foo::URI::WithoutScheme->new->can('scheme'), 'Object cannot scheme()' ); ok( !do { try { HTTP::Request->new( GET => Foo::URI::WithoutScheme->new ); return 1; } catch { return 0 }; }, 'Object without scheme method triggers an exception' ); # test uri_canonical cache { my $url = 'https://localhost/'; my $r = HTTP::Request->new(GET => $url); is($r->uri_canonical, $url, 'Works when canonical uri not yet cached'); is($r->uri_canonical, $url, 'Works when canonical uri has been cached'); } { require URI::URL; my $url = 'https://localhost/'; my $r = HTTP::Request->new(GET => URI::URL->new($url)); is($r->uri_canonical, $url, 'Works when canonical uri not yet cached with URI::URL'); is($r->uri_canonical, $url, 'Works when canonical uri has been cached with URI::URL'); } } eval { $req->uri ({ foo => 'bar'}); }; like($@, qr/A URI can't be a HASH reference/); eval { $req->uri (['foo']); }; like($@, qr/A URI can't be a ARRAY reference/); $req = HTTP::Request->new; is($req->as_string, "- -\n\n"); is($req->dump, <protocol("HTTP/1.1"); is($req->dump, <parse( undef ); is($#warn, -1); local $^W = 1; $r2 = HTTP::Request->parse( undef ); is($#warn, 0); like($warn[0], qr/Undefined argument to parse\(\)/); } is( $r2->method, undef ); is( $r2->uri, undef ); is( $r2->protocol, undef ); is( $r2->header("Accept-Encoding"), $req->header("Accept-Encoding") ); $r2 = HTTP::Request->parse('methonly'); is( $r2->method, 'methonly' ); is( $r2->uri, undef ); is( $r2->protocol, undef ); $r2 = HTTP::Request->parse('methonly http://www.example.com/'); is( $r2->method, 'methonly' ); is( $r2->uri, 'http://www.example.com/' ); is( $r2->protocol, undef ); tidyall.ini100644001750001750 47115075217132 15040 0ustar00olafolaf000000000000HTTP-Message-7.01[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 CONTRIBUTORS100644001750001750 404215075217132 14573 0ustar00olafolaf000000000000HTTP-Message-7.01 # 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 * bayashi * Bill Mann * Brendan Byrd * Bron Gondwana * Chase Whitener * Christopher J. Madsen * chromatic * copilot-swe-agent[bot] * Dan Book * Daniel Hedlund * Daniel Trizen * David E. Wheeler * DAVIDRW * David Steinbrunner * dependabot[bot] * 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 Skory * Jakub Wilk * James Raspass * jefflee * Jerome Eteve * john9art * jonasbn * Julien Fiegehenn * 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 * Neil Bowers * Olaf Alders * Olivier Mengué * Ondrej Hanak * openstrike * Peter Rabbitson * phrstbrn * Robert Rothenberg * Robert Stone * Rolf Grossmann * ruff * sasao * Saturday Walkers Club * Sean M. Burke * Slaven Rezic * Spiros Denaxas * Steve Hay * 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 * Wesley Schwengle * William Storey * yoshikazusawa * Yuri Karaban * Zakariyya Mughal * Zefram perlcriticrc100644001750001750 440515075217132 15326 0ustar00olafolaf000000000000HTTP-Message-7.01severity = 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] response.t100644001750001750 1341015075217132 15220 0ustar00olafolaf000000000000HTTP-Message-7.01/t# Test extra HTTP::Response methods. Basic operation is tested in the # message.t test suite. use strict; use warnings; use Test::More; plan tests => 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); #note $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); note "current_age = $current_age"; note "freshness_lifetime = $freshness_lifetime"; note "response is ", "not " x !$is_fresh, "fresh"; note "it will be fresh for ", $freshness_lifetime - $current_age, " more seconds"; # OK, now we add an Expires header $r->expires($time); note "\n", $r->dump; $freshness_lifetime = $r->freshness_lifetime; is($freshness_lifetime, 25); $r->remove_header('expires'); # Now we try the 'Age' header and the Cache-Control: $r->header('Age', 300); $r->push_header('Cache-Control', 'junk'); $r->push_header(Cache_Control => 'max-age = 10'); #note $r->as_string; $current_age = $r->current_age; $freshness_lifetime = $r->freshness_lifetime; note "current_age = $current_age"; note "freshness_lifetime = $freshness_lifetime"; 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, $r->request->uri); # we no longer consider Content-Location $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'); common-req.t100644001750001750 1603315075217132 15443 0ustar00olafolaf000000000000HTTP-Message-7.01/tuse strict; use warnings; use Test::More; 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, 77, 'content_length'); is($r->header("bar"), "foo", 'bar is foo'); is($r->content, 'foo=bar%3Bbaz&baz=a&baz=b&baz=c&foo=zoo%3D%26&space+=+%2B+&nl=a%0Ab%0D%0Ac%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 - 6), '<', 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); done_testing(); status-old.t100644001750001750 47315075217132 15426 0ustar00olafolaf000000000000HTTP-Message-7.01/tuse strict; use warnings; use Test::More; plan tests => 8; use HTTP::Status; is(RC_OK, 200); ok(is_info(RC_CONTINUE)); ok(is_success(RC_ACCEPTED)); ok(is_error(RC_BAD_REQUEST)); ok(is_redirect(RC_MOVED_PERMANENTLY)); ok(!is_success(RC_NOT_FOUND)); is(status_message(0), undef); is(status_message(200), "OK"); CONTRIBUTING.md100644001750001750 1142715075217132 15171 0ustar00olafolaf000000000000HTTP-Message-7.01# 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-config.t100644001750001750 715315075217132 15573 0ustar00olafolaf000000000000HTTP-Message-7.01/tuse strict; use warnings; use Test::More; plan tests => 30; use HTTP::Config; sub j { join("|", @_) } my $conf = HTTP::Config->new; ok($conf->empty); is($conf->entries, 0); $conf->add_item(42); ok(!$conf->empty); is($conf->entries, 1); is(j($conf->matching_items("http://www.example.com/foo")), 42); is(j($conf->remove_items), 42); is(j($conf->remove_items), ''); is($conf->matching_items("http://www.example.com/foo"), 0); is($conf->matching_items('foo', 'bar', 'baz'), 0); $conf->add({item => "http://www.example.com/foo", m_uri__HEAD => undef}); is($conf->entries, 1); is($conf->matching_items("http://www.example.com/foo"), 0); SKIP: { my $res; eval { $res = $conf->matching_items(0); }; skip "can fails on non-object", 2 if $@; is($res, 0); eval { $res = $conf->matching(0); }; ok(!defined $res); } $conf = HTTP::Config->new; $conf->add_item("always"); $conf->add_item("GET", m_method => ["GET", "HEAD"]); $conf->add_item("POST", m_method => "POST"); $conf->add_item(".com", m_domain => ".com"); $conf->add_item("secure", m_secure => 1); $conf->add_item("not secure", m_secure => 0); $conf->add_item("slash", m_host_port => "www.example.com:80", m_path_prefix => "/"); $conf->add_item("u:p", m_host_port => "www.example.com:80", m_path_prefix => "/foo"); $conf->add_item("success", m_code => "2xx"); is($conf->find(m_domain => ".com")->{item}, '.com'); my @found = $conf->find(m_domain => ".com"); is($#found, 0); is($found[0]->{item}, '.com'); use HTTP::Request; my $request = HTTP::Request->new(HEAD => "http://www.example.com/foo/bar"); $request->header("User-Agent" => "Moz/1.0"); is(j($conf->matching_items($request)), "u:p|slash|.com|GET|not secure|always"); $request->method("HEAD"); $request->uri->scheme("https"); is(j($conf->matching_items($request)), ".com|GET|secure|always"); is(j($conf->matching_items("http://activestate.com")), ".com|not secure|always"); use HTTP::Response; my $response = HTTP::Response->new(200 => "OK"); $response->content_type("text/plain"); $response->content("Hello, world!\n"); $response->request($request); is(j($conf->matching_items($response)), ".com|success|GET|secure|always"); $conf->remove_items(m_secure => 1); $conf->remove_items(m_domain => ".com"); is(j($conf->matching_items($response)), "success|GET|always"); $conf->remove_items; # start fresh is(j($conf->matching_items($response)), ""); $conf->add_item("any", "m_media_type" => "*/*"); $conf->add_item("text", m_media_type => "text/*"); $conf->add_item("html", m_media_type => "html"); $conf->add_item("HTML", m_media_type => "text/html"); $conf->add_item("xhtml", m_media_type => "xhtml"); is(j($conf->matching_items($response)), "text|any"); $response->content_type("application/xhtml+xml"); is(j($conf->matching_items($response)), "xhtml|html|any"); $response->content_type("text/html"); is(j($conf->matching_items($response)), "HTML|html|text|any"); $response->request(undef); is(j($conf->matching_items($response)), "HTML|html|text|any"); { my @warnings; local $SIG{__WARN__} = sub { push @warnings, grep { length } @_ }; my $conf = HTTP::Config->new; $conf->add(owner => undef, callback => sub { 'bleah' }); $conf->remove(owner => undef); ok(($conf->empty), 'found and removed the config entry'); is(scalar(@warnings), 0, 'no warnings') or diag('got warnings: ', explain(\@warnings)); @warnings = (); $conf->add_item("bond", m_header__user_agent => 'james/0.0.7'); my $request2 = HTTP::Request->new(HEAD => "http://www.example.com/foo/bar"); is(j($conf->matching_items($request2)), ''); is(scalar(@warnings), 0, 'no warnings') or diag('got warnings: ', explain(\@warnings)); } lib000755001750001750 015075217132 13564 5ustar00olafolaf000000000000HTTP-Message-7.01/tSecret.pm100644001750001750 33415075217132 15467 0ustar00olafolaf000000000000HTTP-Message-7.01/t/libpackage Secret; use strict; use warnings; use overload ( q{""} => 'to_string', fallback => 1, ); sub new { my ( $class, $s ) = @_; return bless sub {$s}, $class; } sub to_string { shift->(); } 1; message-old.t100644001750001750 512215075217132 15543 0ustar00olafolaf000000000000HTTP-Message-7.01/t# 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, < 9; use HTTP::Response; use HTTP::Headers::Auth; my $res = HTTP::Response->new(401); $res->push_header(WWW_Authenticate => qq(Foo realm="WallyWorld", foo=bar, Bar realm="WallyWorld2")); $res->push_header(WWW_Authenticate => qq(Basic Realm="WallyWorld", foo=bar, bar=baz)); note $res->as_string; my %auth = $res->www_authenticate; is(keys(%auth), 3); is($auth{basic}{realm}, "WallyWorld"); is($auth{bar}{realm}, "WallyWorld2"); $a = $res->www_authenticate; is($a, 'Foo realm="WallyWorld", foo=bar, Bar realm="WallyWorld2", Basic Realm="WallyWorld", foo=bar, bar=baz'); $res->www_authenticate("Basic realm=foo1"); note $res->as_string; $res->www_authenticate(Basic => {realm => "foo2"}); note $res->as_string; $res->www_authenticate(Basic => [realm => "foo3", foo=>33], Digest => {nonce=>"bar", foo=>'foo'}); note $res->as_string; my $string = $res->as_string; like($string, qr/WWW-Authenticate: Basic realm="foo3", foo=33/); like($string, qr/WWW-Authenticate: Digest (nonce=bar, foo=foo|foo=foo, nonce=bar)/); $res = HTTP::Response->new(401); my @auth = $res->proxy_authenticate('foo'); is_deeply(\@auth, []); @auth = $res->proxy_authenticate('foo', 'bar'); is_deeply(\@auth, ['foo', {}]); @auth = $res->proxy_authenticate('foo', {'bar' => '_'}); is_deeply(\@auth, ['foo', {}, 'bar', {}]); headers-etag.t100644001750001750 131115075217132 15670 0ustar00olafolaf000000000000HTTP-Message-7.01/tuse 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, ''); headers-util.t100644001750001750 250215075217132 15730 0ustar00olafolaf000000000000HTTP-Message-7.01/tuse strict; use warnings; use Test::More; use HTTP::Headers::Util qw(split_header_words join_header_words); my @s_tests = ( ["foo" => "foo"], ["foo=bar" => "foo=bar"], [" foo " => "foo"], ["foo=" => 'foo=""'], ["foo=bar bar=baz" => "foo=bar; bar=baz"], ["foo=bar;bar=baz" => "foo=bar; bar=baz"], ['foo bar baz' => "foo; bar; baz"], ['foo="\"" bar="\\\\"' => 'foo="\""; bar="\\\\"'], ['foo,,,bar' => 'foo, bar'], ['foo=bar,bar=baz' => 'foo=bar, bar=baz'], ['TEXT/HTML; CHARSET=ISO-8859-1' => 'text/html; charset=ISO-8859-1'], ['foo="bar"; port="80,81"; discard, bar=baz' => 'foo=bar; port="80,81"; discard, bar=baz'], ['Basic realm="\"foo\\\\bar\""' => 'basic; realm="\"foo\\\\bar\""'], ); plan tests => @s_tests + 4; for (@s_tests) { my($arg, $expect) = @$_; my @arg = ref($arg) ? @$arg : $arg; my $res = join_header_words(split_header_words(@arg)); is($res, $expect); } note "# Extra tests\n"; # some extra tests is(join_header_words("foo" => undef, "bar" => "baz"), "foo; bar=baz"); is(join_header_words(), ""); is(join_header_words([]), ""); # ignore bare = is_deeply(split_header_words("foo; =;bar=baz"), ["foo" => undef, "bar" => "baz"]); message-parts.t100644001750001750 561215075217132 16122 0ustar00olafolaf000000000000HTTP-Message-7.01/tuse strict; use warnings; use Test::More; plan tests => 47; use HTTP::Message; use HTTP::Request::Common qw(POST); my $m = HTTP::Message->new; is(ref($m->headers), "HTTP::Headers"); is($m->headers_as_string, ""); is($m->content, ""); is(j($m->parts), ""); is($m->as_string, "\n"); my $m_clone = $m->clone; $m->push_header("Foo", 1); $m->add_content("foo"); is($m_clone->as_string, "\n"); is($m->headers_as_string, "Foo: 1\n"); is($m->header("Foo"), 1); is($m->as_string, "Foo: 1\n\nfoo\n"); is($m->as_string("\r\n"), "Foo: 1\r\n\r\nfoo"); is(j($m->parts), ""); $m->content_type("message/foo"); $m->content(<parts; is(@parts, 1); my $m2 = $parts[0]; is(ref($m2), "HTTP::Message"); is($m2->header("h1"), 1); is($m2->header("h2"), "2\n 3"); is($m2->header("h3"), " abc"); is($m2->content, "FooBar\n"); is($m2->as_string, $m->content); is(j($m2->parts), ""); $m = POST("http://www.example.com", Content_Type => 'form-data', Content => [ foo => 1, bar => 2 ]); is($m->content_type, "multipart/form-data"); @parts = $m->parts; is(@parts, 2); is($parts[0]->header("Content-Disposition"), 'form-data; name="foo"'); is($parts[0]->content, 1); is($parts[1]->header("Content-Disposition"), 'form-data; name="bar"'); is($parts[1]->content, 2); $m = HTTP::Message->new; $m->content_type("message/http"); $m->content(<parts; is(@parts, 1); is($parts[0]->method, "GET"); is($parts[0]->uri, "/"); is($parts[0]->protocol, "HTTP/1.0"); is($parts[0]->header("Host"), "example.com"); is($parts[0]->content, "How is this?\n"); $m = HTTP::Message->new; $m->content_type("message/http"); $m->content(<Hello world!

EOT @parts = $m->parts; is(@parts, 1); is($parts[0]->code, 200); is($parts[0]->message, "is"); is($parts[0]->protocol, "HTTP/1.1"); is($parts[0]->content_type, "text/html"); is($parts[0]->content, "

Hello world!

\n"); $m->parts(HTTP::Request->new("GET", "http://www.example.com")); is($m->as_string, "Content-Type: message/http\n\nGET http://www.example.com\r\n\r\n"); $m = HTTP::Request->new("PUT", "http://www.example.com"); $m->parts(HTTP::Message->new([Foo => 1], "abc\n"), HTTP::Message->new([Bar => 2], "def")); is($m->as_string, <content(<parts; is(@parts, 1); is($parts[0]->content_length, 4); is($parts[0]->content, "abcd"); $m->content(" --xYzZY Content-Length: 4 efgh --xYzZY Content-Length: 3 ijk --xYzZY--"); @parts = $m->parts; is(@parts, 2); is($parts[0]->content_length, 4); is($parts[0]->content, "efgh"); is($parts[1]->content_length, 3); is($parts[1]->content, "ijk"); sub j { join(":", @_) } HTTP000755001750001750 015075217132 14100 5ustar00olafolaf000000000000HTTP-Message-7.01/libConfig.pm100644001750001750 2704515075217132 16033 0ustar00olafolaf000000000000HTTP-Message-7.01/lib/HTTPpackage HTTP::Config; use strict; use warnings; our $VERSION = '7.01'; 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 7.01 =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 Status.pm100644001750001750 3351515075217132 16110 0ustar00olafolaf000000000000HTTP-Message-7.01/lib/HTTPpackage HTTP::Status; use strict; use warnings; our $VERSION = '7.01'; 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 status_constant_name status_codes); # 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', 306 => '(Unused)', # RFC 9110: Previously used and reserved 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 => 'Content Too Large', 414 => 'URI Too Long', 415 => 'Unsupported Media Type', 416 => 'Range Not Satisfiable', # RFC 7233: Range Requests 417 => 'Expectation Failed', 418 => "I'm a teapot", # RFC 2324: RFC9110 reserved it # 419 .. 420 421 => 'Misdirected Request', # RFC 7540: HTTP/2 422 => 'Unprocessable Content', # RFC 9110: 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: Transparent 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 449 => 'Retry with', # microsoft 509 => 'Bandwidth Limit Exceeded', # Apache / cPanel ); my %StatusCodeName; my $mnemonicCode = ''; my ($code, $message); while (($code, $message) = each %StatusCode) { next if $message eq '(Unused)'; # create mnemonic subroutines $message =~ s/I'm/I am/; $message =~ tr/a-z \-/A-Z__/; my $constant_name = "HTTP_".$message; $mnemonicCode .= "sub $constant_name () { $code }\n"; $mnemonicCode .= "*RC_$message = \\&HTTP_$message;\n"; # legacy $mnemonicCode .= "push(\@EXPORT_OK, 'HTTP_$message');\n"; $mnemonicCode .= "push(\@EXPORT, 'RC_$message');\n"; $StatusCodeName{$code} = $constant_name } 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 = ( UNPROCESSABLE_ENTITY => \&HTTP_UNPROCESSABLE_CONTENT, PAYLOAD_TOO_LARGE => \&HTTP_CONTENT_TOO_LARGE, REQUEST_ENTITY_TOO_LARGE => \&HTTP_CONTENT_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 status_constant_name ($) { exists($StatusCodeName{$_[0]}) ? $StatusCodeName{$_[0]} : undef; } 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 ); } sub status_codes { %StatusCode; } 1; =pod =encoding UTF-8 =head1 NAME HTTP::Status - HTTP Status code processing =head1 VERSION version 7.01 =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_CONTENT_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_CONTENT (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. For example, C will return C<"Not Found">. If the $code is not registered in the L then C is returned. =item status_constant_name( $code ) The status_constant_name() function will translate a status code to a string which has the name of the constant for that status code. For example, C will return C<"HTTP_NOT_FOUND">. If the C<$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. =item status_codes Returns a hash mapping numerical HTTP status code (e.g. 200) to text status messages (e.g. "OK") 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 message-brotli.t100644001750001750 216115075217132 16260 0ustar00olafolaf000000000000HTTP-Message-7.01/t#! perl -w use strict; use warnings; use Test::More; use Test::Needs 'IO::Compress::Brotli', 'IO::Uncompress::Brotli'; require HTTP::Message; subtest "decoding" => sub { my $m = HTTP::Message->new( [ "Content-Type" => "text/plain", "Content-Encoding" => "br, base64", ], "CwaASGVsbG8gd29ybGQhCgM=\n" ); is( $m->decoded_content, "Hello world!\n", "decoded_content() works" ); ok( $m->decode, "decode() works" ); is( $m->content, "Hello world!\n", "... and content() is correct" ); }; subtest "encoding" => sub { my $m = HTTP::Message->new( [ "Content-Type" => "text/plain", ], "Hello world!" ); ok( $m->encode("br"), "set encoding to 'br" ); is( $m->header("Content-Encoding"), "br", "... and Content-Encoding is set" ); isnt( $m->content, "Hello world!", "... and the content has changed" ); is( $m->decoded_content, "Hello world!", "decoded_content() works" ); ok( $m->decode, "decode() works" ); is( $m->content, "Hello world!", "... and content() is correct" ); }; done_testing; Headers.pm100644001750001750 6060415075217132 16177 0ustar00olafolaf000000000000HTTP-Message-7.01/lib/HTTPpackage HTTP::Headers; use strict; use warnings; our $VERSION = '7.01'; use Clone qw(clone); 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 $_; } 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 7.01 =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 Message.pm100644001750001750 10256715075217132 16235 0ustar00olafolaf000000000000HTTP-Message-7.01/lib/HTTPpackage HTTP::Message; use strict; use warnings; our $VERSION = '7.01'; require HTTP::Headers; require Carp; our $MAXIMUM_BODY_SIZE; 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, '_max_body_size' => $HTTP::Message::MAXIMUM_BODY_SIZE, }, $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 max_body_size { my $self = $_[0]; my $old = $self->{_max_body_size}; $self->_set_max_body_size($_[1]) if @_ > 1; return $old; } sub _set_max_body_size { my $self = $_[0]; $self->{_max_body_size} = $_[1]; } 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"; my $content_limit = exists $opt{ max_body_size } ? $opt{ max_body_size } : defined $self->max_body_size ? $self->max_body_size : undef ; my %limiter_options; if( defined $content_limit ) { %limiter_options = (LimitOutput => 1, Bufsize => $content_limit); }; 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 Compress::Raw::Zlib; # 'WANT_GZIP_OR_ZLIB', 'Z_BUF_ERROR'; if( ! $content_ref_iscopy and keys %limiter_options) { # Create a copy of the input because Zlib will overwrite it # :-( my $input = "$$content_ref"; $content_ref = \$input; $content_ref_iscopy++; }; my ($i, $status) = Compress::Raw::Zlib::Inflate->new( %limiter_options, ConsumeInput => 0, # overridden by Zlib if we have %limiter_options :-( WindowBits => Compress::Raw::Zlib::WANT_GZIP_OR_ZLIB(), ); my $res = $i->inflate( $content_ref, \my $output ); $res == Compress::Raw::Zlib::Z_BUF_ERROR() and Carp::croak("Decoded content would be larger than $content_limit octets"); $res == Compress::Raw::Zlib::Z_OK() or $res == Compress::Raw::Zlib::Z_STREAM_END() or die "Can't gunzip content: $res"; $content_ref = \$output; $content_ref_iscopy++; } elsif ($ce eq 'br') { require IO::Uncompress::Brotli; my $bro = IO::Uncompress::Brotli->create; my $output; if( defined $content_limit ) { $output = eval { $bro->decompress( $$content_ref, $content_limit ); } } else { $output = eval { $bro->decompress($$content_ref) }; } $@ and die "Can't unbrotli content: $@"; $content_ref = \$output; $content_ref_iscopy++; } elsif ($ce eq "x-bzip2" or $ce eq "bzip2") { require Compress::Raw::Bzip2; if( ! $content_ref_iscopy ) { # Create a copy of the input because Bzlib2 will overwrite it # :-( my $input = "$$content_ref"; $content_ref = \$input; $content_ref_iscopy++; }; my ($i, $status) = Compress::Raw::Bunzip2->new( 1, # appendInput 0, # consumeInput 0, # small $limiter_options{ LimitOutput } || 0, ); my $output; $output = "\0" x $limiter_options{ Bufsize } if $limiter_options{ Bufsize }; my $res = $i->bzinflate( $content_ref, \$output ); $res == Compress::Raw::Bzip2::BZ_OUTBUFF_FULL() and Carp::croak("Decoded content would be larger than $content_limit octets"); $res == Compress::Raw::Bzip2::BZ_OK() or $res == Compress::Raw::Bzip2::BZ_STREAM_END() or die "Can't bunzip content: $res"; $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 Compress::Raw::Zlib; push(@enc, "gzip", "x-gzip"); }; eval { require IO::Uncompress::Inflate; require IO::Uncompress::RawInflate; push(@enc, "deflate"); }; eval { require Compress::Raw::Bzip2; push(@enc, "x-bzip2", "bzip2"); }; eval { require IO::Uncompress::Brotli; push(@enc, 'br'); }; # 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 "br") { require IO::Compress::Brotli; my $output; eval { $output = IO::Compress::Brotli::bro($content) } or die "Can't brotli content: $@"; $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 7.01 =head1 SYNOPSIS use parent '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 overrides the charset parameter for text content. The value C can used to suppress decoding of the charset. =item C This overrides 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", "base64" and "br". 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) Request.pm100644001750001750 2135215075217132 16251 0ustar00olafolaf000000000000HTTP-Message-7.01/lib/HTTPpackage HTTP::Request; use strict; use warnings; our $VERSION = '7.01'; use parent '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($eol)); } 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 7.01 =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 message-charset.t100644001750001750 615315075217132 16423 0ustar00olafolaf000000000000HTTP-Message-7.01/tuse 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');