Merge 705fcab into 4629793

cpanfile

@@ -14,6 +14,7 @@ requires 'Try::Tiny';
 requires 'URI', '1.59';
 requires 'parent';
 requires 'Apache::LogFormat::Compiler', '0.12';
+requires 'HTTP::Tiny', 0.024;
 
 on test => sub {
     requires 'Test::More', '0.88';

lib/HTTP/Tiny/LWPLike.pm

@@ -0,0 +1,89 @@
+package HTTP::Tiny::LWPLike;
+use strict;
+use warnings;
+use HTTP::Tiny;
+use HTTP::Response;
+use Hash::MultiValue;
+
+sub new {
+    my $class = shift;
+    my $self  = bless {}, $class;
+    $self->{http} = @_ == 1 ? $_[0] : HTTP::Tiny->new(@_);
+    $self;
+}
+
+sub request {
+    my($self, $req) = @_;
+
+    my @headers;
+    $req->headers->scan(sub { push @headers, @_ });
+
+    my $options = {
+        headers => Hash::MultiValue->new(@headers)->mixed,
+    };
+    $options->{content} = $req->content if defined $req->content && length($req->content);
+
+    my $response = $self->{http}->request($req->method, $req->url, $options);
+
+    my $res = HTTP::Response->new(
+        $response->{status},
+        $response->{reason},
+        [ Hash::MultiValue->from_mixed($response->{headers})->flatten ],
+        $response->{content},
+    );
+    $res->request($req);
+
+    return $res;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTTP::Tiny::LWPLike - HTTP::Request/Response compatible interface with HTTP::Tiny backend
+
+=head1 SYNOPSIS
+
+  use HTTP::Tiny::LWPLike;
+
+  my $request = HTTP::Request->new(GET => 'http://perl.com/');
+
+  my $ua = HTTP::Tiny::LWPLike->new;
+  my $res = $ua->request($request); # returns HTTP::Response
+
+=head1 DESCRIPTION
+
+This module is an adapter object that implements one method,
+C<request> that acts like L<LWP::UserAgent>'s request method
+i.e. takes HTTP::Request object and returns HTTP::Response object.
+
+=head1 INCOMPATIBILITIES
+
+=over 4
+
+=item *
+
+SSL is not supported unless required modules are installed.
+
+=item *
+
+authentication is not handled via the UA methods. You can encode the
+C<Authorization> headers in the C<$request> by yourself.
+
+=cut
+
+There might be more - see L<HTTP::Tiny> for the details.
+
+=back
+
+=head1 AUTHOR
+
+Tatsuhiko Miyagawa
+
+=head1 SEE ALSO
+
+L<HTTP::Tiny> L<LWP::UserAgent>
+
+=cut

lib/Plack/Test/Server.pm

@@ -2,18 +2,18 @@ package Plack::Test::Server;
 use strict;
 use warnings;
 use Carp;
+use HTTP::Request;
+use HTTP::Response;
 use Test::TCP;
 use Plack::Loader;
-use Test::Requires ();
+use HTTP::Tiny::LWPLike;
 
 sub test_psgi {
     my %args = @_;
 
-    Test::Requires::test_requires('LWP::UserAgent');
-
     my $client = delete $args{client} or croak "client test code needed";
     my $app    = delete $args{app}    or croak "app needed";
-    my $ua     = delete $args{ua} || LWP::UserAgent->new;
+    my $ua     = delete $args{ua} || HTTP::Tiny::LWPLike->new;
 
     test_tcp(
         client => sub {

lib/Plack/Test/Suite.pm

@@ -12,7 +12,7 @@ use Plack::Middleware::Lint;
 use Plack::Util;
 use Plack::Request;
 use Try::Tiny;
-use Test::Requires ();
+use HTTP::Tiny::LWPLike;
 
 my $share_dir = try { File::ShareDir::dist_dir('Plack') } || 'share';
 
@@ -741,8 +741,6 @@ sub runtests {
 sub run_server_tests {
     my($class, $server, $server_port, $http_port, %args) = @_;
 
-    Test::Requires::test_requires('LWP::UserAgent');
-
     if (ref $server ne 'CODE') {
         my $server_class = $server;
         $server = sub {
@@ -757,7 +755,7 @@ sub run_server_tests {
         client => sub {
             my $port = shift;
 
-            my $ua = LWP::UserAgent->new;
+            my $ua = HTTP::Tiny::LWPLike->new;
             for my $i (0..$#TEST) {
                 my $test = $TEST[$i];
                 note $test->[0];

t/Plack-Middleware/chunked.t

@@ -1,10 +1,11 @@
 use strict;
 use Test::More;
-use Test::Requires qw(IO::Handle::Util LWP::Protocol::http10);
+use Test::Requires qw(IO::Handle::Util LWP::UserAgent LWP::Protocol::http10);
 use IO::Handle::Util qw(:io_from);
 use HTTP::Request::Common;
 use Plack::Test;
 use Plack::Middleware::Chunked;
+
 $Plack::Test::Impl = "Server";
 
 local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI";
@@ -22,7 +23,9 @@ my @app = (
 
 my $app = sub { (shift @app)->(@_) };
 
-test_psgi app => Plack::Middleware::Chunked->wrap($app), client => sub {
+test_psgi
+    ua => LWP::UserAgent->new, # force LWP
+    app => Plack::Middleware::Chunked->wrap($app), client => sub {
     my $cb = shift;
 
     for my $proto (qw( HTTP/1.1 HTTP/1.0 )) {