Define conversions from/to HTTP::Request

Changes

@@ -2,6 +2,8 @@ Revision history for AnyEvent-HTTP-Message
 
 {{$NEXT}}
 
+  - Enable conversion from/to HTTP::Message objects
+
   - Fix error messages when parse_args gets the wrong number of arguments.
 
   - Fix module name copy/paste error in Response Synopsis pod

lib/AnyEvent/HTTP/Request.pm

@@ -73,6 +73,30 @@ sub parse_args {
   return $args;
 }
 
+=class_method from_http_message
+
+Called by the constructor
+when L</new> is passed an instance of L<HTTP::Request>.
+
+Since only L</method>, L</uri>, L</headers>, and L</body>
+can be determined from L<HTTP::Request>,
+a hashref can be passed as a second parameter
+containing L</cb> and L</params>.
+
+=cut
+
+sub from_http_message {
+  my ($self, $req, $extra) = @_;
+  my $args = {
+    method  => $req->method,
+    uri     => $req->uri,
+    headers => $self->_hash_http_headers($req->headers),
+    body    => $req->content,
+    (ref($extra) eq 'HASH' ? %$extra : ()),
+  };
+  return $args;
+}
+
 =method args
 
 Returns a list of arguments that can be passed to
@@ -156,6 +180,29 @@ sub send {
   &AnyEvent::HTTP::http_request( $self->args );
 }
 
+=method to_http_message
+
+Returns an instance of L<HTTP::Request>
+to provide additional functionality.
+
+B<Note> that the L</cb> will not be included in the L<HTTP::Request> object
+(nor any L</params> that are not part of the actual request message).
+
+=cut
+
+sub to_http_message {
+  my ($self) = @_;
+  require HTTP::Request;
+
+  my $res = HTTP::Request->new(
+    $self->method,
+    $self->uri,
+    [ %{ $self->headers } ],
+    $self->body
+  );
+  return $res;
+}
+
 1;
 
 =for test_synopsis
@@ -209,14 +256,14 @@ You can then call L</send> to actually make the request
 (via L<AnyEvent::HTTP/http_request>),
 or L</args> to get the list of arguments the object would pass.
 
-=head1 TODO
-
-=for :list
-* Provide conversion to/from more featureful L<HTTP::Request>
+It can also be converted L<from|/from_http_message> or L<to|/to_http_message>
+the more featureful
+L<HTTP::Request>.
 
 =head1 SEE ALSO
 
 =for :list
 * L<AnyEvent::HTTP::Message> (base class)
+* L<HTTP::Request> - More featureful object
 
 =cut

t/request.t

@@ -1,6 +1,8 @@
 use strict;
 use warnings;
 use Test::More 0.88;
+use lib 't/lib';
+use AEHTTP_Tests;
 
 my $mod = 'AnyEvent::HTTP::Request';
 eval "require $mod" or die $@;
@@ -65,6 +67,14 @@ foreach my $args ( [], [1,2], [1,2,3,4] ){
 
   is $req->cb->(), 'ugly', 'ugly duckling';
   test_send($req);
+
+  test_http_message $req, sub {
+    my $msg = shift;
+    is $msg->method, 'POST', 'method';
+    is $msg->uri, 'scheme://host/path', 'uri';
+    is $msg->header('user_agent'), 'Any-Thing/0.1', 'ua header';
+    is $msg->content, 'rub a dub', 'body/content';
+  };
 }
 
 # empty params
@@ -94,6 +104,14 @@ foreach my $args ( [], [1,2], [1,2,3,4] ){
 
   is $req->cb->(), 'fbbq', 'callback works';
   test_send($req);
+
+  test_http_message $req, sub {
+    my $msg = shift;
+    is $msg->method, 'FOO', 'method';
+    is $msg->uri, '//bar/baz', 'uri';
+    is $msg->header('QUX'), '42', 'single header';
+    is $msg->content, '', 'body/content (empty string)';
+  };
 }
 
 # construct via hashref
@@ -141,8 +159,42 @@ foreach my $args ( [], [1,2], [1,2,3,4] ){
   is $args[-1]->(), 'yee haw', 'correct callback results';
 
   test_send($req);
+
+  test_http_message $req, sub {
+    my $msg = shift;
+    is $msg->method, 'YAWN', 'method';
+    is $msg->uri, 'horse://sense', 'uri';
+    is $msg->header('Wa'), 'hoo', 'single header';
+    is $msg->header('X-Wa'), 'x-hoo', 'single header';
+    is $msg->content, 'by cowboy', 'body/content';
+  };
 }
 
+test_http_message sub {
+  my $msg = new_ok('HTTP::Request', [
+    GET => 'blue://buildings',
+    [
+      x_rain     => 'king',
+      user_agent => 'perfect',
+      User_Agent => 'round here',
+    ],
+    'anna begins',
+  ]);
+
+  my $suffix = 'from HTTP::Request';
+  my $req = new_ok($mod, [$msg]);
+  is $req->method, 'GET', "method $suffix";
+  is $req->uri, 'blue://buildings', "uri $suffix";
+  is $req->body, 'anna begins', "body $suffix";
+  is_deeply
+    $req->headers,
+    {
+      'x-rain'     => 'king',
+      'user-agent' => 'perfect,round here',
+    },
+    "converted headers $suffix";
+};
+
 done_testing;
 
 # AE http_request overridden above