]> Dogcows Code - chaz/p5-HTTP-AnyUA/commitdiff
Version 0.900 dist
authorCharles McGarvey <chazmcgarvey@brokenzipper.com>
Sun, 12 Mar 2017 01:31:00 +0000 (18:31 -0700)
committerCharles McGarvey <chazmcgarvey@brokenzipper.com>
Sun, 12 Mar 2017 01:31:00 +0000 (18:31 -0700)
50 files changed:
.travis.yml [new file with mode: 0644]
Changes [new file with mode: 0644]
LICENSE [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
META.json [new file with mode: 0644]
META.yml [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
lib/HTTP/AnyUA.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Backend.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Backend/AnyEvent/HTTP.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Backend/Furl.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Backend/HTTP/AnyUA.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Backend/HTTP/Tiny.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Backend/LWP/UserAgent.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Backend/Mojo/UserAgent.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Backend/Net/Curl/Easy.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Util.pm [new file with mode: 0644]
t/00-compile.t [new file with mode: 0644]
t/00-report-prereqs.dd [new file with mode: 0644]
t/00-report-prereqs.t [new file with mode: 0644]
t/01-new.t [new file with mode: 0644]
t/02-shortcuts.t [new file with mode: 0644]
t/03-post_form.t [new file with mode: 0644]
t/04-internal-exception.t [new file with mode: 0644]
t/10-get.t [new file with mode: 0644]
t/11-post.t [new file with mode: 0644]
t/12-put.t [new file with mode: 0644]
t/13-head.t [new file with mode: 0644]
t/14-delete.t [new file with mode: 0644]
t/15-custom-method.t [new file with mode: 0644]
t/20-data_callback.t [new file with mode: 0644]
t/21-basic-auth.t [new file with mode: 0644]
t/22-redirects.t [new file with mode: 0644]
t/23-content-coderef.t [new file with mode: 0644]
t/app.psgi [new file with mode: 0644]
t/lib/MockBackend.pm [new file with mode: 0644]
t/lib/Server.pm [new file with mode: 0644]
t/lib/Util.pm [new file with mode: 0644]
xt/author/clean-namespaces.t [new file with mode: 0644]
xt/author/critic.t [new file with mode: 0644]
xt/author/eol.t [new file with mode: 0644]
xt/author/no-tabs.t [new file with mode: 0644]
xt/author/pod-coverage.t [new file with mode: 0644]
xt/author/pod-no404s.t [new file with mode: 0644]
xt/author/pod-syntax.t [new file with mode: 0644]
xt/author/portability.t [new file with mode: 0644]
xt/release/cpan-changes.t [new file with mode: 0644]
xt/release/distmeta.t [new file with mode: 0644]
xt/release/minimum-version.t [new file with mode: 0644]

diff --git a/.travis.yml b/.travis.yml
new file mode 100644 (file)
index 0000000..6e0e2fe
--- /dev/null
@@ -0,0 +1,23 @@
+sudo: false
+language: perl
+perl:
+   - '5.24'
+   - '5.22'
+   - '5.20'
+   - '5.18'
+   - '5.16'
+   - '5.14'
+   - '5.12'
+   - '5.10'
+   - '5.8'
+matrix:
+   allow_failures:
+      - perl: '5.8'
+   fast_finish: true
+branches:
+   only: /^(dist|build\/.*)$/
+before_install:
+   - rm .travis.yml
+   - export AUTHOR_TESTING=0
+install:
+   - cpanm --installdeps --verbose  .
diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..42421d4
--- /dev/null
+++ b/Changes
@@ -0,0 +1,6 @@
+Revision history for HTTP-AnyUA.
+
+0.900     2017-03-11 18:28:59-07:00 MST7MDT
+
+  * Initial release
+
diff --git a/LICENSE b/LICENSE
new file mode 100644 (file)
index 0000000..a2abd4e
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,379 @@
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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) 2017 by Charles McGarvey.
+
+This is free software, licensed under:
+
+  The GNU General Public License, Version 1, February 1989
+
+                    GNU GENERAL PUBLIC LICENSE
+                     Version 1, February 1989
+
+ Copyright (C) 1989 Free Software Foundation, Inc.
+ 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The license agreements of most software companies try to keep users
+at the mercy of those companies.  By contrast, our General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  The
+General Public License applies to the Free Software Foundation's
+software and to any other program whose authors commit to using it.
+You can use it for your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Specifically, the General Public License is designed to make
+sure that you have the freedom to give away or sell copies of free
+software, that you receive source code or can get it if you want it,
+that you can change the software or use pieces of it in new free
+programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of a such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must tell them their rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any program or other work which
+contains a notice placed by the copyright holder saying it may be
+distributed under the terms of this General Public License.  The
+"Program", below, refers to any such program or work, and a "work based
+on the Program" means either the Program or any work containing the
+Program or a portion of it, either verbatim or with modifications.  Each
+licensee is addressed as "you".
+
+  1. You may copy and distribute verbatim copies of the Program's source
+code as you receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice and
+disclaimer of warranty; keep intact all the notices that refer to this
+General Public License and to the absence of any warranty; and give any
+other recipients of the Program a copy of this General Public License
+along with the Program.  You may charge a fee for the physical act of
+transferring a copy.
+
+  2. You may modify your copy or copies of the Program or any portion of
+it, and copy and distribute such modifications under the terms of Paragraph
+1 above, provided that you also do the following:
+
+    a) cause the modified files to carry prominent notices stating that
+    you changed the files and the date of any change; and
+
+    b) cause the whole of any work that you distribute or publish, that
+    in whole or in part contains the Program or any part thereof, either
+    with or without modifications, to be licensed at no charge to all
+    third parties under the terms of this General Public License (except
+    that you may choose to grant warranty protection to some or all
+    third parties, at your option).
+
+    c) If the modified program normally reads commands interactively when
+    run, you must cause it, when started running for such interactive use
+    in the simplest and most usual way, to print or display an
+    announcement including an appropriate copyright notice and a notice
+    that there is no warranty (or else, saying that you provide a
+    warranty) and that users may redistribute the program under these
+    conditions, and telling the user how to view a copy of this General
+    Public License.
+
+    d) You may charge a fee for the physical act of transferring a
+    copy, and you may at your option offer warranty protection in
+    exchange for a fee.
+
+Mere aggregation of another independent work with the Program (or its
+derivative) on a volume of a storage or distribution medium does not bring
+the other work under the scope of these terms.
+
+  3. You may copy and distribute the Program (or a portion or derivative of
+it, under Paragraph 2) in object code or executable form under the terms of
+Paragraphs 1 and 2 above provided that you also do one of the following:
+
+    a) accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of
+    Paragraphs 1 and 2 above; or,
+
+    b) accompany it with a written offer, valid for at least three
+    years, to give any third party free (except for a nominal charge
+    for the cost of distribution) a complete machine-readable copy of the
+    corresponding source code, to be distributed under the terms of
+    Paragraphs 1 and 2 above; or,
+
+    c) accompany it with the information you received as to where the
+    corresponding source code may be obtained.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form alone.)
+
+Source code for a work means the preferred form of the work for making
+modifications to it.  For an executable file, complete source code means
+all the source code for all modules it contains; but, as a special
+exception, it need not include source code for modules which are standard
+libraries that accompany the operating system on which the executable
+file runs, or for standard header files or definitions files that
+accompany that operating system.
+
+  4. You may not copy, modify, sublicense, distribute or transfer the
+Program except as expressly provided under this General Public License.
+Any attempt otherwise to copy, modify, sublicense, distribute or transfer
+the Program is void, and will automatically terminate your rights to use
+the Program under this License.  However, parties who have received
+copies, or rights to use copies, from you under this General Public
+License will not have their licenses terminated so long as such parties
+remain in full compliance.
+
+  5. By copying, distributing or modifying the Program (or any work based
+on the Program) you indicate your acceptance of this license to do so,
+and all its terms and conditions.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the original
+licensor to copy, distribute or modify the Program subject to these
+terms and conditions.  You may not impose any further restrictions on the
+recipients' exercise of the rights granted herein.
+
+  7. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of the license which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+the license, you may choose any version ever published by the Free Software
+Foundation.
+
+  8. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+                            NO WARRANTY
+
+  9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+                     END OF TERMS AND CONDITIONS
+
+        Appendix: How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to humanity, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+  To do so, attach the following notices to the program.  It is safest to
+attach them to the start of each source file to most effectively convey
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) 19yy  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 1, or (at your option)
+    any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA  02110-1301 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) 19xx name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the
+appropriate parts of the General Public License.  Of course, the
+commands you use may be called something other than `show w' and `show
+c'; they could even be mouse-clicks or menu items--whatever suits your
+program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  program `Gnomovision' (a program to direct compilers to make passes
+  at assemblers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+That's all there is to it!
+
+
+--- The Artistic License 1.0 ---
+
+This software is Copyright (c) 2017 by Charles McGarvey.
+
+This is free software, licensed under:
+
+  The Artistic License 1.0
+
+The Artistic License
+
+Preamble
+
+The intent of this document is to state the conditions under which a Package
+may be copied, such that the Copyright Holder maintains some semblance of
+artistic control over the development of the package, while giving the users of
+the package the right to use and distribute the Package in a more-or-less
+customary fashion, plus the right to make reasonable modifications.
+
+Definitions:
+
+  - "Package" refers to the collection of files distributed by the Copyright
+    Holder, and derivatives of that collection of files created through
+    textual modification. 
+  - "Standard Version" refers to such a Package if it has not been modified,
+    or has been modified in accordance with the wishes of the Copyright
+    Holder. 
+  - "Copyright Holder" is whoever is named in the copyright or copyrights for
+    the package. 
+  - "You" is you, if you're thinking about copying or distributing this Package.
+  - "Reasonable copying fee" is whatever you can justify on the basis of media
+    cost, duplication charges, time of people involved, and so on. (You will
+    not be required to justify it to the Copyright Holder, but only to the
+    computing community at large as a market that must bear the fee.) 
+  - "Freely Available" means that no fee is charged for the item itself, though
+    there may be fees involved in handling the item. It also means that
+    recipients of the item may redistribute it under the same conditions they
+    received it. 
+
+1. You may make and give away verbatim copies of the source form of the
+Standard Version of this Package without restriction, provided that you
+duplicate all of the original copyright notices and associated disclaimers.
+
+2. You may apply bug fixes, portability fixes and other modifications derived
+from the Public Domain or from the Copyright Holder. A Package modified in such
+a way shall still be considered the Standard Version.
+
+3. You may otherwise modify your copy of this Package in any way, provided that
+you insert a prominent notice in each changed file stating how and when you
+changed that file, and provided that you do at least ONE of the following:
+
+  a) place your modifications in the Public Domain or otherwise make them
+     Freely Available, such as by posting said modifications to Usenet or an
+     equivalent medium, or placing the modifications on a major archive site
+     such as ftp.uu.net, or by allowing the Copyright Holder to include your
+     modifications in the Standard Version of the Package.
+
+  b) use the modified Package only within your corporation or organization.
+
+  c) rename any non-standard executables so the names do not conflict with
+     standard executables, which must also be provided, and provide a separate
+     manual page for each non-standard executable that clearly documents how it
+     differs from the Standard Version.
+
+  d) make other distribution arrangements with the Copyright Holder.
+
+4. You may distribute the programs of this Package in object code or executable
+form, provided that you do at least ONE of the following:
+
+  a) distribute a Standard Version of the executables and library files,
+     together with instructions (in the manual page or equivalent) on where to
+     get the Standard Version.
+
+  b) accompany the distribution with the machine-readable source of the Package
+     with your modifications.
+
+  c) accompany any non-standard executables with their corresponding Standard
+     Version executables, giving the non-standard executables non-standard
+     names, and clearly documenting the differences in manual pages (or
+     equivalent), together with instructions on where to get the Standard
+     Version.
+
+  d) make other distribution arrangements with the Copyright Holder.
+
+5. You may charge a reasonable copying fee for any distribution of this
+Package.  You may charge any fee you choose for support of this Package. You
+may not charge a fee for this Package itself. However, you may distribute this
+Package in aggregate with other (possibly commercial) programs as part of a
+larger (possibly commercial) software distribution provided that you do not
+advertise this Package as a product of your own.
+
+6. The scripts and library files supplied as input to or produced as output
+from the programs of this Package do not automatically fall under the copyright
+of this Package, but belong to whomever generated them, and may be sold
+commercially, and may be aggregated with this Package.
+
+7. C or perl subroutines supplied by you and linked into this Package shall not
+be considered part of this Package.
+
+8. The name of the Copyright Holder may not be used to endorse or promote
+products derived from this software without specific prior written permission.
+
+9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+The End
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644 (file)
index 0000000..3f765e2
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,51 @@
+# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.009.
+.travis.yml
+Changes
+LICENSE
+MANIFEST
+META.json
+META.yml
+Makefile.PL
+README
+lib/HTTP/AnyUA.pm
+lib/HTTP/AnyUA/Backend.pm
+lib/HTTP/AnyUA/Backend/AnyEvent/HTTP.pm
+lib/HTTP/AnyUA/Backend/Furl.pm
+lib/HTTP/AnyUA/Backend/HTTP/AnyUA.pm
+lib/HTTP/AnyUA/Backend/HTTP/Tiny.pm
+lib/HTTP/AnyUA/Backend/LWP/UserAgent.pm
+lib/HTTP/AnyUA/Backend/Mojo/UserAgent.pm
+lib/HTTP/AnyUA/Backend/Net/Curl/Easy.pm
+lib/HTTP/AnyUA/Util.pm
+t/00-compile.t
+t/00-report-prereqs.dd
+t/00-report-prereqs.t
+t/01-new.t
+t/02-shortcuts.t
+t/03-post_form.t
+t/04-internal-exception.t
+t/10-get.t
+t/11-post.t
+t/12-put.t
+t/13-head.t
+t/14-delete.t
+t/15-custom-method.t
+t/20-data_callback.t
+t/21-basic-auth.t
+t/22-redirects.t
+t/23-content-coderef.t
+t/app.psgi
+t/lib/MockBackend.pm
+t/lib/Server.pm
+t/lib/Util.pm
+xt/author/clean-namespaces.t
+xt/author/critic.t
+xt/author/eol.t
+xt/author/no-tabs.t
+xt/author/pod-coverage.t
+xt/author/pod-no404s.t
+xt/author/pod-syntax.t
+xt/author/portability.t
+xt/release/cpan-changes.t
+xt/release/distmeta.t
+xt/release/minimum-version.t
diff --git a/META.json b/META.json
new file mode 100644 (file)
index 0000000..6e524f4
--- /dev/null
+++ b/META.json
@@ -0,0 +1,158 @@
+{
+   "abstract" : "An HTTP user agent programming interface unification layer",
+   "author" : [
+      "Charles McGarvey <chazmcgarvey@brokenzipper.com>"
+   ],
+   "dynamic_config" : 0,
+   "generated_by" : "Dist::Zilla version 6.009, CPAN::Meta::Converter version 2.150005",
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : 2
+   },
+   "name" : "HTTP-AnyUA",
+   "no_index" : {
+      "directory" : [
+         "eg",
+         "share",
+         "shares",
+         "t",
+         "xt"
+      ]
+   },
+   "prereqs" : {
+      "configure" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : "0"
+         }
+      },
+      "develop" : {
+         "requires" : {
+            "Dist::Zilla" : "5",
+            "Dist::Zilla::Plugin::Prereqs" : "0",
+            "Dist::Zilla::PluginBundle::Author::CCM" : "0",
+            "English" : "0",
+            "Pod::Coverage::TrustPod" : "0",
+            "Software::License::Perl_5" : "0",
+            "Test::CPAN::Changes" : "0.19",
+            "Test::CPAN::Meta" : "0",
+            "Test::CleanNamespaces" : "0.15",
+            "Test::EOL" : "0",
+            "Test::MinimumVersion" : "0",
+            "Test::More" : "0.96",
+            "Test::NoTabs" : "0",
+            "Test::Pod" : "1.41",
+            "Test::Pod::Coverage" : "1.08",
+            "Test::Pod::No404s" : "0",
+            "Test::Portability::Files" : "0"
+         }
+      },
+      "runtime" : {
+         "requires" : {
+            "Carp" : "0",
+            "Exporter" : "0",
+            "Fcntl" : "0",
+            "Future" : "0",
+            "MIME::Base64" : "0",
+            "Module::Loader" : "0",
+            "Scalar::Util" : "0",
+            "Time::Local" : "0",
+            "bytes" : "0",
+            "parent" : "0",
+            "perl" : "5.010",
+            "strict" : "0",
+            "warnings" : "0"
+         },
+         "suggests" : {
+            "HTTP::Tiny" : "0"
+         }
+      },
+      "test" : {
+         "recommends" : {
+            "CPAN::Meta" : "2.120900"
+         },
+         "requires" : {
+            "ExtUtils::MakeMaker" : "0",
+            "File::Spec" : "0",
+            "IO::Handle" : "0",
+            "IPC::Open3" : "0",
+            "Test2::API" : "0",
+            "Test::Exception" : "0",
+            "Test::More" : "0",
+            "blib" : "1.01",
+            "lib" : "0"
+         },
+         "suggests" : {
+            "AnyEvent::HTTP" : "0",
+            "Furl" : "0",
+            "HTTP::Tiny" : "0",
+            "JSON" : "0",
+            "LWP::UserAgent" : "0",
+            "Mojo::UserAgent" : "0",
+            "Net::Curl::Easy" : "0",
+            "Plack::Runner" : "0",
+            "Starman" : "0"
+         }
+      }
+   },
+   "provides" : {
+      "HTTP::AnyUA" : {
+         "file" : "lib/HTTP/AnyUA.pm",
+         "version" : "0.900"
+      },
+      "HTTP::AnyUA::Backend" : {
+         "file" : "lib/HTTP/AnyUA/Backend.pm",
+         "version" : "0.900"
+      },
+      "HTTP::AnyUA::Backend::AnyEvent::HTTP" : {
+         "file" : "lib/HTTP/AnyUA/Backend/AnyEvent/HTTP.pm",
+         "version" : "0.900"
+      },
+      "HTTP::AnyUA::Backend::Furl" : {
+         "file" : "lib/HTTP/AnyUA/Backend/Furl.pm",
+         "version" : "0.900"
+      },
+      "HTTP::AnyUA::Backend::HTTP::AnyUA" : {
+         "file" : "lib/HTTP/AnyUA/Backend/HTTP/AnyUA.pm",
+         "version" : "0.900"
+      },
+      "HTTP::AnyUA::Backend::HTTP::Tiny" : {
+         "file" : "lib/HTTP/AnyUA/Backend/HTTP/Tiny.pm",
+         "version" : "0.900"
+      },
+      "HTTP::AnyUA::Backend::LWP::UserAgent" : {
+         "file" : "lib/HTTP/AnyUA/Backend/LWP/UserAgent.pm",
+         "version" : "0.900"
+      },
+      "HTTP::AnyUA::Backend::Mojo::UserAgent" : {
+         "file" : "lib/HTTP/AnyUA/Backend/Mojo/UserAgent.pm",
+         "version" : "0.900"
+      },
+      "HTTP::AnyUA::Backend::Net::Curl::Easy" : {
+         "file" : "lib/HTTP/AnyUA/Backend/Net/Curl/Easy.pm",
+         "version" : "0.900"
+      },
+      "HTTP::AnyUA::Util" : {
+         "file" : "lib/HTTP/AnyUA/Util.pm",
+         "version" : "0.900"
+      }
+   },
+   "release_status" : "stable",
+   "resources" : {
+      "bugtracker" : {
+         "web" : "https://github.com/chazmcgarvey/HTTP-AnyUA/issues"
+      },
+      "homepage" : "https://github.com/chazmcgarvey/HTTP-AnyUA",
+      "repository" : {
+         "type" : "git",
+         "url" : "https://github.com/chazmcgarvey/HTTP-AnyUA.git",
+         "web" : "https://github.com/chazmcgarvey/HTTP-AnyUA"
+      }
+   },
+   "version" : "0.900",
+   "x_authority" : "cpan:CCM",
+   "x_serialization_backend" : "Cpanel::JSON::XS version 3.0225"
+}
+
diff --git a/META.yml b/META.yml
new file mode 100644 (file)
index 0000000..c83c73e
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,82 @@
+---
+abstract: 'An HTTP user agent programming interface unification layer'
+author:
+  - 'Charles McGarvey <chazmcgarvey@brokenzipper.com>'
+build_requires:
+  ExtUtils::MakeMaker: '0'
+  File::Spec: '0'
+  IO::Handle: '0'
+  IPC::Open3: '0'
+  Test2::API: '0'
+  Test::Exception: '0'
+  Test::More: '0'
+  blib: '1.01'
+  lib: '0'
+configure_requires:
+  ExtUtils::MakeMaker: '0'
+dynamic_config: 0
+generated_by: 'Dist::Zilla version 6.009, CPAN::Meta::Converter version 2.150005'
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: '1.4'
+name: HTTP-AnyUA
+no_index:
+  directory:
+    - eg
+    - share
+    - shares
+    - t
+    - xt
+provides:
+  HTTP::AnyUA:
+    file: lib/HTTP/AnyUA.pm
+    version: '0.900'
+  HTTP::AnyUA::Backend:
+    file: lib/HTTP/AnyUA/Backend.pm
+    version: '0.900'
+  HTTP::AnyUA::Backend::AnyEvent::HTTP:
+    file: lib/HTTP/AnyUA/Backend/AnyEvent/HTTP.pm
+    version: '0.900'
+  HTTP::AnyUA::Backend::Furl:
+    file: lib/HTTP/AnyUA/Backend/Furl.pm
+    version: '0.900'
+  HTTP::AnyUA::Backend::HTTP::AnyUA:
+    file: lib/HTTP/AnyUA/Backend/HTTP/AnyUA.pm
+    version: '0.900'
+  HTTP::AnyUA::Backend::HTTP::Tiny:
+    file: lib/HTTP/AnyUA/Backend/HTTP/Tiny.pm
+    version: '0.900'
+  HTTP::AnyUA::Backend::LWP::UserAgent:
+    file: lib/HTTP/AnyUA/Backend/LWP/UserAgent.pm
+    version: '0.900'
+  HTTP::AnyUA::Backend::Mojo::UserAgent:
+    file: lib/HTTP/AnyUA/Backend/Mojo/UserAgent.pm
+    version: '0.900'
+  HTTP::AnyUA::Backend::Net::Curl::Easy:
+    file: lib/HTTP/AnyUA/Backend/Net/Curl/Easy.pm
+    version: '0.900'
+  HTTP::AnyUA::Util:
+    file: lib/HTTP/AnyUA/Util.pm
+    version: '0.900'
+requires:
+  Carp: '0'
+  Exporter: '0'
+  Fcntl: '0'
+  Future: '0'
+  MIME::Base64: '0'
+  Module::Loader: '0'
+  Scalar::Util: '0'
+  Time::Local: '0'
+  bytes: '0'
+  parent: '0'
+  perl: '5.010'
+  strict: '0'
+  warnings: '0'
+resources:
+  bugtracker: https://github.com/chazmcgarvey/HTTP-AnyUA/issues
+  homepage: https://github.com/chazmcgarvey/HTTP-AnyUA
+  repository: https://github.com/chazmcgarvey/HTTP-AnyUA.git
+version: '0.900'
+x_authority: cpan:CCM
+x_serialization_backend: 'YAML::Tiny version 1.70'
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..f04ca02
--- /dev/null
@@ -0,0 +1,85 @@
+# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.009.
+use strict;
+use warnings;
+
+use 5.010;
+
+use ExtUtils::MakeMaker;
+
+my %WriteMakefileArgs = (
+  "ABSTRACT" => "An HTTP user agent programming interface unification layer",
+  "AUTHOR" => "Charles McGarvey <chazmcgarvey\@brokenzipper.com>",
+  "CONFIGURE_REQUIRES" => {
+    "ExtUtils::MakeMaker" => 0
+  },
+  "DISTNAME" => "HTTP-AnyUA",
+  "LICENSE" => "perl",
+  "MIN_PERL_VERSION" => "5.010",
+  "NAME" => "HTTP::AnyUA",
+  "PREREQ_PM" => {
+    "Carp" => 0,
+    "Exporter" => 0,
+    "Fcntl" => 0,
+    "Future" => 0,
+    "MIME::Base64" => 0,
+    "Module::Loader" => 0,
+    "Scalar::Util" => 0,
+    "Time::Local" => 0,
+    "bytes" => 0,
+    "parent" => 0,
+    "strict" => 0,
+    "warnings" => 0
+  },
+  "TEST_REQUIRES" => {
+    "ExtUtils::MakeMaker" => 0,
+    "File::Spec" => 0,
+    "IO::Handle" => 0,
+    "IPC::Open3" => 0,
+    "Test2::API" => 0,
+    "Test::Exception" => 0,
+    "Test::More" => 0,
+    "blib" => "1.01",
+    "lib" => 0
+  },
+  "VERSION" => "0.900",
+  "test" => {
+    "TESTS" => "t/*.t"
+  }
+);
+
+
+my %FallbackPrereqs = (
+  "Carp" => 0,
+  "Exporter" => 0,
+  "ExtUtils::MakeMaker" => 0,
+  "Fcntl" => 0,
+  "File::Spec" => 0,
+  "Future" => 0,
+  "IO::Handle" => 0,
+  "IPC::Open3" => 0,
+  "MIME::Base64" => 0,
+  "Module::Loader" => 0,
+  "Scalar::Util" => 0,
+  "Test2::API" => 0,
+  "Test::Exception" => 0,
+  "Test::More" => 0,
+  "Time::Local" => 0,
+  "blib" => "1.01",
+  "bytes" => 0,
+  "lib" => 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);
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..17ad969
--- /dev/null
+++ b/README
@@ -0,0 +1,500 @@
+NAME
+
+    HTTP::AnyUA - An HTTP user agent programming interface unification
+    layer
+
+VERSION
+
+    version 0.900
+
+SYNOPSIS
+
+        my $any_ua = HTTP::AnyUA->new(ua => LWP::UserAgent->new);
+        # OR: my $any_ua = HTTP::AnyUA->new(ua => Furl->new);
+        # OR: my $any_ua = HTTP::AnyUA->new(ua => HTTP::Tiny->new);
+        # etc...
+    
+        my $response = $any_ua->get('http://www.example.com/');
+    
+        print "$response->{status} $response->{reason}\n";
+    
+        while (my ($k, $v) = each %{$response->{headers}}) {
+            for (ref $v eq 'ARRAY' ? @$v : $v) {
+                print "$k: $_\n";
+            }
+        }
+    
+        print $response->{content} if length $response->{content};
+    
+        ### Non-blocking user agents cause Future objects to be returned:
+    
+        my $any_ua = HTTP::AnyUA->new(ua => HTTP::Tiny->new, response_is_future => 1);
+        # OR: my $any_ua = HTTP::AnyUA->new(ua => 'AnyEvent::HTTP');
+        # OR: my $any_ua = HTTP::AnyUA->new(ua => Mojo::UserAgent->new);
+        # etc...
+    
+        my $future = $any_ua->get('http://www.example.com/');
+    
+        $future->on_done(sub {
+            my $response = shift;
+    
+            print "$response->{status} $response->{reason}\n";
+    
+            while (my ($k, $v) = each %{$response->{headers}}) {
+                for (ref $v eq 'ARRAY' ? @$v : $v) {
+                    print "$k: $_\n";
+                }
+            }
+    
+            print $response->{content} if length $response->{content};
+        });
+    
+        $future->on_fail(sub { print STDERR "Oh no!!\n" });
+
+DESCRIPTION
+
+    This module provides a small wrapper for unifying the programming
+    interfaces of several different actual user agents (HTTP clients) under
+    one familiar interface.
+
+    Rather than providing yet another programming interface for you to
+    learn, HTTP::AnyUA follows the HTTP::Tiny interface. This also means
+    that you can plug in any supported HTTP client (LWP::UserAgent, Furl,
+    etc.) and use it as if it were HTTP::Tiny.
+
+    There are a lot of great HTTP clients available for Perl, each with
+    different goals, different feature sets, and of course different
+    programming interfaces! If you're an end user, you can just pick one of
+    these clients according to the needs of your project (or personal
+    preference). But if you're writing a module that needs to interface
+    with a web server (like perhaps a RESTful API wrapper) and you want
+    your users to be able to use whatever HTTP client they want,
+    HTTP::AnyUA can help you support that!
+
+    It's a good idea to let the end user pick whatever HTTP client they
+    want to use, because they're the one who knows the requirements of
+    their application or script. If you're writing an event-driven
+    application, you'll need to use a non-blocking user agent like
+    Mojo::UserAgent. If you're writing a simple command-line script, you
+    may decide that your priority is to minimize dependencies and so may
+    want to go with HTTP::Tiny.
+
+    Unfortunately, many modules on CPAN are hardcoded to work with specific
+    HTTP clients, leaving the end user unable to use the HTTP client that
+    would be best for them. Although the end user won't -- or at least
+    doesn't need to -- use HTTP::AnyUA directly, they will benefit from
+    client choice if their third-party modules use HTTP::AnyUA or something
+    like it.
+
+    The primary goal of HTTP::AnyUA is to make it easy for module
+    developers to write HTTP code once that can work with any HTTP client
+    the end user may decide to plug in. A secondary goal is to make it easy
+    for anyone to add support for new or yet-unsupported user agents.
+
+ATTRIBUTES
+
+ ua
+
+    Get the user agent that was passed to "new".
+
+ response_is_future
+
+    Get and set whether or not responses are Future objects.
+
+ backend
+
+    Get the backend instance. You normally shouldn't need this.
+
+METHODS
+
+ new
+
+        $any_ua = HTTP::AnyUA->new(ua => $user_agent, %attr);
+        $any_ua = HTTP::AnyUA->new($user_agent, %attr);
+
+    Construct a new HTTP::AnyUA.
+
+ request
+
+        $response = $any_ua->request($method, $url);
+        $response = $any_ua->request($method, $url, \%options);
+
+    Make a request, get a response.
+
+    Compare to "request" in HTTP::Tiny.
+
+ get, head, put, post, delete
+
+        $response = $any_ua->get($url);
+        $response = $any_ua->get($url, \%options);
+        $response = $any_ua->head($url);
+        $response = $any_ua->head($url, \%options);
+        # etc.
+
+    Shortcuts for "request" where the method is the method name rather than
+    the first argument.
+
+    Compare to "get|head|put|post|delete" in HTTP::Tiny.
+
+ post_form
+
+        $response = $any_ua->post_form($url, $formdata);
+        $response = $any_ua->post_form($url, $formdata, \%options);
+
+    Does a POST request with the form data encoded and sets the
+    Content-Type header to application/x-www-form-urlencoded.
+
+    Compare to "post_form" in HTTP::Tiny.
+
+ mirror
+
+        $response = $http->mirror($url, $filepath, \%options);
+        if ($response->{success}) {
+            print "$filepath is up to date\n";
+        }
+
+    Does a GET request and saves the downloaded document to a file. If the
+    file already exists, its timestamp will be sent using the
+    If-Modified-Since request header (which you can override). If the
+    server responds with a 304 (Not Modified) status, the success field
+    will be true; this is usually only the case for 2XX statuses. If the
+    server responds with a Last-Modified header, the file will be updated
+    to have the same modification timestamp.
+
+    Compare to "mirror" in HTTP::Tiny. This version differs slightly in
+    that this returns internal exception responses (for cases like being
+    unable to write the file locally, etc.) rather than actually throwing
+    the exceptions. The reason for this is that exceptions as responses are
+    easier to deal with for non-blocking HTTP clients, and the fact that
+    this method throws exceptions in HTTP::Tiny seems like an inconsistency
+    in its interface.
+
+ register_backend
+
+        HTTP::AnyUA->register_backend($user_agent_package => $backend_package);
+        HTTP::AnyUA->register_backend('MyAgent' => 'MyBackend');    # HTTP::AnyUA::Backend::MyBackend
+        HTTP::AnyUA->register_backend('LWP::UserAgent' => '+SpecialBackend');   # SpecialBackend
+
+    Register a backend for a new user agent type or override a default
+    backend. Backend packages are relative to the HTTP::AnyUA::Backend::
+    namespace unless prefixed with a +.
+
+    If you only need to set a backend as a one-off thing, you could also
+    pass an instantiated backend to "new".
+
+SUPPORTED USER AGENTS
+
+      * AnyEvent::HTTP
+
+      * Furl
+
+      * HTTP::AnyUA - a little bit meta, but why not?
+
+      * HTTP::Tiny
+
+      * LWP::UserAgent
+
+      * Mojo::UserAgent
+
+      * Net::Curl::Easy
+
+    Any HTTP client that inherits from one of these in a well-behaved
+    manner should also be supported.
+
+    Of course, there are many other HTTP clients on CPAN that HTTP::AnyUA
+    doesn't yet support. I'm more than happy to help add support for
+    others, so send me a message if you know of an HTTP client that needs
+    support. See HTTP::AnyUA::Backend for how to write support for a new
+    HTTP client.
+
+NON-BLOCKING USER AGENTS
+
+    HTTP::AnyUA tries to target the HTTP::Tiny interface, which is a
+    blocking interface. This means that when you call "request", it is
+    supposed to not return until either the response is received or an
+    error occurs. This doesn't jive well with non-blocking HTTP clients
+    which expect the flow to reenter an event loop so that the request can
+    complete concurrently.
+
+    In order to reconcile this, a Future will be returned instead of the
+    normal hashref response if the wrapped HTTP client is non-blocking
+    (such as Mojo::UserAgent or AnyEvent::HTTP). This Future object may be
+    used to set up callbacks that will be called when the request is
+    completed. You can call "response_is_future" to know if the response is
+    or will be a Future.
+
+    This is typically okay for the end user; since they're the one who
+    chose which HTTP client to use in the first place, they should know
+    whether they should expect a Future or a direct response when they make
+    an HTTP request, but it does add some burden on you as a module writer
+    because if you ever need to examine the response, you may need to write
+    code like this:
+
+        my $resp = $any_ua->get('http://www.perl.org/');
+    
+        if ($any_ua->response_is_future) {
+            $resp->on_done(sub {
+                my $real_resp = shift;
+                handle_response($real_resp);
+            });
+        }
+        else {
+            handle_response($resp);     # response is the real response already
+        }
+
+    This actually isn't too annoying to deal with in practice, but you can
+    avoid it if you like by forcing the response to always be a Future.
+    Just set the "response_is_future" attribute. Then you don't need to do
+    an if-else because the response will always be the same type:
+
+        $any_ua->response_is_future(1);
+    
+        my $resp = $any_ua->get('http://www.perl.org/');
+    
+        $resp->on_done(sub {            # response is always a Future
+            my $real_resp = shift;
+            handle_response($real_resp);
+        });
+
+    Note that this doesn't make a blocking HTTP client magically
+    non-blocking. The call to "request" will still block if the client is
+    blocking, and your "done" callback will simply be fired immediately.
+    But this does let you write the same code in your module and have it
+    work regardless of whether the underlying HTTP client is blocking or
+    non-blocking.
+
+    The default behavior is to return a direct hashref response if the HTTP
+    client is blocking and a Future if the client is non-blocking. It's up
+    to you to decide whether or not to set response_is_future, and you
+    should also consider whether you want to expose the possibility of
+    either type of response or always returning Future objects to the end
+    user of your module. It doesn't matter for users who choose
+    non-blocking HTTP clients because they will be using Future objects
+    either way, but users who know they are using a blocking HTTP client
+    may appreciate not having to deal with Future objects at all.
+
+FREQUENTLY ASKED QUESTIONS
+
+ How do I set up proxying, SSL, cookies, timeout, etc.?
+
+    HTTP::AnyUA provides a common interface for using HTTP clients, not for
+    instantiating or configuring them. Proxying, SSL, and other custom
+    settings can be configured directly through the underlying HTTP client;
+    see the documentation for your particular user agent to learn how to
+    configure these things.
+
+    AnyEvent::HTTP is a bit of a special case because there is no
+    instantiated object representing the client. For this particular user
+    agent, you can configure the backend to pass a default set of options
+    whenever it calls http_request. See "options" in
+    HTTP::AnyUA::Backend::AnyEvent::HTTP:
+
+        $any_ua->backend->options({recurse => 5, timeout => 15});
+
+    If you are a module writer, you should probably receive a user agent
+    from your end user and leave this type of configuration up to them.
+
+ Why use HTTP::AnyUA instead of some other HTTP client?
+
+    Maybe you shouldn't. If you're an end user writing a script or
+    application, you can just pick the HTTP client that suits you best and
+    use it. For example, if you're writing a Mojolicious app, you're not
+    going wrong by using Mojo::UserAgent; it's loaded with features and is
+    well-integrated with that particular environment.
+
+    As an end user, you could wrap the HTTP client you pick in an
+    HTTP::AnyUA object, but the only reason to do this is if you prefer
+    using the HTTP::Tiny interface.
+
+    The real benefit of HTTP::AnyUA (or something like it) is if module
+    writers use it to allow end users of their modules to be able to plug
+    in whatever HTTP client they want. For example, a module that
+    implements an API wrapper that has a hard dependency on LWP::UserAgent
+    or even HTTP::Tiny is essentially useless for non-blocking
+    applications. If the same hypothetical module had been written using
+    HTTP::AnyUA then it would be useful in any scenario.
+
+ Why use the HTTP::Tiny interface?
+
+    The HTTP::Tiny interface is simple but provides all the essential
+    functionality needed for a capable HTTP client and little more. That
+    makes it easy to provide an implementation for, and it also makes it
+    straightforward for module authors to use.
+
+    Marrying the HTTP::Tiny interface with Future gives us these benefits
+    for both blocking and non-blocking modules and applications.
+
+SPECIFICATION
+
+    This section specifies a standard set of data structures that can be
+    used to make a request and get a response from a user agent. This is
+    the specification HTTP::AnyUA uses for its programming interface. It is
+    heavily based on HTTP::Tiny's interface, and parts of this
+    specification were adapted or copied verbatim from that module's
+    documentation. The intent is for this specification to be written such
+    that HTTP::Tiny is already a compliant implementor of the specification
+    (at least as of the specification's publication date).
+
+ The Request
+
+    A request is a tuple of the form (Method, URL) or (Method, URL,
+    Options).
+
+  Method
+
+    Method MUST be a string representing the HTTP verb. This is commonly
+    "GET", "POST", "HEAD", "DELETE", etc.
+
+  URL
+
+    URL MUST be a string representing the remote resource to be acted upon.
+    The URL MUST have unsafe characters escaped and international domain
+    names encoded before being passed to the user agent. A user agent MUST
+    generated a "Host" header based on the URL in accordance with RFC 2616;
+    a user agent MAY throw an error if a "Host" header is given with the
+    "headers".
+
+  Options
+
+    Options, if present, MUST be a hash reference containing zero or more
+    of the following keys with appropriate values. A user agent MAY support
+    more options than are specified here.
+
+   headers
+
+    The value for the headers key MUST be a hash reference containing zero
+    or more HTTP header names (as keys) and header values. The value for a
+    header MUST be either a string containing the header value OR an array
+    reference where each item is a string. If the value for a header is an
+    array reference, the user agent MUST output the header multiple times
+    with each value in the array.
+
+    User agents MAY may add headers, but SHOULD NOT replace user-specified
+    headers unless otherwise documented.
+
+   content
+
+    The value for the content key MUST be a string OR a code reference. If
+    the value is a string, its contents will be included with the request
+    as the body. If the value is a code reference, the referenced code will
+    be called iteratively to produce the body of the request, and the code
+    MUST return an empty string or undef value to indicate the end of the
+    request body. If the value is a code reference, a user agent SHOULD use
+    chunked transfer encoding if it supports it, otherwise a user agent MAY
+    completely drain the code of content before sending the request.
+
+   data_callback
+
+    The value for the data_callback key MUST be a code reference that will
+    be called zero or more times, once for each "chunk" of response body
+    received. A user agent MAY send the entire response body in one call.
+    The referenced code MUST be given two arguments; the first is a string
+    containing a chunk of the response body, the second is an in-progress
+    response.
+
+ The Response
+
+    A response MUST be a hash reference containg some required keys and
+    values. A response MAY contain some optional keys and values.
+
+  success
+
+    A response MUST include a success key, the value of which is a boolean
+    indicating whether or not the request is to be considered a success
+    (true is a success). Unless otherwise documented, a successful result
+    means that the operation returned a 2XX status code.
+
+  url
+
+    A response MUST include a url key, the value of which is the URL that
+    provided the response. This is the URL used in the request unless there
+    were redirections, in which case it is the last URL queried in a
+    rediretion chain.
+
+  status
+
+    A response MUST include a status key, the value of which is the HTTP
+    status code of the response. If an internal exception occurs (e.g.
+    connection error), then the status code MUST be 599.
+
+  reason
+
+    A response MUST include a reason key, the value of which is the
+    response phrase returned by the server OR "Internal Exception" if an
+    internal exception occurred.
+
+  content
+
+    A response MAY include a content key, the value of which is the
+    response body returned by the server OR the text of the exception if an
+    internal exception occurred. This field MUST be missing or empty if the
+    server provided no response OR if the body was already provided via
+    "data_callback".
+
+  headers
+
+    A response SHOULD include a headers key, the value of which is a hash
+    reference containing zero or more HTTP header names (as keys) and
+    header values. Keys MUST be lowercased. The value for a header MUST be
+    either a string containing the header value OR an array reference where
+    each item is the value of one of the repeated headers.
+
+  redirects
+
+    A response MAY include a redirects key, the value of which is an array
+    reference of one or more responses from redirections that occurred to
+    fulfill the current request, in chronological order.
+
+ENVIRONMENT
+
+      * PERL_HTTP_ANYUA_DEBUG - If 1, print some info useful for debugging
+      to STDERR.
+
+CAVEATS
+
+    Not all HTTP clients implement the same features or in the same ways.
+    While the point of HTTP::AnyUA is to hide those differences, you may
+    notice some (hopefully) insignificant differences when plugging in
+    different clients. For example, LWP::UserAgent sets some headers on the
+    response such as client-date and client-peer that won't appear when
+    using other clients. Little differences like these probably aren't big
+    deal. Other differences may be a bigger deal, depending on what's
+    important to you. For example, some clients (like HTTP::Tiny) may do
+    chunked transfer encoding in situations where other clients won't
+    (probably because they don't support it). It's not a goal of this
+    project to eliminate all of the differences, but if you come across a
+    difference that is significant enough that you think you need to detect
+    the user agent and write special logic, I would like to learn about
+    your use case.
+
+SEE ALSO
+
+    These modules share similar goals or provide overlapping functionality:
+
+      * Future::HTTP
+
+      * HTTP::Any
+
+      * HTTP::Tinyish
+
+      * Plient
+
+BUGS
+
+    Please report any bugs or feature requests on the bugtracker website
+    https://github.com/chazmcgarvey/HTTP-AnyUA/issues
+
+    When submitting a bug or request, please include a test-file or a patch
+    to an existing test-file that illustrates the bug or desired feature.
+
+AUTHOR
+
+    Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+COPYRIGHT AND LICENSE
+
+    This software is copyright (c) 2017 by Charles McGarvey.
+
+    This is free software; you can redistribute it and/or modify it under
+    the same terms as the Perl 5 programming language system itself.
+
diff --git a/lib/HTTP/AnyUA.pm b/lib/HTTP/AnyUA.pm
new file mode 100644 (file)
index 0000000..6d44018
--- /dev/null
@@ -0,0 +1,796 @@
+package HTTP::AnyUA;
+# ABSTRACT: An HTTP user agent programming interface unification layer
+
+
+use 5.010;
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+use HTTP::AnyUA::Util;
+use Module::Loader;
+use Scalar::Util;
+
+
+our $BACKEND_NAMESPACE;
+our @BACKENDS;
+our %REGISTERED_BACKENDS;
+
+BEGIN {
+    $BACKEND_NAMESPACE = __PACKAGE__ . '::Backend';
+}
+
+
+sub _debug_log { print STDERR join(' ', @_), "\n" if $ENV{PERL_HTTP_ANYUA_DEBUG} }
+
+sub _croak { require Carp; Carp::croak(@_) }
+sub _usage { _croak("Usage: @_\n") }
+
+
+
+sub new {
+    my $class = shift;
+    unshift @_, 'ua' if @_ % 2;
+    my %args = @_;
+    $args{ua} or _usage(q{HTTP::AnyUA->new(ua => $user_agent, %attr)});
+
+    my $self;
+    my @attr = qw(ua backend response_is_future);
+
+    for my $attr (@attr) {
+        $self->{$attr} = $args{$attr} if defined $args{$attr};
+    }
+
+    bless $self, $class;
+
+    $self->_debug_log('Created with user agent', $self->ua);
+
+    # call accessors to get the checks to run
+    $self->ua;
+    $self->response_is_future($args{response_is_future}) if defined $args{response_is_future};
+
+    return $self;
+}
+
+
+sub ua { shift->{ua} or _croak 'User agent is required' }
+
+
+sub response_is_future {
+    my $self = shift;
+    my $val  = shift;
+
+    if (defined $val) {
+        $self->_debug_log('Set response_is_future to', $val ? 'ON' : 'OFF');
+
+        $self->_check_response_is_future($val);
+        $self->{response_is_future} = $val;
+
+        $self->_module_loader->load('Future') if $self->{response_is_future};
+    }
+    elsif (!defined $self->{response_is_future} && $self->{backend}) {
+        $self->{response_is_future} = $self->backend->response_is_future;
+
+        $self->_module_loader->load('Future') if $self->{response_is_future};
+    }
+
+    return $self->{response_is_future} || '';
+}
+
+
+sub backend {
+    my $self = shift;
+
+    return $self->{backend} if defined $self->{backend};
+
+    $self->{backend} = $self->_build_backend;
+    $self->_check_response_is_future($self->response_is_future);
+
+    return $self->{backend};
+}
+
+
+sub request {
+    my ($self, $method, $url, $args) = @_;
+    $args ||= {};
+    @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
+        or _usage(q{$any_ua->request($method, $url, \%options)});
+
+    my $resp = eval { $self->backend->request(uc($method) => $url, $args) };
+    if (my $err = $@) {
+        return $self->_wrap_internal_exception($err);
+    }
+
+    return $self->_wrap_response($resp);
+}
+
+
+# adapted from HTTP/Tiny.pm
+for my $sub_name (qw{get head put post delete}) {
+    my %swap = (SUBNAME => $sub_name, METHOD => uc($sub_name));
+    my $code = q[
+sub {{SUBNAME}} {
+    my ($self, $url, $args) = @_;
+    @_ == 2 || (@_ == 3 && ref $args eq 'HASH')
+        or _usage(q{$any_ua->{{SUBNAME}}($url, \%options)});
+    return $self->request('{{METHOD}}', $url, $args);
+}
+    ];
+    $code =~ s/\{\{([A-Z_]+)\}\}/$swap{$1}/ge;
+    eval $code;     ## no critic
+}
+
+
+# adapted from HTTP/Tiny.pm
+sub post_form {
+    my ($self, $url, $data, $args) = @_;
+    (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
+        or _usage(q{$any_ua->post_form($url, $formdata, \%options)});
+
+    my $headers = {};
+    while (my ($key, $value) = each %{$args->{headers} || {}}) {
+        $headers->{lc $key} = $value;
+    }
+    delete $args->{headers};
+
+    return $self->request(POST => $url, {
+        %$args,
+        content => HTTP::AnyUA::Util::www_form_urlencode($data),
+        headers => {
+            %$headers,
+            'content-type' => 'application/x-www-form-urlencoded',
+        },
+    });
+}
+
+
+# adapted from HTTP/Tiny.pm
+sub mirror {
+    my ($self, $url, $file, $args) = @_;
+    @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
+        or _usage(q{$any_ua->mirror($url, $filepath, \%options)});
+
+    if (exists $args->{headers}) {
+        my $headers = {};
+        while (my ($key, $value) = each %{$args->{headers} || {}}) {
+            $headers->{lc($key)} = $value;
+        }
+        $args->{headers} = $headers;
+    }
+
+    if (-e $file and my $mtime = (stat($file))[9]) {
+        $args->{headers}{'if-modified-since'} ||= HTTP::AnyUA::Util::http_date($mtime);
+    }
+    my $tempfile = $file . int(rand(2**31));
+
+    # set up the response body to be written to the file
+    require Fcntl;
+    sysopen(my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY())
+        or return $self->_wrap_internal_exception(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
+    binmode $fh;
+    $args->{data_callback} = sub { print $fh $_[0] };
+
+    my $resp = $self->request(GET => $url, $args);
+
+    my $finish = sub {
+        my $resp = shift;
+
+        close $fh
+            or return HTTP::AnyUA::Util::internal_exception(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
+
+        if ($resp->{success}) {
+            rename($tempfile, $file)
+                or return HTTP::AnyUA::Util::internal_exception(qq/Error replacing $file with $tempfile: $!\n/);
+            my $lm = $resp->{headers}{'last-modified'};
+            if ($lm and my $mtime = HTTP::AnyUA::Util::parse_http_date($lm)) {
+                utime($mtime, $mtime, $file);
+            }
+        }
+        unlink($tempfile);
+
+        $resp->{success} ||= $resp->{status} eq '304';
+
+        return $resp;
+    };
+
+    if ($self->response_is_future) {
+        return $resp->followed_by(sub {
+            my $future = shift;
+            my @resp = $future->is_done ? $future->get : $future->failure;
+            my $resp = $finish->(@resp);
+            if ($resp->{success}) {
+                return Future->done(@resp);
+            }
+            else {
+                return Future->fail(@resp);
+            }
+        });
+    }
+    else {
+        return $finish->($resp);
+    }
+}
+
+
+sub register_backend {
+    my ($class, $ua_type, $backend_class) = @_;
+    @_ == 3 or _usage(q{HTTP::AnyUA->register_backend($ua_type, $backend_package)});
+
+    if ($backend_class) {
+        $backend_class = "${BACKEND_NAMESPACE}::${backend_class}" unless $backend_class =~ s/^\+//;
+        $REGISTERED_BACKENDS{$ua_type} = $backend_class;
+    }
+    else {
+        delete $REGISTERED_BACKENDS{$ua_type};
+    }
+}
+
+
+# turn a response into a Future if it needs to be
+sub _wrap_response {
+    my $self = shift;
+    my $resp = shift;
+
+    if ($self->response_is_future && !$self->backend->response_is_future) {
+        # wrap the response in a Future
+        if ($resp->{success}) {
+            $self->_debug_log('Wrapped successful response in a Future');
+            $resp = Future->done($resp);
+        }
+        else {
+            $self->_debug_log('Wrapped failed response in a Future');
+            $resp = Future->fail($resp);
+        }
+    }
+
+    return $resp;
+}
+
+sub _wrap_internal_exception { shift->_wrap_response(HTTP::AnyUA::Util::internal_exception(@_)) }
+
+# get a module loader object
+sub _module_loader { shift->{_module_loader} ||= Module::Loader->new }
+
+# get a list of potential backends that may be able to handle the user agent
+sub _build_backend {
+    my $self = shift;
+    my $ua   = shift || $self->ua or _croak 'User agent is required';
+
+    my $ua_type = Scalar::Util::blessed($ua);
+
+    my @classes;
+
+    if ($ua_type) {
+        push @classes, $REGISTERED_BACKENDS{$ua_type} if $REGISTERED_BACKENDS{$ua_type};
+
+        push @classes, "${BACKEND_NAMESPACE}::${ua_type}";
+
+        if (!@BACKENDS) {
+            # search for some backends to try
+            @BACKENDS = sort $self->_module_loader->find_modules($BACKEND_NAMESPACE);
+            $self->_debug_log('Found backends to try (' . join(', ', @BACKENDS) . ')');
+        }
+
+        for my $backend_type (@BACKENDS) {
+            my $plugin = $backend_type;
+            $plugin =~ s/^\Q${BACKEND_NAMESPACE}\E:://;
+            push @classes, $backend_type if $ua->isa($plugin);
+        }
+    }
+    else {
+        push @classes, $REGISTERED_BACKENDS{$ua} if $REGISTERED_BACKENDS{$ua};
+        push @classes, "${BACKEND_NAMESPACE}::${ua}";
+    }
+
+    for my $class (@classes) {
+        if (eval { $self->_module_loader->load($class); 1 }) {
+            $self->_debug_log("Found usable backend (${class})");
+            return $class->new($self->ua);
+        }
+        else {
+            $self->_debug_log($@);
+        }
+    }
+
+    _croak 'Cannot find a usable backend that supports the given user agent';
+}
+
+# make sure the response_is_future setting is compatible with the backend
+sub _check_response_is_future {
+    my $self = shift;
+    my $val  = shift;
+
+    # make sure the user agent is not non-blocking
+    if (!$val && $self->{backend} && $self->backend->response_is_future) {
+        _croak 'Cannot disable response_is_future with a non-blocking user agent';
+    }
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA - An HTTP user agent programming interface unification layer
+
+=head1 VERSION
+
+version 0.900
+
+=head1 SYNOPSIS
+
+    my $any_ua = HTTP::AnyUA->new(ua => LWP::UserAgent->new);
+    # OR: my $any_ua = HTTP::AnyUA->new(ua => Furl->new);
+    # OR: my $any_ua = HTTP::AnyUA->new(ua => HTTP::Tiny->new);
+    # etc...
+
+    my $response = $any_ua->get('http://www.example.com/');
+
+    print "$response->{status} $response->{reason}\n";
+
+    while (my ($k, $v) = each %{$response->{headers}}) {
+        for (ref $v eq 'ARRAY' ? @$v : $v) {
+            print "$k: $_\n";
+        }
+    }
+
+    print $response->{content} if length $response->{content};
+
+    ### Non-blocking user agents cause Future objects to be returned:
+
+    my $any_ua = HTTP::AnyUA->new(ua => HTTP::Tiny->new, response_is_future => 1);
+    # OR: my $any_ua = HTTP::AnyUA->new(ua => 'AnyEvent::HTTP');
+    # OR: my $any_ua = HTTP::AnyUA->new(ua => Mojo::UserAgent->new);
+    # etc...
+
+    my $future = $any_ua->get('http://www.example.com/');
+
+    $future->on_done(sub {
+        my $response = shift;
+
+        print "$response->{status} $response->{reason}\n";
+
+        while (my ($k, $v) = each %{$response->{headers}}) {
+            for (ref $v eq 'ARRAY' ? @$v : $v) {
+                print "$k: $_\n";
+            }
+        }
+
+        print $response->{content} if length $response->{content};
+    });
+
+    $future->on_fail(sub { print STDERR "Oh no!!\n" });
+
+=head1 DESCRIPTION
+
+This module provides a small wrapper for unifying the programming interfaces of several different
+actual user agents (HTTP clients) under one B<familiar> interface.
+
+Rather than providing yet another programming interface for you to learn, HTTP::AnyUA follows the
+L<HTTP::Tiny> interface. This also means that you can plug in any supported HTTP client
+(L<LWP::UserAgent>, L<Furl>, etc.) and use it as if it were L<HTTP::Tiny>.
+
+There are a lot of great HTTP clients available for Perl, each with different goals, different
+feature sets, and of course different programming interfaces! If you're an end user, you can just
+pick one of these clients according to the needs of your project (or personal preference). But if
+you're writing a module that needs to interface with a web server (like perhaps a RESTful API
+wrapper) and you want your users to be able to use whatever HTTP client they want, HTTP::AnyUA can
+help you support that!
+
+It's a good idea to let the end user pick whatever HTTP client they want to use, because they're the
+one who knows the requirements of their application or script. If you're writing an event-driven
+application, you'll need to use a non-blocking user agent like L<Mojo::UserAgent>. If you're writing
+a simple command-line script, you may decide that your priority is to minimize dependencies and so
+may want to go with L<HTTP::Tiny>.
+
+Unfortunately, many modules on CPAN are hardcoded to work with specific HTTP clients, leaving the
+end user unable to use the HTTP client that would be best for them. Although the end user won't --
+or at least doesn't need to -- use HTTP::AnyUA directly, they will benefit from client choice if
+their third-party modules use HTTP::AnyUA or something like it.
+
+The primary goal of HTTP::AnyUA is to make it easy for module developers to write HTTP code once
+that can work with any HTTP client the end user may decide to plug in. A secondary goal is to make
+it easy for anyone to add support for new or yet-unsupported user agents.
+
+=head1 ATTRIBUTES
+
+=head2 ua
+
+Get the user agent that was passed to L</new>.
+
+=head2 response_is_future
+
+Get and set whether or not responses are L<Future> objects.
+
+=head2 backend
+
+Get the backend instance. You normally shouldn't need this.
+
+=head1 METHODS
+
+=head2 new
+
+    $any_ua = HTTP::AnyUA->new(ua => $user_agent, %attr);
+    $any_ua = HTTP::AnyUA->new($user_agent, %attr);
+
+Construct a new HTTP::AnyUA.
+
+=head2 request
+
+    $response = $any_ua->request($method, $url);
+    $response = $any_ua->request($method, $url, \%options);
+
+Make a L<request|/"The Request">, get a L<response|/"The Response">.
+
+Compare to L<HTTP::Tiny/request>.
+
+=head2 get, head, put, post, delete
+
+    $response = $any_ua->get($url);
+    $response = $any_ua->get($url, \%options);
+    $response = $any_ua->head($url);
+    $response = $any_ua->head($url, \%options);
+    # etc.
+
+Shortcuts for L</request> where the method is the method name rather than the first argument.
+
+Compare to L<HTTP::Tiny/getE<verbar>headE<verbar>putE<verbar>postE<verbar>delete>.
+
+=head2 post_form
+
+    $response = $any_ua->post_form($url, $formdata);
+    $response = $any_ua->post_form($url, $formdata, \%options);
+
+Does a C<POST> request with the form data encoded and sets the C<Content-Type> header to
+C<application/x-www-form-urlencoded>.
+
+Compare to L<HTTP::Tiny/post_form>.
+
+=head2 mirror
+
+    $response = $http->mirror($url, $filepath, \%options);
+    if ($response->{success}) {
+        print "$filepath is up to date\n";
+    }
+
+Does a C<GET> request and saves the downloaded document to a file. If the file already exists, its
+timestamp will be sent using the C<If-Modified-Since> request header (which you can override). If
+the server responds with a C<304> (Not Modified) status, the C<success> field will be true; this is
+usually only the case for C<2XX> statuses. If the server responds with a C<Last-Modified> header,
+the file will be updated to have the same modification timestamp.
+
+Compare to L<HTTP::Tiny/mirror>. This version differs slightly in that this returns internal
+exception responses (for cases like being unable to write the file locally, etc.) rather than
+actually throwing the exceptions. The reason for this is that exceptions as responses are easier to
+deal with for non-blocking HTTP clients, and the fact that this method throws exceptions in
+L<HTTP::Tiny> seems like an inconsistency in its interface.
+
+=head2 register_backend
+
+    HTTP::AnyUA->register_backend($user_agent_package => $backend_package);
+    HTTP::AnyUA->register_backend('MyAgent' => 'MyBackend');    # HTTP::AnyUA::Backend::MyBackend
+    HTTP::AnyUA->register_backend('LWP::UserAgent' => '+SpecialBackend');   # SpecialBackend
+
+Register a backend for a new user agent type or override a default backend. Backend packages are
+relative to the C<HTTP::AnyUA::Backend::> namespace unless prefixed with a C<+>.
+
+If you only need to set a backend as a one-off thing, you could also pass an instantiated backend to
+L</new>.
+
+=head1 SUPPORTED USER AGENTS
+
+=over 4
+
+=item *
+
+L<AnyEvent::HTTP>
+
+=item *
+
+L<Furl>
+
+=item *
+
+L<HTTP::AnyUA> - a little bit meta, but why not?
+
+=item *
+
+L<HTTP::Tiny>
+
+=item *
+
+L<LWP::UserAgent>
+
+=item *
+
+L<Mojo::UserAgent>
+
+=item *
+
+L<Net::Curl::Easy>
+
+=back
+
+Any HTTP client that inherits from one of these in a well-behaved manner should also be supported.
+
+Of course, there are many other HTTP clients on CPAN that HTTP::AnyUA doesn't yet support. I'm more
+than happy to help add support for others, so send me a message if you know of an HTTP client that
+needs support. See L<HTTP::AnyUA::Backend> for how to write support for a new HTTP client.
+
+=head1 NON-BLOCKING USER AGENTS
+
+HTTP::AnyUA tries to target the L<HTTP::Tiny> interface, which is a blocking interface. This means
+that when you call L</request>, it is supposed to not return until either the response is received
+or an error occurs. This doesn't jive well with non-blocking HTTP clients which expect the flow to
+reenter an event loop so that the request can complete concurrently.
+
+In order to reconcile this, a L<Future> will be returned instead of the normal hashref response if
+the wrapped HTTP client is non-blocking (such as L<Mojo::UserAgent> or L<AnyEvent::HTTP>). This
+L<Future> object may be used to set up callbacks that will be called when the request is completed.
+You can call L</response_is_future> to know if the response is or will be a L<Future>.
+
+This is typically okay for the end user; since they're the one who chose which HTTP client to use in
+the first place, they should know whether they should expect a L<Future> or a direct response when
+they make an HTTP request, but it does add some burden on you as a module writer because if you ever
+need to examine the response, you may need to write code like this:
+
+    my $resp = $any_ua->get('http://www.perl.org/');
+
+    if ($any_ua->response_is_future) {
+        $resp->on_done(sub {
+            my $real_resp = shift;
+            handle_response($real_resp);
+        });
+    }
+    else {
+        handle_response($resp);     # response is the real response already
+    }
+
+This actually isn't too annoying to deal with in practice, but you can avoid it if you like by
+forcing the response to always be a L<Future>. Just set the L</response_is_future> attribute. Then
+you don't need to do an if-else because the response will always be the same type:
+
+    $any_ua->response_is_future(1);
+
+    my $resp = $any_ua->get('http://www.perl.org/');
+
+    $resp->on_done(sub {            # response is always a Future
+        my $real_resp = shift;
+        handle_response($real_resp);
+    });
+
+Note that this doesn't make a blocking HTTP client magically non-blocking. The call to L</request>
+will still block if the client is blocking, and your "done" callback will simply be fired
+immediately. But this does let you write the same code in your module and have it work regardless of
+whether the underlying HTTP client is blocking or non-blocking.
+
+The default behavior is to return a direct hashref response if the HTTP client is blocking and
+a L<Future> if the client is non-blocking. It's up to you to decide whether or not to set
+C<response_is_future>, and you should also consider whether you want to expose the possibility of
+either type of response or always returning L<Future> objects to the end user of your module. It
+doesn't matter for users who choose non-blocking HTTP clients because they will be using L<Future>
+objects either way, but users who know they are using a blocking HTTP client may appreciate not
+having to deal with L<Future> objects at all.
+
+=head1 FREQUENTLY ASKED QUESTIONS
+
+=head2 How do I set up proxying, SSL, cookies, timeout, etc.?
+
+HTTP::AnyUA provides a common interface for I<using> HTTP clients, not for instantiating or
+configuring them. Proxying, SSL, and other custom settings can be configured directly through the
+underlying HTTP client; see the documentation for your particular user agent to learn how to
+configure these things.
+
+L<AnyEvent::HTTP> is a bit of a special case because there is no instantiated object representing
+the client. For this particular user agent, you can configure the backend to pass a default set of
+options whenever it calls C<http_request>. See L<HTTP::AnyUA::Backend::AnyEvent::HTTP/options>:
+
+    $any_ua->backend->options({recurse => 5, timeout => 15});
+
+If you are a module writer, you should probably receive a user agent from your end user and leave
+this type of configuration up to them.
+
+=head2 Why use HTTP::AnyUA instead of some other HTTP client?
+
+Maybe you shouldn't. If you're an end user writing a script or application, you can just pick the
+HTTP client that suits you best and use it. For example, if you're writing a L<Mojolicious> app,
+you're not going wrong by using L<Mojo::UserAgent>; it's loaded with features and is well-integrated
+with that particular environment.
+
+As an end user, you I<could> wrap the HTTP client you pick in an HTTP::AnyUA object, but the only
+reason to do this is if you prefer using the L<HTTP::Tiny> interface.
+
+The real benefit of HTTP::AnyUA (or something like it) is if module writers use it to allow end
+users of their modules to be able to plug in whatever HTTP client they want. For example, a module
+that implements an API wrapper that has a hard dependency on L<LWP::UserAgent> or even L<HTTP::Tiny>
+is essentially useless for non-blocking applications. If the same hypothetical module had been
+written using HTTP::AnyUA then it would be useful in any scenario.
+
+=head2 Why use the HTTP::Tiny interface?
+
+The L<HTTP::Tiny> interface is simple but provides all the essential functionality needed for
+a capable HTTP client and little more. That makes it easy to provide an implementation for, and it
+also makes it straightforward for module authors to use.
+
+Marrying the L<HTTP::Tiny> interface with L<Future> gives us these benefits for both blocking and
+non-blocking modules and applications.
+
+=head1 SPECIFICATION
+
+This section specifies a standard set of data structures that can be used to make a request and get
+a response from a user agent. This is the specification HTTP::AnyUA uses for its programming
+interface. It is heavily based on L<HTTP::Tiny>'s interface, and parts of this specification were
+adapted or copied verbatim from that module's documentation. The intent is for this specification to
+be written such that L<HTTP::Tiny> is already a compliant implementor of the specification (at least
+as of the specification's publication date).
+
+=head2 The Request
+
+A request is a tuple of the form C<(Method, URL)> or C<(Method, URL, Options)>.
+
+=head3 Method
+
+Method B<MUST> be a string representing the HTTP verb. This is commonly C<"GET">, C<"POST">,
+C<"HEAD">, C<"DELETE">, etc.
+
+=head3 URL
+
+URL B<MUST> be a string representing the remote resource to be acted upon. The URL B<MUST> have
+unsafe characters escaped and international domain names encoded before being passed to the user
+agent. A user agent B<MUST> generated a C<"Host"> header based on the URL in accordance with RFC
+2616; a user agent B<MAY> throw an error if a C<"Host"> header is given with the L</headers>.
+
+=head3 Options
+
+Options, if present, B<MUST> be a hash reference containing zero or more of the following keys with
+appropriate values. A user agent B<MAY> support more options than are specified here.
+
+=head4 headers
+
+The value for the C<headers> key B<MUST> be a hash reference containing zero or more HTTP header
+names (as keys) and header values. The value for a header B<MUST> be either a string containing the
+header value OR an array reference where each item is a string. If the value for a header is an
+array reference, the user agent B<MUST> output the header multiple times with each value in the
+array.
+
+User agents B<MAY> may add headers, but B<SHOULD NOT> replace user-specified headers unless
+otherwise documented.
+
+=head4 content
+
+The value for the C<content> key B<MUST> be a string OR a code reference. If the value is a string,
+its contents will be included with the request as the body. If the value is a code reference, the
+referenced code will be called iteratively to produce the body of the request, and the code B<MUST>
+return an empty string or undef value to indicate the end of the request body. If the value is
+a code reference, a user agent B<SHOULD> use chunked transfer encoding if it supports it, otherwise
+a user agent B<MAY> completely drain the code of content before sending the request.
+
+=head4 data_callback
+
+The value for the C<data_callback> key B<MUST> be a code reference that will be called zero or more
+times, once for each "chunk" of response body received. A user agent B<MAY> send the entire response
+body in one call. The referenced code B<MUST> be given two arguments; the first is a string
+containing a chunk of the response body, the second is an in-progress L<response|/The Response>.
+
+=head2 The Response
+
+A response B<MUST> be a hash reference containg some required keys and values. A response B<MAY>
+contain some optional keys and values.
+
+=head3 success
+
+A response B<MUST> include a C<success> key, the value of which is a boolean indicating whether or
+not the request is to be considered a success (true is a success). Unless otherwise documented,
+a successful result means that the operation returned a 2XX status code.
+
+=head3 url
+
+A response B<MUST> include a C<url> key, the value of which is the URL that provided the response.
+This is the URL used in the request unless there were redirections, in which case it is the last URL
+queried in a rediretion chain.
+
+=head3 status
+
+A response B<MUST> include a C<status> key, the value of which is the HTTP status code of the
+response. If an internal exception occurs (e.g. connection error), then the status code B<MUST> be
+C<599>.
+
+=head3 reason
+
+A response B<MUST> include a C<reason> key, the value of which is the response phrase returned by
+the server OR "Internal Exception" if an internal exception occurred.
+
+=head3 content
+
+A response B<MAY> include a C<content> key, the value of which is the response body returned by the
+server OR the text of the exception if an internal exception occurred. This field B<MUST> be missing
+or empty if the server provided no response OR if the body was already provided via
+L</data_callback>.
+
+=head3 headers
+
+A response B<SHOULD> include a C<headers> key, the value of which is a hash reference containing
+zero or more HTTP header names (as keys) and header values. Keys B<MUST> be lowercased. The value
+for a header B<MUST> be either a string containing the header value OR an array reference where each
+item is the value of one of the repeated headers.
+
+=head3 redirects
+
+A response B<MAY> include a C<redirects> key, the value of which is an array reference of one or
+more responses from redirections that occurred to fulfill the current request, in chronological
+order.
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item *
+
+C<PERL_HTTP_ANYUA_DEBUG> - If 1, print some info useful for debugging to C<STDERR>.
+
+=back
+
+=head1 CAVEATS
+
+Not all HTTP clients implement the same features or in the same ways. While the point of HTTP::AnyUA
+is to hide those differences, you may notice some (hopefully) I<insignificant> differences when
+plugging in different clients. For example, L<LWP::UserAgent> sets some headers on the response such
+as C<client-date> and C<client-peer> that won't appear when using other clients. Little differences
+like these probably aren't big deal. Other differences may be a bigger deal, depending on what's
+important to you. For example, some clients (like L<HTTP::Tiny>) may do chunked transfer encoding in
+situations where other clients won't (probably because they don't support it). It's not a goal of
+this project to eliminate I<all> of the differences, but if you come across a difference that is
+significant enough that you think you need to detect the user agent and write special logic, I would
+like to learn about your use case.
+
+=head1 SEE ALSO
+
+These modules share similar goals or provide overlapping functionality:
+
+=over 4
+
+=item *
+
+L<Future::HTTP>
+
+=item *
+
+L<HTTP::Any>
+
+=item *
+
+L<HTTP::Tinyish>
+
+=item *
+
+L<Plient>
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/lib/HTTP/AnyUA/Backend.pm b/lib/HTTP/AnyUA/Backend.pm
new file mode 100644 (file)
index 0000000..a3a68ec
--- /dev/null
@@ -0,0 +1,172 @@
+package HTTP::AnyUA::Backend;
+# ABSTRACT: A base class for HTTP::AnyUA backends
+
+
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+
+
+sub new {
+    my $class   = shift;
+    my $ua      = shift or die 'User agent is required';
+    bless {ua => $ua}, $class;
+}
+
+
+sub request {
+    die 'Not yet implemented';
+}
+
+
+sub ua { shift->{ua} }
+
+
+sub response_is_future { 0 }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA::Backend - A base class for HTTP::AnyUA backends
+
+=head1 VERSION
+
+version 0.900
+
+=head1 SYNOPSIS
+
+    package HTTP::AnyUA::Backend::MyUserAgent;
+
+    use parent 'HTTP::AnyUA::Backend';
+
+    sub response_is_future { 0 }
+
+    sub request {
+        my ($self, $method, $url, $args) = @_;
+
+        my $ua = $self->ua;
+
+        # Here is where you transform the arguments into a request that $ua
+        # understands, make the request against $ua and get a response, and
+        # transform the response to the expected hashref form.
+
+        my $resp = $ua->make_request();
+
+        return $resp;
+    }
+
+    ### Non-blocking user agents return responses as Future objects:
+
+    sub response_is_future { 1 }
+
+    sub request {
+        my ($self, $method, $url, $args) = @_;
+
+        my $ua = $self->ua;
+
+        my $future = Future->new;
+
+        # Again, this example glosses over transforming the request and response
+        # to and from the actual user agent, but such details are the whole
+        # point of a backend.
+
+        $ua->nonblocking_callback(sub {
+            my $resp = shift;
+
+            if ($resp->{success}) {
+                $future->done($resp);
+            }
+            else {
+                $future->fail($resp);
+            }
+        });
+
+        return $future;
+    }
+
+=head1 DESCRIPTION
+
+This module provides an interface for an L<HTTP::AnyUA> "backend," which is an adapter that adds
+support for using a type of user agent with L<HTTP::AnyUA>.
+
+This class should not be instantiated directly, but it may be convenient for backend implementations
+to subclass it.
+
+At its core, a backend simply takes a set of standard arguments that represent an HTTP request,
+transforms that request into a form understood by an underlying user agent, calls upon the user
+agent to make the request and get a response, and then transforms that response into a standard
+form. The standard forms for the request and response are based on L<HTTP::Tiny>'s arguments and
+return value to and from its L<request|HTTP::Tiny/request> method.
+
+=head1 ATTRIBUTES
+
+=head2 ua
+
+Get the user agent that was passed to L</new>.
+
+=head2 response_is_future
+
+Get whether or not responses are L<Future> objects. Default is false.
+
+This may be overridden by implementations.
+
+=head1 METHODS
+
+=head2 new
+
+    $backend = HTTP::AnyUA::Backend::MyUserAgent->new($my_user_agent);
+
+Construct a new backend.
+
+=head2 request
+
+    $response = $backend->request($method => $url, \%options);
+
+Make a request, get a response.
+
+This must be overridden by implementations.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<HTTP::AnyUA/REQUEST>  - Explanation of the request arguments
+
+=item *
+
+L<HTTP::AnyUA/RESPONSE> - Explanation of the response
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/lib/HTTP/AnyUA/Backend/AnyEvent/HTTP.pm b/lib/HTTP/AnyUA/Backend/AnyEvent/HTTP.pm
new file mode 100644 (file)
index 0000000..393d6aa
--- /dev/null
@@ -0,0 +1,187 @@
+package HTTP::AnyUA::Backend::AnyEvent::HTTP;
+# ABSTRACT: A unified programming interface for AnyEvent::HTTP
+
+
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+use parent 'HTTP::AnyUA::Backend';
+
+use Future;
+use HTTP::AnyUA::Util;
+
+
+
+sub options { @_ == 2 ? $_[0]->{options} = pop : $_[0]->{options} }
+
+sub response_is_future { 1 }
+
+sub request {
+    my $self = shift;
+    my ($method, $url, $args) = @_;
+
+    my %opts    = $self->_munge_request($method, $url, $args);
+    my $future  = Future->new;
+
+    require AnyEvent::HTTP;
+    AnyEvent::HTTP::http_request($method => $url, %opts, sub {
+        my $resp = $self->_munge_response(@_, $args->{data_callback});
+
+        if ($resp->{success}) {
+            $future->done($resp);
+        }
+        else {
+            $future->fail($resp);
+        }
+    });
+
+    return $future;
+}
+
+
+sub _munge_request {
+    my $self    = shift;
+    my $method  = shift;
+    my $url     = shift;
+    my $args    = shift || {};
+
+    my %opts = %{$self->options || {}};
+
+    if (my $headers = $args->{headers}) {
+        # munge headers
+        my %headers;
+        for my $header (keys %$headers) {
+            my $value  = $headers->{$header};
+            $value = join(', ', @$value) if ref($value) eq 'ARRAY';
+            $headers{$header} = $value;
+        }
+        $opts{headers} = \%headers;
+    }
+
+    my @url_parts = HTTP::AnyUA::Util::split_url($url);
+    if (my $auth = $url_parts[4] and !$opts{headers}{'authorization'}) {
+        # handle auth in the URL
+        require MIME::Base64;
+        $opts{headers}{'authorization'} = 'Basic ' . MIME::Base64::encode_base64($auth, '');
+    }
+
+    my $content = HTTP::AnyUA::Util::coderef_content_to_string($args->{content});
+    $opts{body} = $content if $content;
+
+    if (my $data_cb = $args->{data_callback}) {
+        # stream the response
+        $opts{on_body} = sub {
+            my $data = shift;
+            $data_cb->($data, $self->_munge_response(undef, @_));
+            1;  # continue
+        };
+    }
+
+    return %opts;
+}
+
+sub _munge_response {
+    my $self    = shift;
+    my $data    = shift;
+    my $headers = shift;
+    my $data_cb = shift;
+
+    # copy headers because http_request will continue to use the original
+    my %headers = %$headers;
+
+    my $code    = delete $headers{Status};
+    my $reason  = delete $headers{Reason};
+    my $url     = delete $headers{URL};
+
+    my $resp = {
+        success => 200 <= $code && $code <= 299,
+        url     => $url,
+        status  => $code,
+        reason  => $reason,
+        headers => \%headers,
+    };
+
+    my $version = delete $headers{HTTPVersion};
+    $resp->{protocol} = "HTTP/$version" if $version;
+
+    $resp->{content} = $data if $data && !$data_cb;
+
+    my @redirects;
+    my $redirect = delete $headers{Redirect};
+    while ($redirect) {
+        # delete pseudo-header first so redirects aren't recursively munged
+        my $next = delete $redirect->[1]{Redirect};
+        unshift @redirects, $self->_munge_response(@$redirect);
+        $redirect = $next;
+    }
+    $resp->{redirects} = \@redirects if @redirects;
+
+    if (590 <= $code && $code <= 599) {
+        HTTP::AnyUA::Util::internal_exception($reason, $resp);
+    }
+
+    return $resp;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA::Backend::AnyEvent::HTTP - A unified programming interface for AnyEvent::HTTP
+
+=head1 VERSION
+
+version 0.900
+
+=head1 DESCRIPTION
+
+This module adds support for the HTTP client L<AnyEvent::HTTP> to be used with the unified
+programming interface provided by L<HTTP::AnyUA>.
+
+=head1 METHODS
+
+=head2 options
+
+    $backend->options(\%options);
+
+Get and set default arguments to C<http_request>.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<HTTP::AnyUA::Backend>
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/lib/HTTP/AnyUA/Backend/Furl.pm b/lib/HTTP/AnyUA/Backend/Furl.pm
new file mode 100644 (file)
index 0000000..1188835
--- /dev/null
@@ -0,0 +1,119 @@
+package HTTP::AnyUA::Backend::Furl;
+# ABSTRACT: A unified programming interface for Furl
+
+
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+use parent 'HTTP::AnyUA::Backend';
+
+use HTTP::AnyUA::Util;
+
+
+sub request {
+    my $self = shift;
+    my ($method, $url, $args) = @_;
+
+    local $args->{content} = HTTP::AnyUA::Util::coderef_content_to_string($args->{content});
+
+    my $request = HTTP::AnyUA::Util::native_to_http_request(@_);
+    my $ua_resp = $self->ua->request($request);
+
+    return $self->_munge_response($ua_resp, $args->{data_callback});
+}
+
+sub _munge_response {
+    my $self    = shift;
+    my $ua_resp = shift;
+    my $data_cb = shift;
+
+    my $resp = {
+        success => !!$ua_resp->is_success,
+        url     => $ua_resp->request->uri->as_string,
+        status  => $ua_resp->code,
+        reason  => $ua_resp->message,
+        headers => HTTP::AnyUA::Util::http_headers_to_native($ua_resp->headers),
+    };
+
+    $resp->{protocol} = $ua_resp->protocol if $ua_resp->protocol;
+
+    if ($resp->{headers}{'x-internal-response'}) {
+        HTTP::AnyUA::Util::internal_exception($ua_resp->content, $resp);
+    }
+    elsif ($data_cb) {
+        $data_cb->($ua_resp->content, $resp);
+    }
+    else {
+        $resp->{content} = $ua_resp->content;
+    }
+
+    return $resp;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA::Backend::Furl - A unified programming interface for Furl
+
+=head1 VERSION
+
+version 0.900
+
+=head1 DESCRIPTION
+
+This module adds support for the HTTP client L<Furl> to be used with the unified programming
+interface provided by L<HTTP::AnyUA>.
+
+=head1 CAVEATS
+
+=over 4
+
+=item *
+
+L<Furl> doesn't keep a list of requests and responses along a redirect chain. As such, the C<url>
+
+field in the response is always the same as the URL of the original request, and the C<redirects>
+field is never used.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<HTTP::AnyUA::Backend>
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/lib/HTTP/AnyUA/Backend/HTTP/AnyUA.pm b/lib/HTTP/AnyUA/Backend/HTTP/AnyUA.pm
new file mode 100644 (file)
index 0000000..d2eeede
--- /dev/null
@@ -0,0 +1,78 @@
+package HTTP::AnyUA::Backend::HTTP::AnyUA;
+# ABSTRACT: A unified programming interface for HTTP::AnyUA
+
+
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+use parent 'HTTP::AnyUA::Backend';
+
+
+sub response_is_future {
+    my $self = shift;
+
+    return $self->ua->response_is_future;
+}
+
+sub request {
+    my $self = shift;
+
+    return $self->ua->request(@_);
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA::Backend::HTTP::AnyUA - A unified programming interface for HTTP::AnyUA
+
+=head1 VERSION
+
+version 0.900
+
+=head1 DESCRIPTION
+
+This module adds support for the HTTP client L<HTTP::AnyUA> to be used with the unified programming
+interface provided by L<HTTP::AnyUA>.
+
+Mind blown.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<HTTP::AnyUA::Backend>
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/lib/HTTP/AnyUA/Backend/HTTP/Tiny.pm b/lib/HTTP/AnyUA/Backend/HTTP/Tiny.pm
new file mode 100644 (file)
index 0000000..dbd0bd4
--- /dev/null
@@ -0,0 +1,70 @@
+package HTTP::AnyUA::Backend::HTTP::Tiny;
+# ABSTRACT: A unified programming interface for HTTP::Tiny
+
+
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+use parent 'HTTP::AnyUA::Backend';
+
+
+sub request {
+    my $self = shift;
+
+    return $self->ua->request(@_);
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA::Backend::HTTP::Tiny - A unified programming interface for HTTP::Tiny
+
+=head1 VERSION
+
+version 0.900
+
+=head1 DESCRIPTION
+
+This module adds support for the HTTP client L<HTTP::Tiny> to be used with the unified programming
+interface provided by L<HTTP::AnyUA>.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<HTTP::AnyUA::Backend>
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/lib/HTTP/AnyUA/Backend/LWP/UserAgent.pm b/lib/HTTP/AnyUA/Backend/LWP/UserAgent.pm
new file mode 100644 (file)
index 0000000..071bb57
--- /dev/null
@@ -0,0 +1,115 @@
+package HTTP::AnyUA::Backend::LWP::UserAgent;
+# ABSTRACT: A unified programming interface for LWP::UserAgent
+
+
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+use parent 'HTTP::AnyUA::Backend';
+
+use HTTP::AnyUA::Util;
+
+
+sub request {
+    my $self = shift;
+    my ($method, $url, $args) = @_;
+
+    my $r = HTTP::AnyUA::Util::native_to_http_request(@_);
+
+    my $ua_resp = $self->ua->request($r);
+
+    return $self->_munge_response($ua_resp, $args->{data_callback});
+}
+
+
+sub _munge_response {
+    my $self    = shift;
+    my $ua_resp = shift;
+    my $data_cb = shift;
+    my $recurse = shift;
+
+    my $resp = {
+        success => !!$ua_resp->is_success,
+        url     => $ua_resp->request->uri->as_string,
+        status  => $ua_resp->code,
+        reason  => $ua_resp->message,
+        headers => HTTP::AnyUA::Util::http_headers_to_native($ua_resp->headers),
+    };
+
+    $resp->{protocol} = $ua_resp->protocol if $ua_resp->protocol;
+
+    if (!$recurse) {
+        for my $redirect ($ua_resp->redirects) {
+            push @{$resp->{redirects} ||= []}, $self->_munge_response($redirect, undef, 1);
+        }
+    }
+
+    my $content_ref = $ua_resp->content_ref;
+
+    if (($resp->{headers}{'client-warning'} || '') eq 'Internal response') {
+        HTTP::AnyUA::Util::internal_exception($$content_ref, $resp);
+    }
+    elsif ($data_cb) {
+        $data_cb->($$content_ref, $resp);
+    }
+    else {
+        $resp->{content} = $$content_ref;
+    }
+
+    return $resp;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA::Backend::LWP::UserAgent - A unified programming interface for LWP::UserAgent
+
+=head1 VERSION
+
+version 0.900
+
+=head1 DESCRIPTION
+
+This module adds support for the HTTP client L<LWP::UserAgent> to be used with the unified
+programming interface provided by L<HTTP::AnyUA>.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<HTTP::AnyUA::Backend>
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/lib/HTTP/AnyUA/Backend/Mojo/UserAgent.pm b/lib/HTTP/AnyUA/Backend/Mojo/UserAgent.pm
new file mode 100644 (file)
index 0000000..5f73ce8
--- /dev/null
@@ -0,0 +1,200 @@
+package HTTP::AnyUA::Backend::Mojo::UserAgent;
+# ABSTRACT: A unified programming interface for Mojo::UserAgent
+
+
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+use parent 'HTTP::AnyUA::Backend';
+
+use Future;
+use Scalar::Util;
+
+
+sub response_is_future { 1 }
+
+sub request {
+    my $self = shift;
+    my ($method, $url, $args) = @_;
+
+    my $future = Future->new;
+
+    my $tx = $self->_munge_request(@_);
+
+    $self->ua->start($tx => sub {
+        my $ua = shift;
+        my $tx = shift;
+
+        my $resp = $self->_munge_response($tx, $args->{data_callback});
+
+        if ($resp->{success}) {
+            $future->done($resp);
+        }
+        else {
+            $future->fail($resp);
+        }
+    });
+
+    return $future;
+}
+
+
+sub _munge_request {
+    my $self    = shift;
+    my $method  = shift;
+    my $url     = shift;
+    my $args    = shift;
+
+    my $headers = $args->{headers} || {};
+    my $content = $args->{content};
+
+    my @content;
+
+    my $content_length;
+    if ($content) {
+        for my $header (keys %$headers) {
+            if (lc($header) eq 'content-length') {
+                $content_length = $headers->{$header};
+                last;
+            }
+        }
+
+        # if we don't know the length we have to just read it all in
+        $content = HTTP::AnyUA::Util::coderef_content_to_string($content) if !$content_length;
+
+        push @content, $content if ref($content) ne 'CODE';
+    }
+
+    my $tx = $self->ua->build_tx($method => $url => $headers => @content);
+
+    if (ref($content) eq 'CODE') {
+        $tx->req->headers->content_length($content_length);
+        # stream the request
+        my $drain;
+        $drain = sub {
+            my $body    = shift;
+            my $chunk   = $content->() || '';
+            undef $drain if !$chunk;
+            $body->write($chunk, $drain);
+        };
+        $tx->req->content->$drain;
+    }
+
+    if (my $data_cb = $args->{data_callback}) {
+        # stream the response
+        my $tx_copy = $tx;
+        Scalar::Util::weaken($tx_copy);
+        $tx->res->content->unsubscribe('read')->on(read => sub {
+            my ($content, $bytes) = @_;
+            my $resp = $self->_munge_response($tx_copy, undef);
+            $data_cb->($bytes, $resp);
+        });
+    }
+
+    return $tx;
+}
+
+sub _munge_response {
+    my $self    = shift;
+    my $tx      = shift;
+    my $data_cb = shift;
+    my $recurse = shift;
+
+    my $resp = {
+        success => !!$tx->res->is_success,
+        url     => $tx->req->url->to_string,
+        status  => $tx->res->code,
+        reason  => $tx->res->message,
+        headers => {},
+    };
+
+    # lowercase header keys
+    my $headers = $tx->res->headers->to_hash;
+    for my $header (keys %$headers) {
+        $resp->{headers}{lc($header)} = delete $headers->{$header};
+    }
+
+    my $version = $tx->res->version;
+    $resp->{protocol} = "HTTP/$version" if $version;
+
+    if (!$recurse) {
+        for my $redirect (@{$tx->redirects}) {
+            push @{$resp->{redirects} ||= []}, $self->_munge_response($redirect, undef, 1);
+        }
+    }
+
+    my $err = $tx->error;
+    if ($err and !$err->{code}) {
+        return HTTP::AnyUA::Util::internal_exception($err->{message}, $resp);
+    }
+
+    my $body = $tx->res->body;
+    $resp->{content} = $body if $body && !$data_cb;
+
+    return $resp;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA::Backend::Mojo::UserAgent - A unified programming interface for Mojo::UserAgent
+
+=head1 VERSION
+
+version 0.900
+
+=head1 DESCRIPTION
+
+This module adds support for the HTTP client L<Mojo::UserAgent> to be used with the unified
+programming interface provided by L<HTTP::AnyUA>.
+
+=head1 CAVEATS
+
+=over 4
+
+=item *
+
+The C<url> field in the response has the auth portion (if any) removed from the URL.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<HTTP::AnyUA::Backend>
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/lib/HTTP/AnyUA/Backend/Net/Curl/Easy.pm b/lib/HTTP/AnyUA/Backend/Net/Curl/Easy.pm
new file mode 100644 (file)
index 0000000..7f8ee0b
--- /dev/null
@@ -0,0 +1,275 @@
+package HTTP::AnyUA::Backend::Net::Curl::Easy;
+# ABSTRACT: A unified programming interface for Net::Curl::Easy
+
+
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+use parent 'HTTP::AnyUA::Backend';
+
+use HTTP::AnyUA::Util;
+use Scalar::Util;
+
+
+sub request {
+    my $self = shift;
+    my ($method, $url, $args) = @_;
+
+    my $ua = $self->ua;
+
+    # reset
+    $ua->setopt(Net::Curl::Easy::CURLOPT_HTTPGET(), 0);
+    $ua->setopt(Net::Curl::Easy::CURLOPT_NOBODY(), 0);
+    $ua->setopt(Net::Curl::Easy::CURLOPT_READFUNCTION(), undef);
+    $ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDS(), undef);
+    $ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDSIZE(), 0);
+
+    if ($method eq 'GET') {
+        $ua->setopt(Net::Curl::Easy::CURLOPT_HTTPGET(), 1);
+    }
+    elsif ($method eq 'HEAD') {
+        $ua->setopt(Net::Curl::Easy::CURLOPT_NOBODY(), 1);
+    }
+
+    if (my $content = $args->{content}) {
+        if (ref($content) eq 'CODE') {
+            my $content_length;
+            for my $header (keys %{$args->{headers} || {}}) {
+                if (lc($header) eq 'content-length') {
+                    $content_length = $args->{headers}{$header};
+                    last;
+                }
+            }
+
+            if ($content_length) {
+                my $chunk;
+                $ua->setopt(Net::Curl::Easy::CURLOPT_READFUNCTION(), sub {
+                    my $ua      = shift;
+                    my $maxlen  = shift;
+
+                    if (!$chunk) {
+                        $chunk = $content->();
+                        return 0 if !$chunk;
+                    }
+
+                    my $part = substr($chunk, 0, $maxlen, '');
+                    return \$part;
+                });
+                $ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDSIZE(), $content_length);
+            }
+            else {
+                # if we don't know the length we have to just read it all in
+                $content = HTTP::AnyUA::Util::coderef_content_to_string($content);
+            }
+        }
+        if (ref($content) ne 'CODE') {
+            $ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDS(), $content);
+            $ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDSIZE(), length $content);
+        }
+    }
+
+    $ua->setopt(Net::Curl::Easy::CURLOPT_URL(), $url);
+    $ua->setopt(Net::Curl::Easy::CURLOPT_CUSTOMREQUEST(), $method);
+
+    # munge headers
+    my @headers;
+    for my $header (keys %{$args->{headers} || {}}) {
+        my $value  = $args->{headers}{$header};
+        my @values = ref($value) eq 'ARRAY' ? @$value : $value;
+        for my $v (@values) {
+            push @headers, "${header}: $v";
+        }
+    }
+    $ua->setopt(Net::Curl::Easy::CURLOPT_HTTPHEADER(), \@headers) if @headers;
+
+    my @hdrdata;
+
+    $ua->setopt(Net::Curl::Easy::CURLOPT_HEADERFUNCTION(), sub {
+        my $ua      = shift;
+        my $data    = shift;
+        my $size    = length $data;
+
+        my %headers = _parse_header($data);
+
+        if ($headers{Status}) {
+            push @hdrdata, {};
+        }
+
+        my $resp_headers = $hdrdata[-1];
+
+        for my $key (keys %headers) {
+            if (!$resp_headers->{$key}) {
+                $resp_headers->{$key} =  $headers{$key};
+            }
+            else {
+                if (ref($resp_headers->{$key}) ne 'ARRAY') {
+                    $resp_headers->{$key} = [$resp_headers->{$key}];
+                }
+                push @{$resp_headers->{$key}}, $headers{$key};
+            }
+        }
+
+        return $size;
+    });
+
+    my $resp_body = '';
+
+    my $data_cb = $args->{data_callback};
+    my $copy = $self;
+    Scalar::Util::weaken($copy);
+    $ua->setopt(Net::Curl::Easy::CURLOPT_WRITEFUNCTION(), sub {
+        my $ua      = shift;
+        my $data    = shift;
+        my $fh      = shift;
+        my $size    = length $data;
+
+        if ($data_cb) {
+            my $resp = $copy->_munge_response(undef, undef, [@hdrdata], $data_cb);
+            $data_cb->($data, $resp);
+        }
+        else {
+            print $fh $data;
+        }
+
+        return $size;
+    });
+    open(my $fileb, '>', \$resp_body);
+    $ua->setopt(Net::Curl::Easy::CURLOPT_WRITEDATA(), $fileb);
+
+    eval { $ua->perform };
+    my $ret = $@;
+
+    return $self->_munge_response($ret, $resp_body, [@hdrdata], $data_cb);
+}
+
+
+sub _munge_response {
+    my $self    = shift;
+    my $error   = shift;
+    my $body    = shift;
+    my $hdrdata = shift;
+    my $data_cb = shift;
+
+    my %headers = %{pop @$hdrdata || {}};
+
+    my $code    = delete $headers{Status} || $self->ua->getinfo(Net::Curl::Easy::CURLINFO_RESPONSE_CODE()) || 599;
+    my $reason  = delete $headers{Reason};
+    my $url     = $self->ua->getinfo(Net::Curl::Easy::CURLINFO_EFFECTIVE_URL());
+
+    my $resp = {
+        success => 200 <= $code && $code <= 299,
+        url     => $url,
+        status  => $code,
+        reason  => $reason,
+        headers => \%headers,
+    };
+
+    my $version = delete $headers{HTTPVersion} || _http_version($self->ua->getinfo(Net::Curl::Easy::CURLINFO_HTTP_VERSION()));
+    $resp->{protocol} = "HTTP/$version" if $version;
+
+    # We have the headers for the redirect chain in $hdrdata, but we don't have the contents, and we
+    # would also need to reconstruct the URLs.
+
+    if ($error) {
+        my $err = $self->ua->strerror($error);
+        return HTTP::AnyUA::Util::internal_exception($err, $resp);
+    }
+
+    $resp->{content} = $body if $body && !$data_cb;
+
+    return $resp;
+}
+
+# get the HTTP version according to the user agent object
+sub _http_version {
+    my $version = shift;
+    return $version == Net::Curl::Easy::CURL_HTTP_VERSION_1_0() ? '1.0' :
+           $version == Net::Curl::Easy::CURL_HTTP_VERSION_1_1() ? '1.1' :
+           $version == Net::Curl::Easy::CURL_HTTP_VERSION_2_0() ? '2.0' : '';
+}
+
+# parse a header line (or status line) and return as key-value pairs
+sub _parse_header {
+    my $data = shift;
+
+    $data =~ s/[\x0A\x0D]*$//;
+
+    if ($data =~ m!^HTTP/([0-9.]+) [\x09\x20]+ (\d{3}) [\x09\x20]+ ([^\x0A\x0D]*)!x) {
+        return (
+            HTTPVersion => $1,
+            Status      => $2,
+            Reason      => $3,
+        );
+    }
+
+    my ($key, $val) = split(/:\s*/, $data, 2);
+    return if !$key;
+    return (lc($key) => $val);
+}
+
+# no Net::Curl::Easy;
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA::Backend::Net::Curl::Easy - A unified programming interface for Net::Curl::Easy
+
+=head1 VERSION
+
+version 0.900
+
+=head1 DESCRIPTION
+
+This module adds support for the HTTP client L<Net::Curl::Easy> to be used with the unified
+programming interface provided by L<HTTP::AnyUA>.
+
+=head1 CAVEATS
+
+=over 4
+
+=item *
+
+The C<redirects> field in the response is currently unsupported.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<HTTP::AnyUA::Backend>
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/lib/HTTP/AnyUA/Util.pm b/lib/HTTP/AnyUA/Util.pm
new file mode 100644 (file)
index 0000000..5bd7000
--- /dev/null
@@ -0,0 +1,314 @@
+package HTTP::AnyUA::Util;
+# ABSTRACT: Utility subroutines for HTTP::AnyUA backends
+
+use warnings;
+use strict;
+
+our $VERSION = '0.900'; # VERSION
+
+use Exporter qw(import);
+
+
+our @EXPORT_OK = qw(
+    http_headers_to_native
+    native_to_http_request
+    coderef_content_to_string
+    internal_exception
+    http_date
+    parse_http_date
+    uri_escape
+    www_form_urlencode
+);
+
+
+sub _croak { require Carp; Carp::croak(@_) }
+sub _usage { _croak("Usage: @_\n") }
+
+
+sub coderef_content_to_string {
+    my $content = shift;
+
+    return $content if !$content;
+
+    if (ref($content) eq 'CODE') {
+        # drain the request body
+        my $body = '';
+        while (my $chunk = $content->()) {
+            $body .= $chunk;
+        }
+        $content = $body;
+    }
+
+    return $content;
+}
+
+
+sub native_to_http_request {
+    my $method  = shift;
+    my $url     = shift;
+    my $args    = shift || {};
+
+    my $headers = [];
+    my $content = $args->{content};     # works as either scalar or coderef
+
+    # flatten headers
+    for my $header (keys %{$args->{headers} || {}}) {
+        my $value  = $args->{headers}{$header};
+        my @values = ref($value) eq 'ARRAY' ? @$value : ($value);
+        for my $v (@values) {
+            push @$headers, ($header => $v);
+        }
+    }
+
+    require HTTP::Request;
+    return HTTP::Request->new($method, $url, $headers, $content);
+}
+
+
+sub http_headers_to_native {
+    my $http_headers = shift;
+
+    my $native;
+
+    for my $header ($http_headers->header_field_names) {
+        my @values = $http_headers->header($header);
+        $native->{lc($header)} = @values == 1 ? $values[0] : [@values];
+    }
+
+    return $native;
+}
+
+
+sub internal_exception {
+    my $e       = shift or _usage(q{internal_exception($exception)});
+    my $resp    = shift || {};
+
+    $e = "$e";
+
+    $resp->{headers}{'client-original-status'} = $resp->{status} if $resp->{status};
+    $resp->{headers}{'client-original-reason'} = $resp->{reason} if $resp->{reason};
+
+    $resp->{success}    = '';
+    $resp->{status}     = 599;
+    $resp->{reason}     = 'Internal Exception';
+    $resp->{content}    = $e;
+    $resp->{headers}{'content-type'}    = 'text/plain';
+    $resp->{headers}{'content-length'}  = length $e;
+
+    return $resp;
+}
+
+
+# adapted from HTTP/Tiny.pm
+sub split_url {
+    my $url = shift or _usage(q{split_url($url)});
+
+    # URI regex adapted from the URI module
+    my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
+        or die(qq/Cannot parse URL: '$url'\n/);
+
+    $scheme     = lc $scheme;
+    $path_query = "/$path_query" unless $path_query =~ m<\A/>;
+
+    my $auth = '';
+    if ( (my $i = index $host, '@') != -1 ) {
+        # user:pass@host
+        $auth = substr $host, 0, $i, ''; # take up to the @ for auth
+        substr $host, 0, 1, '';          # knock the @ off the host
+
+        # userinfo might be percent escaped, so recover real auth info
+        $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+    }
+    my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
+             : $scheme eq 'http'                  ? 80
+             : $scheme eq 'https'                 ? 443
+             : undef;
+
+    return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
+}
+
+
+# Date conversions adapted from HTTP::Date
+# adapted from HTTP/Tiny.pm
+my $DoW = 'Sun|Mon|Tue|Wed|Thu|Fri|Sat';
+my $MoY = 'Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec';
+sub http_date {
+    my $time = shift or _usage(q{http_date($time)});
+    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
+    return sprintf('%s, %02d %s %04d %02d:%02d:%02d GMT',
+        substr($DoW,$wday*4,3),
+        $mday, substr($MoY,$mon*4,3), $year+1900,
+        $hour, $min, $sec
+    );
+}
+
+
+# adapted from HTTP/Tiny.pm
+sub parse_http_date {
+    my $str = shift or _usage(q{parse_http_date($str)});
+    my @tl_parts;
+    if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
+        @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
+    }
+    elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
+        @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
+    }
+    elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
+        @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
+    }
+    require Time::Local;
+    return eval {
+        my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
+        $t < 0 ? undef : $t;
+    };
+}
+
+
+# URI escaping adapted from URI::Escape
+# c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
+# perl 5.6 ready UTF-8 encoding adapted from JSON::PP
+# adapted from HTTP/Tiny.pm
+my %escapes = map { chr($_) => sprintf('%%%02X', $_) } 0..255;
+$escapes{' '} = '+';
+my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
+
+sub uri_escape {
+    my $str = shift or _usage(q{uri_escape($str)});
+    if ($] ge '5.008') {
+        utf8::encode($str);
+    }
+    else {
+        $str = pack('U*', unpack('C*', $str))   # UTF-8 encode a byte string
+            if (length $str == do { use bytes; length $str });
+        $str = pack('C*', unpack('C*', $str));  # clear UTF-8 flag
+    }
+    $str =~ s/($unsafe_char)/$escapes{$1}/ge;
+    return $str;
+}
+
+
+# adapted from HTTP/Tiny.pm
+sub www_form_urlencode {
+    my $data = shift;
+    ($data && ref $data)
+        or _usage(q{www_form_urlencode($dataref)});
+    (ref $data eq 'HASH' || ref $data eq 'ARRAY')
+        or _croak("form data must be a hash or array reference\n");
+
+    my @params = ref $data eq 'HASH' ? %$data : @$data;
+    @params % 2 == 0
+        or _croak("form data reference must have an even number of terms\n");
+
+    my @terms;
+    while (@params) {
+        my ($key, $value) = splice(@params, 0, 2);
+        if (ref $value eq 'ARRAY') {
+            unshift @params, map { $key => $_ } @$value;
+        }
+        else {
+            push @terms, join('=', map { uri_escape($_) } $key, $value);
+        }
+    }
+
+    return join('&', ref($data) eq 'ARRAY' ? @terms : sort @terms);
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::AnyUA::Util - Utility subroutines for HTTP::AnyUA backends
+
+=head1 VERSION
+
+version 0.900
+
+=head1 FUNCTIONS
+
+=head2 coderef_content_to_string
+
+    $content = coderef_content_to_string(\&code);
+    $content = coderef_content_to_string($content);     # noop
+
+Convert a coderef into a string of content by iteratively calling the coderef and concatenating the
+chunks it provides until the coderef returns undef or an empty string.
+
+=head2 native_to_http_request
+
+    $http_request = native_to_http_request($method, $url);
+    $http_request = native_to_http_request($method, $url, \%options);
+
+Convert a "native" request tuple to an L<HTTP::Request> object.
+
+=head2 http_headers_to_native
+
+    $headers = http_headers_to_native($http_headers);
+
+Convert an L<HTTP::Headers> object to a "native" hashref.
+
+=head2 internal_exception
+
+    $response = internal_exception($content);
+    $response = internal_exception($content, $response);
+
+Create an internal exception response. If an existing response is passed, that response will have
+its fields modified to become an internal exception.
+
+=head2 split_url
+
+    ($scheme, $host, $port, $path_query, $auth) = split_url($url);
+
+Split a URL into its components.
+
+=head2 http_date
+
+    $http_date = http_date($epoch_time);
+
+Convert an epoch time into a date format suitable for HTTP.
+
+=head2 parse_http_date
+
+    $epoch_time = parse_http_date($http_date);
+
+Convert an HTTP date into an epoch time. Returns undef if the date cannot be parsed.
+
+=head2 uri_escape
+
+    $escaped = uri_escape($unescaped);
+
+Escape a string for use in a URL query param or as C<application/x-www-form-urlencoded> data.
+
+=head2 www_form_urlencode
+
+    $bytes = www_form_urlencode(\%form_data);
+    $bytes = www_form_urlencode(\@form_data);
+
+Encode a hashref or arrayref as C<application/x-www-form-urlencoded> data.
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/HTTP-AnyUA/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Charles McGarvey.
+
+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
diff --git a/t/00-compile.t b/t/00-compile.t
new file mode 100644 (file)
index 0000000..e47e859
--- /dev/null
@@ -0,0 +1,69 @@
+use 5.006;
+use strict;
+use warnings;
+
+# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.056
+
+use Test::More;
+
+plan tests => 10 + ($ENV{AUTHOR_TESTING} ? 1 : 0);
+
+my @module_files = (
+    'HTTP/AnyUA.pm',
+    'HTTP/AnyUA/Backend.pm',
+    'HTTP/AnyUA/Backend/AnyEvent/HTTP.pm',
+    'HTTP/AnyUA/Backend/Furl.pm',
+    'HTTP/AnyUA/Backend/HTTP/AnyUA.pm',
+    'HTTP/AnyUA/Backend/HTTP/Tiny.pm',
+    'HTTP/AnyUA/Backend/LWP/UserAgent.pm',
+    'HTTP/AnyUA/Backend/Mojo/UserAgent.pm',
+    'HTTP/AnyUA/Backend/Net/Curl/Easy.pm',
+    'HTTP/AnyUA/Util.pm'
+);
+
+
+
+# no fake home requested
+
+my @switches = (
+    -d 'blib' ? '-Mblib' : '-Ilib',
+);
+
+use File::Spec;
+use IPC::Open3;
+use IO::Handle;
+
+open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!";
+
+my @warnings;
+for my $lib (@module_files)
+{
+    # see L<perlfaq8/How can I capture STDERR from an external command?>
+    my $stderr = IO::Handle->new;
+
+    diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
+            $^X, @switches, '-e', "require q[$lib]"))
+        if $ENV{PERL_COMPILE_TEST_DEBUG};
+
+    my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
+    binmode $stderr, ':crlf' if $^O eq 'MSWin32';
+    my @_warnings = <$stderr>;
+    waitpid($pid, 0);
+    is($?, 0, "$lib loaded ok");
+
+    shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
+        and not eval { require blib; blib->VERSION('1.01') };
+
+    if (@_warnings)
+    {
+        warn @_warnings;
+        push @warnings, @_warnings;
+    }
+}
+
+
+
+is(scalar(@warnings), 0, 'no warnings found')
+    or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING};
+
+
diff --git a/t/00-report-prereqs.dd b/t/00-report-prereqs.dd
new file mode 100644 (file)
index 0000000..dbad75d
--- /dev/null
@@ -0,0 +1,77 @@
+do { my $x = {
+       'configure' => {
+                        'requires' => {
+                                        'ExtUtils::MakeMaker' => '0'
+                                      }
+                      },
+       'develop' => {
+                      'requires' => {
+                                      'Dist::Zilla' => '5',
+                                      'Dist::Zilla::Plugin::Prereqs' => '0',
+                                      'Dist::Zilla::PluginBundle::Author::CCM' => '0',
+                                      'English' => '0',
+                                      'Pod::Coverage::TrustPod' => '0',
+                                      'Software::License::Perl_5' => '0',
+                                      'Test::CPAN::Changes' => '0.19',
+                                      'Test::CPAN::Meta' => '0',
+                                      'Test::CleanNamespaces' => '0.15',
+                                      'Test::EOL' => '0',
+                                      'Test::MinimumVersion' => '0',
+                                      'Test::More' => '0.96',
+                                      'Test::NoTabs' => '0',
+                                      'Test::Pod' => '1.41',
+                                      'Test::Pod::Coverage' => '1.08',
+                                      'Test::Pod::No404s' => '0',
+                                      'Test::Portability::Files' => '0'
+                                    }
+                    },
+       'runtime' => {
+                      'requires' => {
+                                      'Carp' => '0',
+                                      'Exporter' => '0',
+                                      'Fcntl' => '0',
+                                      'Future' => '0',
+                                      'MIME::Base64' => '0',
+                                      'Module::Loader' => '0',
+                                      'Scalar::Util' => '0',
+                                      'Time::Local' => '0',
+                                      'bytes' => '0',
+                                      'parent' => '0',
+                                      'perl' => '5.010',
+                                      'strict' => '0',
+                                      'warnings' => '0'
+                                    },
+                      'suggests' => {
+                                      'HTTP::Tiny' => '0'
+                                    }
+                    },
+       'test' => {
+                   'recommends' => {
+                                     'CPAN::Meta' => '2.120900'
+                                   },
+                   'requires' => {
+                                   'ExtUtils::MakeMaker' => '0',
+                                   'File::Spec' => '0',
+                                   'IO::Handle' => '0',
+                                   'IPC::Open3' => '0',
+                                   'Test2::API' => '0',
+                                   'Test::Exception' => '0',
+                                   'Test::More' => '0',
+                                   'blib' => '1.01',
+                                   'lib' => '0'
+                                 },
+                   'suggests' => {
+                                   'AnyEvent::HTTP' => '0',
+                                   'Furl' => '0',
+                                   'HTTP::Tiny' => '0',
+                                   'JSON' => '0',
+                                   'LWP::UserAgent' => '0',
+                                   'Mojo::UserAgent' => '0',
+                                   'Net::Curl::Easy' => '0',
+                                   'Plack::Runner' => '0',
+                                   'Starman' => '0'
+                                 }
+                 }
+     };
+  $x;
+ }
\ No newline at end of file
diff --git a/t/00-report-prereqs.t b/t/00-report-prereqs.t
new file mode 100644 (file)
index 0000000..e338372
--- /dev/null
@@ -0,0 +1,183 @@
+#!perl
+
+use strict;
+use warnings;
+
+# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.025
+
+use Test::More tests => 1;
+
+use ExtUtils::MakeMaker;
+use File::Spec;
+
+# from $version::LAX
+my $lax_version_re =
+    qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
+            |
+            (?:\.[0-9]+) (?:_[0-9]+)?
+        ) | (?:
+            v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
+            |
+            (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)?
+        )
+    )/x;
+
+# hide optional CPAN::Meta modules from prereq scanner
+# and check if they are available
+my $cpan_meta = "CPAN::Meta";
+my $cpan_meta_pre = "CPAN::Meta::Prereqs";
+my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic
+
+# Verify requirements?
+my $DO_VERIFY_PREREQS = 1;
+
+sub _max {
+    my $max = shift;
+    $max = ( $_ > $max ) ? $_ : $max for @_;
+    return $max;
+}
+
+sub _merge_prereqs {
+    my ($collector, $prereqs) = @_;
+
+    # CPAN::Meta::Prereqs object
+    if (ref $collector eq $cpan_meta_pre) {
+        return $collector->with_merged_prereqs(
+            CPAN::Meta::Prereqs->new( $prereqs )
+        );
+    }
+
+    # Raw hashrefs
+    for my $phase ( keys %$prereqs ) {
+        for my $type ( keys %{ $prereqs->{$phase} } ) {
+            for my $module ( keys %{ $prereqs->{$phase}{$type} } ) {
+                $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module};
+            }
+        }
+    }
+
+    return $collector;
+}
+
+my @include = qw(
+
+);
+
+my @exclude = qw(
+
+);
+
+# Add static prereqs to the included modules list
+my $static_prereqs = do 't/00-report-prereqs.dd';
+
+# Merge all prereqs (either with ::Prereqs or a hashref)
+my $full_prereqs = _merge_prereqs(
+    ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
+    $static_prereqs
+);
+
+# Add dynamic prereqs to the included modules list (if we can)
+my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
+if ( $source && $HAS_CPAN_META
+    && (my $meta = eval { CPAN::Meta->load_file($source) } )
+) {
+    $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
+}
+else {
+    $source = 'static metadata';
+}
+
+my @full_reports;
+my @dep_errors;
+my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
+
+# Add static includes into a fake section
+for my $mod (@include) {
+    $req_hash->{other}{modules}{$mod} = 0;
+}
+
+for my $phase ( qw(configure build test runtime develop other) ) {
+    next unless $req_hash->{$phase};
+    next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
+
+    for my $type ( qw(requires recommends suggests conflicts modules) ) {
+        next unless $req_hash->{$phase}{$type};
+
+        my $title = ucfirst($phase).' '.ucfirst($type);
+        my @reports = [qw/Module Want Have/];
+
+        for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
+            next if $mod eq 'perl';
+            next if grep { $_ eq $mod } @exclude;
+
+            my $file = $mod;
+            $file =~ s{::}{/}g;
+            $file .= ".pm";
+            my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
+
+            my $want = $req_hash->{$phase}{$type}{$mod};
+            $want = "undef" unless defined $want;
+            $want = "any" if !$want && $want == 0;
+
+            my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
+
+            if ($prefix) {
+                my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
+                $have = "undef" unless defined $have;
+                push @reports, [$mod, $want, $have];
+
+                if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
+                    if ( $have !~ /\A$lax_version_re\z/ ) {
+                        push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
+                    }
+                    elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
+                        push @dep_errors, "$mod version '$have' is not in required range '$want'";
+                    }
+                }
+            }
+            else {
+                push @reports, [$mod, $want, "missing"];
+
+                if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
+                    push @dep_errors, "$mod is not installed ($req_string)";
+                }
+            }
+        }
+
+        if ( @reports ) {
+            push @full_reports, "=== $title ===\n\n";
+
+            my $ml = _max( map { length $_->[0] } @reports );
+            my $wl = _max( map { length $_->[1] } @reports );
+            my $hl = _max( map { length $_->[2] } @reports );
+
+            if ($type eq 'modules') {
+                splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
+                push @full_reports, map { sprintf("    %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
+            }
+            else {
+                splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
+                push @full_reports, map { sprintf("    %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
+            }
+
+            push @full_reports, "\n";
+        }
+    }
+}
+
+if ( @full_reports ) {
+    diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
+}
+
+if ( @dep_errors ) {
+    diag join("\n",
+        "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n",
+        "The following REQUIRED prerequisites were not satisfied:\n",
+        @dep_errors,
+        "\n"
+    );
+}
+
+pass;
+
+# vim: ts=4 sts=4 sw=4 et:
diff --git a/t/01-new.t b/t/01-new.t
new file mode 100644 (file)
index 0000000..4362ef3
--- /dev/null
@@ -0,0 +1,19 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::Exception;
+use Test::More tests => 3;
+
+my $any_ua1 = HTTP::AnyUA->new(ua => 'Mock');
+ok $any_ua1, 'can construct a new HTTP::AnyUA';
+
+my $any_ua2 = HTTP::AnyUA->new('Mock');
+ok $any_ua2, 'can construct a new HTTP::AnyUA';
+
+throws_ok { HTTP::AnyUA->new() } qr/^Usage:/, 'constructor requires user agent';
+
diff --git a/t/02-shortcuts.t b/t/02-shortcuts.t
new file mode 100644 (file)
index 0000000..768c4bd
--- /dev/null
@@ -0,0 +1,24 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More tests => 10;
+
+HTTP::AnyUA->register_backend(Mock => '+MockBackend');
+
+my $any_ua  = HTTP::AnyUA->new(ua => 'Mock');
+my $backend = $any_ua->backend;
+
+my $url = 'http://acme.tld/';
+
+for my $shortcut (qw{get head put post delete}) {
+    my $resp    = $any_ua->$shortcut($url);
+    my $request = ($backend->requests)[-1];
+    is $request->[0], uc($shortcut), "$shortcut shortcut makes a request with the correct method";
+    is $request->[1], $url, "$shortcut shortcut makes a request with the correct URL";
+}
+
diff --git a/t/03-post_form.t b/t/03-post_form.t
new file mode 100644 (file)
index 0000000..d6746e6
--- /dev/null
@@ -0,0 +1,29 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More tests => 4;
+
+HTTP::AnyUA->register_backend(Mock => '+MockBackend');
+
+my $any_ua  = HTTP::AnyUA->new(ua => 'Mock');
+my $backend = $any_ua->backend;
+
+my $url = 'http://acme.tld/';
+my $form = {
+    foo => 'bar',
+    baz => 42,
+};
+my $resp = $any_ua->post_form($url, $form);
+
+my $request = ($backend->requests)[-1];
+
+is $request->[0], 'POST', 'post_form request method is POST';
+is $request->[1], $url, 'post_form request URL is correct';
+is $request->[2]{content}, 'baz=42&foo=bar', 'post_form request body is correct';
+is $request->[2]{headers}{'content-type'}, 'application/x-www-form-urlencoded', 'post_form request content-type header is correct';
+
diff --git a/t/04-internal-exception.t b/t/04-internal-exception.t
new file mode 100644 (file)
index 0000000..3e02360
--- /dev/null
@@ -0,0 +1,36 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:test :ua);
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 3;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new($ua, response_is_future => 1);
+
+    my $url     = 'invalidscheme://acme.tld/hello';
+    my $future  = $any_ua->get($url);
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+
+        note explain 'RESPONSE: ', $resp;
+
+        is_response_reason($resp, 'Internal Exception');
+        is_response_status($resp, 599);
+        is_response_success($resp, 0);
+    });
+
+    return $future;
+};
+
diff --git a/t/10-get.t b/t/10-get.t
new file mode 100644 (file)
index 0000000..6d2e203
--- /dev/null
@@ -0,0 +1,71 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+my $server = start_server('t/app.psgi');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 14;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new($ua, response_is_future => 1);
+
+    my $path    = '/get-document';
+    my $url     = $server->url . $path;
+    my $future  = $any_ua->get($url, {
+        headers => {
+            'x-test-custom' => 'whatever',
+            'x-test-multi'  => [qw(foo bar baz)],
+        },
+    });
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 5 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, 'GET', 'correct method sent');
+            is($env->{REQUEST_URI}, $path, 'correct url sent');
+            is($env->{content}, '', 'no body sent');
+            is($env->{HTTP_X_TEST_CUSTOM}, 'whatever', 'custom header sent');
+            like($env->{HTTP_X_TEST_MULTI}, qr/foo,\s*bar,\s*baz/, 'multi-value header sent');
+        }
+
+        is_response_content($resp, 'this is a document');
+        is_response_reason($resp, 'OK');
+        is_response_status($resp, 200);
+        is_response_success($resp, 1);
+        is_response_url($resp, $url);
+        is_response_header($resp, 'content-type', 'text/plain');
+        is_response_header($resp, 'content-length', 18);
+        is_response_header($resp, 'x-foo', 'bar');
+        response_protocol_ok($resp);
+    });
+
+    return $future;
+};
+
+# test:
+# X custom headers
+# X repeat headers (arrayref value)
+# X stream request
+# X stream response
+# X redirect log
+# X internal errors
+# X all methods: get, post, put, head, delete, custom
+# X basic auth in URL
+
diff --git a/t/11-post.t b/t/11-post.t
new file mode 100644 (file)
index 0000000..80fc830
--- /dev/null
@@ -0,0 +1,55 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+my $server = start_server('t/app.psgi');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 10;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new(ua => $ua, response_is_future => 1);
+
+    my $path    = '/create-document';
+    my $url     = $server->url . $path;
+    my $future  = $any_ua->post($url, {
+        headers => {'content-type' => 'text/plain'},
+        content => 'some document',
+    });
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 3 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, 'POST', 'correct method sent');
+            is($env->{REQUEST_URI}, $path, 'correct url sent');
+            is($env->{content}, 'some document', 'correct body sent');
+        }
+
+        is_response_content($resp, 'created document');
+        is_response_reason($resp, 'Created');
+        is_response_status($resp, 201);
+        is_response_success($resp, 1);
+        is_response_url($resp, $url);
+        is_response_header($resp, 'content-type', 'text/plain');
+        response_protocol_ok($resp);
+    });
+
+    return $future;
+};
+
diff --git a/t/12-put.t b/t/12-put.t
new file mode 100644 (file)
index 0000000..c6adb78
--- /dev/null
@@ -0,0 +1,56 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+my $server = start_server('t/app.psgi');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 9;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new(ua => $ua, response_is_future => 1);
+
+    my $path    = '/modify-document';
+    my $url     = $server->url . $path;
+    my $future  = $any_ua->put($url, {
+        headers => {'content-type' => 'text/plain'},
+        content => 'some document',
+    });
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 3 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, 'PUT', 'correct method sent');
+            is($env->{REQUEST_URI}, $path, 'correct url sent');
+            is($env->{content}, 'some document', 'correct body sent');
+        }
+
+        is_response_reason($resp, 'No Content');
+        is_response_status($resp, 204);
+        is_response_success($resp, 1);
+        is_response_url($resp, $url);
+        response_protocol_ok($resp);
+
+        my $body = ref($resp) eq 'HASH' && $resp->{content};
+        ok(!$body, 'response body is empty');
+    });
+
+    return $future;
+};
+
diff --git a/t/13-head.t b/t/13-head.t
new file mode 100644 (file)
index 0000000..9e68542
--- /dev/null
@@ -0,0 +1,54 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+my $server = start_server('t/app.psgi');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 10;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new(ua => $ua, response_is_future => 1);
+
+    my $path    = '/get-document';
+    my $url     = $server->url . $path;
+    my $future  = $any_ua->head($url);
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 2 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, 'HEAD', 'correct method sent');
+            is($env->{REQUEST_URI}, $path, 'correct url sent');
+        }
+
+        is_response_reason($resp, 'OK');
+        is_response_status($resp, 200);
+        is_response_success($resp, 1);
+        is_response_url($resp, $url);
+        is_response_header($resp, 'content-type', 'text/plain');
+        is_response_header($resp, 'content-length', 18);
+        response_protocol_ok($resp);
+
+        my $body = ref($resp) eq 'HASH' && $resp->{content};
+        ok(!$body, 'response body is empty');
+    });
+
+    return $future;
+};
+
diff --git a/t/14-delete.t b/t/14-delete.t
new file mode 100644 (file)
index 0000000..86682e4
--- /dev/null
@@ -0,0 +1,52 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+my $server = start_server('t/app.psgi');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 8;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new(ua => $ua, response_is_future => 1);
+
+    my $path    = '/modify-document';
+    my $url     = $server->url . $path;
+    my $future  = $any_ua->delete($url);
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 2 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, 'DELETE', 'correct method sent');
+            is($env->{REQUEST_URI}, $path, 'correct url sent');
+        }
+
+        is_response_reason($resp, 'No Content');
+        is_response_status($resp, 204);
+        is_response_success($resp, 1);
+        is_response_url($resp, $url);
+        response_protocol_ok($resp);
+
+        my $body = ref($resp) eq 'HASH' && $resp->{content};
+        ok(!$body, 'response body is empty');
+    });
+
+    return $future;
+};
+
diff --git a/t/15-custom-method.t b/t/15-custom-method.t
new file mode 100644 (file)
index 0000000..7dc7ab2
--- /dev/null
@@ -0,0 +1,56 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+my $server = start_server('t/app.psgi');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 13;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new(ua => $ua, response_is_future => 1);
+
+    my $method  = 'FOOBAR';
+    my $path    = '/get-document';
+    my $url     = $server->url . $path;
+    my $future  = $any_ua->request($method => $url, {headers => {'x-test-custom' => 'whatever'}});
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 4 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, $method, 'correct method sent');
+            is($env->{REQUEST_URI}, $path, 'correct url sent');
+            is($env->{content}, '', 'no body sent');
+            is($env->{HTTP_X_TEST_CUSTOM}, 'whatever', 'custom header sent');
+        }
+
+        is_response_content($resp, 'this is a document');
+        is_response_reason($resp, 'OK');
+        is_response_status($resp, 200);
+        is_response_success($resp, 1);
+        is_response_url($resp, $url);
+        is_response_header($resp, 'content-type', 'text/plain');
+        is_response_header($resp, 'content-length', 18);
+        is_response_header($resp, 'x-foo', 'bar');
+        response_protocol_ok($resp);
+    });
+
+    return $future;
+};
+
diff --git a/t/20-data_callback.t b/t/20-data_callback.t
new file mode 100644 (file)
index 0000000..1e8847c
--- /dev/null
@@ -0,0 +1,59 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+my $server = start_server('t/app.psgi');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 13;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new($ua, response_is_future => 1);
+
+    my $path    = '/get-document';
+    my $url     = $server->url . $path;
+    my $body    = '';
+    my $future  = $any_ua->get($url, {
+        data_callback   => sub { my ($part, $resp) = @_; $body .= $part; },
+    });
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 3 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, 'GET', 'correct method sent');
+            is($env->{REQUEST_URI}, $path, 'correct url sent');
+            is($env->{content}, '', 'no body sent');
+        }
+
+        is($body, 'this is a document', 'streamed response content matches');
+        ok($resp && !$resp->{content}, 'content in response structure is empty');
+
+        is_response_reason($resp, 'OK');
+        is_response_status($resp, 200);
+        is_response_success($resp, 1);
+        is_response_url($resp, $url);
+        is_response_header($resp, 'content-type', 'text/plain');
+        is_response_header($resp, 'content-length', 18);
+        is_response_header($resp, 'x-foo', 'bar');
+        response_protocol_ok($resp);
+    });
+
+    return $future;
+};
+
diff --git a/t/21-basic-auth.t b/t/21-basic-auth.t
new file mode 100644 (file)
index 0000000..0631e28
--- /dev/null
@@ -0,0 +1,62 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+my $server = start_server('t/app.psgi');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 12;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new($ua, response_is_future => 1);
+
+    my $user    = 'bob';
+    my $pass    = 'opensesame';
+    my $auth    = 'Ym9iOm9wZW5zZXNhbWU=';
+    my $path    = '/get-document';
+    my $url     = $server->url . $path;
+    $url =~ s!^(https?://)!${1}${user}:${pass}\@!;
+    my $future  = $any_ua->get($url);
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 4 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, 'GET', 'correct method sent');
+            is($env->{REQUEST_URI}, $path, 'correct url sent');
+            is($env->{content}, '', 'no body sent');
+            is($env->{HTTP_AUTHORIZATION}, "Basic $auth", 'correct authorization sent');
+        }
+
+        is_response_content($resp, 'this is a document');
+        is_response_reason($resp, 'OK');
+        is_response_status($resp, 200);
+        is_response_success($resp, 1);
+        TODO: {
+            local $TODO = 'some user agents strip the auth from the URL';
+            # Mojo::UserAgent strips the auth from the URL
+            is_response_url($resp, $url);
+        };
+        is_response_header($resp, 'content-type', 'text/plain');
+        is_response_header($resp, 'content-length', 18);
+        response_protocol_ok($resp);
+    });
+
+    return $future;
+};
+
diff --git a/t/22-redirects.t b/t/22-redirects.t
new file mode 100644 (file)
index 0000000..d3491f4
--- /dev/null
@@ -0,0 +1,93 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+my $server = start_server('t/app.psgi');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 29;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new($ua, response_is_future => 1);
+
+    # enable redirects for useragents that don't do it by default
+    if ($ua->isa('Mojo::UserAgent')) {
+        $ua->max_redirects(5);
+    }
+    elsif ($ua->isa('Net::Curl::Easy')) {
+        $ua->setopt(Net::Curl::Easy::CURLOPT_FOLLOWLOCATION(), 1);
+    }
+
+    my $path    = '/foo';
+    my $url     = $server->url . $path;
+    my $future  = $any_ua->get($url);
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 3 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, 'GET', 'correct method sent');
+            is($env->{REQUEST_URI}, '/baz', 'correct url sent');
+            is($env->{content}, '', 'no body sent');
+        }
+
+        is_response_content($resp, 'you found it');
+        is_response_reason($resp, 'OK');
+        is_response_status($resp, 200);
+        is_response_success($resp, 1);
+        TODO: {
+            local $TODO = 'some user agents do not support this correctly';
+            # Furl has the URL from the original request, not the last request
+            is_response_url($resp, $server->url . '/baz');
+        };
+        is_response_header($resp, 'content-type', 'text/plain');
+        is_response_header($resp, 'content-length', 12);
+        response_protocol_ok($resp);
+
+        SKIP: {
+            skip 'no redirect chain', 18 if !$resp || !$resp->{redirects};
+
+            my $chain = $resp->{redirects};
+            isa_ok($chain, 'ARRAY', 'redirect chain');
+            is(scalar @$chain, 2, 'redirect chain has two redirections');
+
+            my $r1 = $chain->[0];
+            is_response_content($r1, 'the thing you seek is not here');
+            is_response_reason($r1, 'Found');
+            is_response_status($r1, 302);
+            is_response_success($r1, 0);
+            is_response_url($r1, $server->url . '/foo');
+            is_response_header($r1, 'content-type', 'text/plain');
+            is_response_header($r1, 'content-length', 30);
+            response_protocol_ok($r1);
+
+            my $r2 = $chain->[1];
+            is_response_content($r2, 'not here either');
+            is_response_reason($r2, 'Moved Permanently');
+            is_response_status($r2, 301);
+            is_response_success($r2, 0);
+            is_response_url($r2, $server->url . '/bar');
+            is_response_header($r2, 'content-type', 'text/plain');
+            is_response_header($r2, 'content-length', 15);
+            response_protocol_ok($r2);
+        }
+    });
+
+    return $future;
+};
+
diff --git a/t/23-content-coderef.t b/t/23-content-coderef.t
new file mode 100644 (file)
index 0000000..c87833c
--- /dev/null
@@ -0,0 +1,65 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More;
+use Util qw(:server :test :ua);
+
+# using Starman because we need a server that can handle chunked requests
+my $server = start_server('t/app.psgi', type => 'Starman');
+
+plan tests => scalar user_agents;
+
+test_all_user_agents {
+    plan tests => 10;
+
+    my $ua      = shift;
+    my $any_ua  = HTTP::AnyUA->new(ua => $ua, response_is_future => 1);
+
+    if ($ua->isa('Mojo::UserAgent')) {
+        # disable keep-alive to avoid Mojo::Reactor::EV warnings
+        $ua->max_connections(0);
+    }
+
+    my $chunk   = 0;
+    my @chunk   = ('some ', 'document');
+    my $code    = sub { return $chunk[$chunk++] };
+
+    my $path    = '/create-document';
+    my $url     = $server->url . $path;
+    my $future  = $any_ua->post($url, {
+        headers => {'content-type' => 'text/plain'},
+        content => $code,
+    });
+
+    $future->on_ready(sub {
+        my $self    = shift;
+        my $resp    = $self->is_done ? $self->get : $self->failure;
+        my $env     = $server->read_env;
+
+        note explain 'RESPONSE: ', $resp;
+        note explain 'ENV: ', $env;
+
+        SKIP: {
+            skip 'unexpected env', 3 if ref($env) ne 'HASH';
+            is($env->{REQUEST_METHOD}, 'POST', 'correct method sent');
+            is($env->{REQUEST_URI}, $path, 'correct url sent');
+            is($env->{content}, 'some document', 'correct body sent');
+        }
+
+        is_response_content($resp, 'created document');
+        is_response_reason($resp, 'Created');
+        is_response_status($resp, 201);
+        is_response_success($resp, 1);
+        is_response_url($resp, $url);
+        is_response_header($resp, 'content-type', 'text/plain');
+        response_protocol_ok($resp);
+    });
+
+    return $future;
+};
+
diff --git a/t/app.psgi b/t/app.psgi
new file mode 100644 (file)
index 0000000..c860c07
--- /dev/null
@@ -0,0 +1,46 @@
+# A little plack app for testing HTTP::AnyUA
+
+# When a request is made, the environment will be sent back to the test which will assert that the
+# request was made correctly.
+
+use Plack::Builder;
+use Util qw(send_env);
+
+builder {
+
+    mount '/create-document' => sub {
+        my $env = shift;
+        send_env($env);
+        [201, ['Content-Type' => 'text/plain'], ['created document']];
+    };
+
+    mount '/get-document' => sub {
+        my $env = shift;
+        send_env($env);
+        [200, ['Content-Type' => 'text/plain', 'x-foo' => 'bar'], ['this is a document']];
+    };
+
+    mount '/modify-document' => sub {
+        my $env = shift;
+        send_env($env);
+        [204, [], ['']];
+    };
+
+    mount '/foo' => sub {
+        [302, ['Content-Type' => 'text/plain', 'Location' => '/bar'], ['the thing you seek is not here']];
+    };
+    mount '/bar' => sub {
+        [301, ['Content-Type' => 'text/plain', 'Location' => '/baz'], ['not here either']];
+    };
+    mount '/baz' => sub {
+        my $env = shift;
+        send_env($env);
+        [200, ['Content-Type' => 'text/plain'], ['you found it']];
+    };
+
+    mount '/' => sub {
+        [200, ['Content-Type' => 'text/plain'], ['this is a test server']];
+    };
+
+}
+
diff --git a/t/lib/MockBackend.pm b/t/lib/MockBackend.pm
new file mode 100644 (file)
index 0000000..c8b6535
--- /dev/null
@@ -0,0 +1,45 @@
+package MockBackend;
+# ABSTRACT: A backend for testing HTTP::AnyUA
+
+use warnings;
+use strict;
+
+use parent 'HTTP::AnyUA::Backend';
+
+
+=method response
+
+    $response = $backend->response;
+    $response = $backend->response($response);
+
+Get and set the response hashref or L<Future> that this backend will always respond with.
+
+=cut
+
+sub response { @_ == 2 ? $_[0]->{response} = pop : $_[0]->{response} }
+
+=method requests
+
+    @requests = $backend->requests;
+
+Get the requests the backend has handled so far.
+
+=cut
+
+sub requests { @{$_[0]->{requests} || []} }
+
+sub request {
+    my $self = shift;
+
+    push @{$self->{requests} ||= []}, [@_];
+
+    return $self->response || {
+        success => '',
+        status  => 599,
+        reason  => 'Internal Exception',
+        content => "No response mocked.\n",
+    };
+}
+
+
+1;
diff --git a/t/lib/Server.pm b/t/lib/Server.pm
new file mode 100644 (file)
index 0000000..fbac0da
--- /dev/null
@@ -0,0 +1,185 @@
+package Server;
+# ABSTRACT: A runner for test HTTP servers
+
+=head1 SYNOPSIS
+
+    use Server;
+    my $server = Server->new('app.psgi');
+
+=head1 DESCRIPTION
+
+Throws up an HTTP server on a random port, suitable for testing. Server logs will be printed to
+C<STDERR> as test notes.
+
+=cut
+
+use warnings;
+use strict;
+
+use IO::Handle;
+use Plack::Runner;
+use Util qw(recv_env);
+
+=method new
+
+    $server = Server->new($path);
+    $server = Server->new(\&app);
+    $server = Server->new(\&app, type => 'Starman');
+
+Construct and L</start> a new test HTTP server.
+
+=cut
+
+sub new {
+    my $class   = shift;
+    my $app     = shift or die 'PSGI app required';
+    my %args    = @_;
+
+    $args{type} ||= 'HTTP::Server::PSGI';
+
+    my $self = bless {app => $app, %args}, $class;
+    return $self->start;
+}
+
+=attr app
+
+Get the app that was passed to L</new>.
+
+=attr in
+
+Get a filehandle for reading the server's STDOUT.
+
+=attr pid
+
+Get the process identifier of the server.
+
+=attr port
+
+Get the port number the server is listening on.
+
+=attr url
+
+Get the URL for the server.
+
+=attr type
+
+Get the type of server that was passed to L</new>.
+
+=cut
+
+sub app  { shift->{app}  }
+sub in   { shift->{in}   }
+sub pid  { shift->{pid}  }
+sub port { shift->{port} }
+sub url  { 'http://localhost:' . shift->port }
+sub type { shift->{type} }
+
+=method start
+
+    $server->start;
+
+Start the server.
+
+=cut
+
+sub start {
+    my $self = shift;
+
+    # do not start on top of an already-started server
+    return $self if $self->{pid};
+
+    my $type = $self->type;
+
+    my $pid = open(my $pipe, '-|');
+    defined $pid or die "fork failed: $!";
+
+    $pipe->autoflush(1);
+
+    if ($pid) {
+        my $port = <$pipe>;
+        die 'Could not start test server' if !$port;
+        chomp $port;
+
+        $self->{in}     = $pipe;
+        $self->{pid}    = $pid;
+        $self->{port}   = $port;
+    }
+    else {
+        tie *STDERR, 'Server::RedirectToTestHarness';
+
+        autoflush STDOUT 1;
+
+        for my $try (1..10) {
+            my $port_num = $ENV{PERL_HTTP_ANYUA_TEST_PORT} || int(rand(32768)) + 32768;
+            print STDERR sprintf('Try %02d - Attempting to start a server on port %d for testing...', $try, $port_num);
+
+            local $SIG{ALRM} = sub { print "$port_num\n" };
+            alarm 1;
+
+            eval {
+                my $runner = Plack::Runner->new;
+                $runner->parse_options('-s', $type, '-p', $port_num);
+                $runner->run($self->app);
+            };
+            warn $@ if $@;
+
+            alarm 0;
+        }
+
+        print STDERR "Giving up...";
+        exit;
+    }
+
+    return $self;
+}
+
+=method stop
+
+    $server->stop;
+
+Stop the server. Called implicitly by C<DESTROY>.
+
+=cut
+
+sub stop {
+    my $self = shift;
+
+    if (my $pid = $self->pid) {
+        kill 'TERM', $pid;
+        waitpid $pid, 0;
+        $? = 0;             # don't let child exit status affect parent
+    }
+    %$self = (app => $self->app);
+}
+
+sub DESTROY {
+    my $self = shift;
+    $self->stop;
+}
+
+
+=method read_env
+
+    $env = $server->read_env;
+
+Read a L<PSGI> environment from the server, sent by L<Util/send_env>.
+
+=cut
+
+sub read_env {
+    my $self = shift;
+    return recv_env($self->in or die 'Not connected');
+}
+
+
+{
+    package Server::RedirectToTestHarness;
+
+    use Test::More ();
+
+    sub TIEHANDLE   { bless {} }
+    sub PRINT       { shift; Test::More::note('Server: ', @_) }
+    sub PRINTF      { shift; Test::More::note('Server: ', sprintf(@_)) }
+}
+
+1;
diff --git a/t/lib/Util.pm b/t/lib/Util.pm
new file mode 100644 (file)
index 0000000..892e085
--- /dev/null
@@ -0,0 +1,343 @@
+package Util;
+# ABSTRACT: Utility subroutines for testing HTTP::AnyUA
+
+=head1 SYNOPSIS
+
+    use Util qw(:server :test :ua);
+
+=cut
+
+use warnings;
+use strict;
+
+use Exporter qw(import);
+use Future;
+use Test2::API qw(context release);
+use Test::More;
+
+our @EXPORT_OK = qw(
+    recv_env
+    send_env
+    start_server
+    use_server
+
+    is_response_content
+    is_response_header
+    is_response_reason
+    is_response_status
+    is_response_success
+    is_response_url
+    response_protocol_ok
+
+    test_all_user_agents
+    test_user_agent
+    user_agents
+);
+our %EXPORT_TAGS = (
+    server  => [qw(
+        recv_env
+        send_env
+        start_server
+        use_server
+    )],
+    test    => [qw(
+        is_response_content
+        is_response_header
+        is_response_reason
+        is_response_status
+        is_response_success
+        is_response_url
+        response_protocol_ok
+    )],
+    ua      => [qw(
+        test_all_user_agents
+        test_user_agent
+        user_agents
+    )],
+);
+
+our @USER_AGENTS = qw(
+    AnyEvent::HTTP
+    Furl
+    HTTP::Tiny
+    LWP::UserAgent
+    Mojo::UserAgent
+    Net::Curl::Easy
+);
+our %USER_AGENT_TEST_WRAPPER;
+
+sub _croak { require Carp; Carp::croak(@_) }
+sub _carp  { require Carp; Carp::carp(@_)  }
+
+
+=func use_server
+
+    use_server;
+
+Try to use the test server package. If it fails, the test plan is set to C<skip_all>.
+
+=cut
+
+sub use_server {
+    eval 'use Server';
+    if (my $err = $@) {
+        diag $err;
+        plan skip_all => 'Could not compile test server runner.';
+    }
+}
+
+=func start_server
+
+    $server = start_server('app.psgi');
+
+Start a test server.
+
+=cut
+
+sub start_server {
+    use_server;
+    my $server = eval { Server->new(@_) };
+    if (my $err = $@) {
+        diag $err;
+        plan skip_all => 'Could not start test server.';
+    }
+    return $server;
+}
+
+=func send_env
+
+    send_env(\%env);
+
+Encode and send a L<PSGI> environment over C<STDOUT>, to be received by L</recv_env>.
+
+=cut
+
+sub send_env {
+    my $env = shift || {};
+    my $fh  = shift || *STDOUT;
+
+    my %data = map { !/^psgi/ ? ($_ => $env->{$_}) : () } keys %$env;
+
+    # read in the request body
+    my $buffer;
+    my $body = '';
+    $env->{'psgix.input.buffered'} or die 'Expected buffered input';
+    while (1) {
+        my $bytes = $env->{'psgi.input'}->read($buffer, 32768);
+        defined $bytes or die 'Error while reading input stream';
+        last if !$bytes;
+        $body .= $buffer;
+    }
+    $data{content} = $body;
+
+    require JSON;
+    print $fh JSON::encode_json(\%data), "\n";
+}
+
+=func recv_env
+
+    my $env = recv_env($fh);
+
+Receive and decode a L<PSGI> environment over a filehandle, sent by L</send_env>.
+
+=cut
+
+sub recv_env {
+    my $fh = shift;
+
+    my $data = <$fh>;
+
+    require JSON;
+    return JSON::decode_json($data);
+}
+
+
+=func is_response_content, is_response_reason, is_response_status, is_response_success, is_response_url, is_response_header
+
+    is_response_content($resp, $body, $test_name);
+    is_response_content($resp, $body);
+    # etc.
+
+Test a response for various fields.
+
+=cut
+
+sub is_response_content { my $ctx = context; release $ctx, _test_response_field($_[0], 'content', @_[1,2]) }
+sub is_response_reason  { my $ctx = context; release $ctx, _test_response_field($_[0], 'reason',  @_[1,2]) }
+sub is_response_status  { my $ctx = context; release $ctx, _test_response_field($_[0], 'status',  @_[1,2]) }
+sub is_response_success { my $ctx = context; release $ctx, _test_response_field($_[0], 'success', @_[1,2], 'bool') }
+sub is_response_url     { my $ctx = context; release $ctx, _test_response_field($_[0], 'url',     @_[1,2]) }
+sub is_response_header  { my $ctx = context; release $ctx, _test_response_header(@_) }
+
+=func response_protocol_ok
+
+    response_protocol_ok($resp);
+
+Test that a response protocol is well-formed.
+
+=cut
+
+sub response_protocol_ok {
+    my ($resp) = @_;
+    my $ctx = context;
+    my $test;
+    if (ref($resp) ne 'HASH') {
+        $test = isa_ok($resp, 'HASH', 'response');
+    }
+    else {
+        my $proto = $resp->{protocol};
+        $test = ok(!$proto || $proto =~ m!^HTTP/!, 'response protocol matches or is missing');
+    }
+    release $ctx, $test;
+}
+
+sub _test_response_field {
+    my ($resp, $key, $val, $name, $type) = @_;
+    if (ref($resp) ne 'HASH') {
+        return isa_ok($resp, 'HASH', 'response');
+    }
+    elsif (defined $val) {
+        $type ||= '';
+        if ($type eq 'bool') {
+            my $disp = $val ? 'true' : 'false';
+            return is(!!$resp->{$key}, !!$val, $name || "response $key matches \"$disp\"");
+        }
+        else {
+            my $disp = $val;
+            $disp =~ s/(.{40}).{4,}/$1.../;
+            return is($resp->{$key}, $val, $name || "response $key matches \"$disp\"");
+        }
+    }
+    else {
+        return ok(exists $resp->{$key}, $name || "response $key exists");
+    }
+}
+
+sub _test_response_header {
+    my ($resp, $key, $val, $name) = @_;
+    if (ref($resp) ne 'HASH') {
+        return isa_ok($resp, 'HASH', 'response');
+    }
+    elsif (ref($resp->{headers}) ne 'HASH') {
+        return isa_ok($resp, 'HASH', 'response headers');
+    }
+    elsif (defined $val) {
+        my $disp = $val;
+        $disp =~ s/(.{40}).{4,}/$1.../;
+        return is($resp->{headers}{$key}, $val, $name || "response header \"$key\" matches \"$disp\"");
+    }
+    else {
+        return ok(exists $resp->{headers}{$key}, $name || "response header $key exists");
+    }
+}
+
+
+=func user_agents
+
+    @user_agents = user_agents;
+
+Get a list of user agents available for testing. Shortcut for C<@Util::USER_AGENTS>.
+
+=cut
+
+sub user_agents { @USER_AGENTS }
+
+=func test_user_agent
+
+    test_user_agent($ua_type, \&test);
+
+Run a subtest against one user agent.
+
+=cut
+
+sub test_user_agent {
+    my $name = shift;
+    my $code = shift;
+
+    my $wrapper = $USER_AGENT_TEST_WRAPPER{$name} || sub {
+        my $name = shift;
+        my $code = shift;
+
+        if (!eval "require $name") {
+            diag $@;
+            return;
+        }
+
+        my $ua = $name->new;
+        $code->($ua);
+
+        return 1;
+    };
+
+    # this is quite gross, but we don't want any active event loops from preventing us from
+    # committing suicide if things are looking deadlocked
+    local $SIG{ALRM} = sub { $@ = 'Deadlock or test is slow'; _carp $@; exit 1 };
+    alarm 5;
+    my $ret = $wrapper->($name, $code);
+    alarm 0;
+
+    plan skip_all => "Cannot create user agent ${name}" if !$ret;
+}
+
+=func test_all_user_agents
+
+    test_all_user_agents { ... };
+
+Run the same subtest against all user agents returned by L</user_agents>.
+
+=cut
+
+sub test_all_user_agents(&) {
+    my $code = shift;
+
+    for my $name (user_agents) {
+        subtest $name => sub {
+            test_user_agent($name, $code);
+        };
+    }
+}
+
+
+$USER_AGENT_TEST_WRAPPER{'AnyEvent::HTTP'} = sub {
+    my $name = shift;
+    my $code = shift;
+
+    if (!eval "require $name") {
+        diag $@;
+        return;
+    }
+
+    require AnyEvent;
+    my $cv = AnyEvent->condvar;
+
+    my $ua = 'AnyEvent::HTTP';
+    my @futures = $code->($ua);
+    my $waiting = Future->wait_all(@futures)->on_ready(sub { $cv->send });
+
+    $cv->recv;
+
+    return 1;
+};
+
+$USER_AGENT_TEST_WRAPPER{'Mojo::UserAgent'} = sub {
+    my $name = shift;
+    my $code = shift;
+
+    if (!eval "require $name") {
+        diag $@;
+        return;
+    }
+
+    require Mojo::IOLoop;
+    my $loop = Mojo::IOLoop->singleton;
+
+    my $ua = Mojo::UserAgent->new;
+    my @futures = $code->($ua);
+    my $waiting = Future->wait_all(@futures)->on_ready(sub { $loop->reset });
+
+    $loop->start;
+
+    return 1;
+};
+
+1;
diff --git a/xt/author/clean-namespaces.t b/xt/author/clean-namespaces.t
new file mode 100644 (file)
index 0000000..36387da
--- /dev/null
@@ -0,0 +1,11 @@
+use strict;
+use warnings;
+
+# this test was generated with Dist::Zilla::Plugin::Test::CleanNamespaces 0.006
+
+use Test::More 0.94;
+use Test::CleanNamespaces 0.15;
+
+subtest all_namespaces_clean => sub { all_namespaces_clean() };
+
+done_testing;
diff --git a/xt/author/critic.t b/xt/author/critic.t
new file mode 100644 (file)
index 0000000..d5b4c96
--- /dev/null
@@ -0,0 +1,12 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use English qw(-no_match_vars);
+
+eval "use Test::Perl::Critic";
+plan skip_all => 'Test::Perl::Critic required to criticise code' if $@;
+Test::Perl::Critic->import( -profile => "perlcritic.rc" ) if -e "perlcritic.rc";
+all_critic_ok();
diff --git a/xt/author/eol.t b/xt/author/eol.t
new file mode 100644 (file)
index 0000000..da57476
--- /dev/null
@@ -0,0 +1,55 @@
+use strict;
+use warnings;
+
+# this test was generated with Dist::Zilla::Plugin::Test::EOL 0.19
+
+use Test::More 0.88;
+use Test::EOL;
+
+my @files = (
+    'lib/HTTP/AnyUA.pm',
+    'lib/HTTP/AnyUA/Backend.pm',
+    'lib/HTTP/AnyUA/Backend/AnyEvent/HTTP.pm',
+    'lib/HTTP/AnyUA/Backend/Furl.pm',
+    'lib/HTTP/AnyUA/Backend/HTTP/AnyUA.pm',
+    'lib/HTTP/AnyUA/Backend/HTTP/Tiny.pm',
+    'lib/HTTP/AnyUA/Backend/LWP/UserAgent.pm',
+    'lib/HTTP/AnyUA/Backend/Mojo/UserAgent.pm',
+    'lib/HTTP/AnyUA/Backend/Net/Curl/Easy.pm',
+    'lib/HTTP/AnyUA/Util.pm',
+    't/00-compile.t',
+    't/00-report-prereqs.dd',
+    't/00-report-prereqs.t',
+    't/01-new.t',
+    't/02-shortcuts.t',
+    't/03-post_form.t',
+    't/04-internal-exception.t',
+    't/10-get.t',
+    't/11-post.t',
+    't/12-put.t',
+    't/13-head.t',
+    't/14-delete.t',
+    't/15-custom-method.t',
+    't/20-data_callback.t',
+    't/21-basic-auth.t',
+    't/22-redirects.t',
+    't/23-content-coderef.t',
+    't/app.psgi',
+    't/lib/MockBackend.pm',
+    't/lib/Server.pm',
+    't/lib/Util.pm',
+    'xt/author/clean-namespaces.t',
+    'xt/author/critic.t',
+    'xt/author/eol.t',
+    'xt/author/no-tabs.t',
+    'xt/author/pod-coverage.t',
+    'xt/author/pod-no404s.t',
+    'xt/author/pod-syntax.t',
+    'xt/author/portability.t',
+    'xt/release/cpan-changes.t',
+    'xt/release/distmeta.t',
+    'xt/release/minimum-version.t'
+);
+
+eol_unix_ok($_, { trailing_whitespace => 1 }) foreach @files;
+done_testing;
diff --git a/xt/author/no-tabs.t b/xt/author/no-tabs.t
new file mode 100644 (file)
index 0000000..e67433f
--- /dev/null
@@ -0,0 +1,55 @@
+use strict;
+use warnings;
+
+# this test was generated with Dist::Zilla::Plugin::Test::NoTabs 0.15
+
+use Test::More 0.88;
+use Test::NoTabs;
+
+my @files = (
+    'lib/HTTP/AnyUA.pm',
+    'lib/HTTP/AnyUA/Backend.pm',
+    'lib/HTTP/AnyUA/Backend/AnyEvent/HTTP.pm',
+    'lib/HTTP/AnyUA/Backend/Furl.pm',
+    'lib/HTTP/AnyUA/Backend/HTTP/AnyUA.pm',
+    'lib/HTTP/AnyUA/Backend/HTTP/Tiny.pm',
+    'lib/HTTP/AnyUA/Backend/LWP/UserAgent.pm',
+    'lib/HTTP/AnyUA/Backend/Mojo/UserAgent.pm',
+    'lib/HTTP/AnyUA/Backend/Net/Curl/Easy.pm',
+    'lib/HTTP/AnyUA/Util.pm',
+    't/00-compile.t',
+    't/00-report-prereqs.dd',
+    't/00-report-prereqs.t',
+    't/01-new.t',
+    't/02-shortcuts.t',
+    't/03-post_form.t',
+    't/04-internal-exception.t',
+    't/10-get.t',
+    't/11-post.t',
+    't/12-put.t',
+    't/13-head.t',
+    't/14-delete.t',
+    't/15-custom-method.t',
+    't/20-data_callback.t',
+    't/21-basic-auth.t',
+    't/22-redirects.t',
+    't/23-content-coderef.t',
+    't/app.psgi',
+    't/lib/MockBackend.pm',
+    't/lib/Server.pm',
+    't/lib/Util.pm',
+    'xt/author/clean-namespaces.t',
+    'xt/author/critic.t',
+    'xt/author/eol.t',
+    'xt/author/no-tabs.t',
+    'xt/author/pod-coverage.t',
+    'xt/author/pod-no404s.t',
+    'xt/author/pod-syntax.t',
+    'xt/author/portability.t',
+    'xt/release/cpan-changes.t',
+    'xt/release/distmeta.t',
+    'xt/release/minimum-version.t'
+);
+
+notabs_ok($_) foreach @files;
+done_testing;
diff --git a/xt/author/pod-coverage.t b/xt/author/pod-coverage.t
new file mode 100644 (file)
index 0000000..66b3b64
--- /dev/null
@@ -0,0 +1,7 @@
+#!perl
+# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests.
+
+use Test::Pod::Coverage 1.08;
+use Pod::Coverage::TrustPod;
+
+all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' });
diff --git a/xt/author/pod-no404s.t b/xt/author/pod-no404s.t
new file mode 100644 (file)
index 0000000..eb9760c
--- /dev/null
@@ -0,0 +1,21 @@
+#!perl
+
+use strict;
+use warnings;
+use Test::More;
+
+foreach my $env_skip ( qw(
+  SKIP_POD_NO404S
+  AUTOMATED_TESTING
+) ){
+  plan skip_all => "\$ENV{$env_skip} is set, skipping"
+    if $ENV{$env_skip};
+}
+
+eval "use Test::Pod::No404s";
+if ( $@ ) {
+  plan skip_all => 'Test::Pod::No404s required for testing POD';
+}
+else {
+  all_pod_files_ok();
+}
diff --git a/xt/author/pod-syntax.t b/xt/author/pod-syntax.t
new file mode 100644 (file)
index 0000000..e563e5d
--- /dev/null
@@ -0,0 +1,7 @@
+#!perl
+# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests.
+use strict; use warnings;
+use Test::More;
+use Test::Pod 1.41;
+
+all_pod_files_ok();
diff --git a/xt/author/portability.t b/xt/author/portability.t
new file mode 100644 (file)
index 0000000..c531252
--- /dev/null
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+eval 'use Test::Portability::Files';
+plan skip_all => 'Test::Portability::Files required for testing portability'
+    if $@;
+
+run_tests();
diff --git a/xt/release/cpan-changes.t b/xt/release/cpan-changes.t
new file mode 100644 (file)
index 0000000..286005a
--- /dev/null
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+
+# this test was generated with Dist::Zilla::Plugin::Test::CPAN::Changes 0.012
+
+use Test::More 0.96 tests => 1;
+use Test::CPAN::Changes;
+subtest 'changes_ok' => sub {
+    changes_file_ok('Changes');
+};
diff --git a/xt/release/distmeta.t b/xt/release/distmeta.t
new file mode 100644 (file)
index 0000000..c2280dc
--- /dev/null
@@ -0,0 +1,6 @@
+#!perl
+# This file was automatically generated by Dist::Zilla::Plugin::MetaTests.
+
+use Test::CPAN::Meta;
+
+meta_yaml_ok();
diff --git a/xt/release/minimum-version.t b/xt/release/minimum-version.t
new file mode 100644 (file)
index 0000000..ff71971
--- /dev/null
@@ -0,0 +1,8 @@
+#!perl
+
+use Test::More;
+
+eval "use Test::MinimumVersion";
+plan skip_all => "Test::MinimumVersion required for testing minimum versions"
+  if $@;
+all_minimum_version_ok( qq{5.10.1} );
This page took 0.13301 seconds and 4 git commands to generate.