Skip to content
Browse files

Test conversion from/to HTTP::Response

  • Loading branch information...
1 parent 2d57f92 commit 2efc46a40f80be800456f34c8b419a03fc9f7c0c @rwstauner committed Apr 21, 2012
Showing with 111 additions and 7 deletions.
  1. +37 −0 t/lib/AEHTTP_Tests.pm
  2. +74 −7 t/response.t
View
37 t/lib/AEHTTP_Tests.pm
@@ -0,0 +1,37 @@
+package #
+ AEHTTP_Tests;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(
+ have_http_message
+ test_http_message
+);
+
+my $mod = 'HTTP::Message';
+my $have_hm;
+sub have_http_message () {
+ if( !defined($have_hm) ){
+ $have_hm = eval("require $mod") || 0;
+ }
+ return $have_hm;
+}
+
+# ($obj, \&sub) or just (\&sub)
+sub test_http_message (;$&) {
+ my $sub = pop;
+ my $msg = shift;
+ ::subtest http_message => sub {
+ ::plan skip_all => "$mod required for these tests"
+ if !have_http_message;
+
+ my @args;
+ if( $msg ){
+ push @args, $msg->to_http_message;
+ ::isa_ok($args[0], $mod);
+ }
+ $sub->(@args);
+ };
+}
+
+1;
View
81 t/response.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::Response';
eval "require $mod" or die $@;
@@ -14,8 +16,14 @@ foreach my $args ( [1], [1,2,3] ){
# not much to test here, just order of args
{
my $body = "black\nparade";
- my %headers = (
+ my %pseudo = (
Pseudo => 'Header',
+ Status => 200,
+ Reason => 'Who Cares',
+ HTTPVersion => 1.1,
+ );
+ my %headers = (
+ %pseudo,
'x-interjection' => '3 cheers!'
);
@@ -24,11 +32,23 @@ foreach my $args ( [1], [1,2,3] ){
is $res->body, $body, 'body in/out';
is $res->content, $body, 'content alias';
is_deeply $res->headers, { 'x-interjection' => '3 cheers!' }, 'headers in/out';
- is_deeply $res->pseudo_headers, { Pseudo => 'Header' }, 'pseudo headers';
+ is_deeply $res->pseudo_headers, { %pseudo }, 'pseudo headers';
- is $res->header( 'X_Interjection' ), '3 cheers!', 'single header';
+ my @interjections = qw( X_Interjection X-INTERJECTION );
+ is $res->header( $_ ), '3 cheers!', 'single header'
+ for @interjections;
is_deeply [ $res->args ], [ $body, { %headers } ], 'arg list';
+
+ test_http_message $res, sub {
+ my $msg = shift;
+ ok $msg->is_success, '200 OK';
+ is $msg->message, 'Who Cares', 'nobody cares';
+ is $msg->header( $_ ), '3 cheers!', 'header via HTTP::Headers'
+ for @interjections;
+ is $msg->protocol, 'HTTP/1.1', 'HTTPVersion => protocol';
+ is $msg->content, "black\nparade", 'reponse body content';
+ };
}
# args via hashref
@@ -37,24 +57,71 @@ foreach my $args ( [1], [1,2,3] ){
my %headers = (
res_is => 'less useful than req'
);
+ my %pseudo = (
+ Silly => 'wabbit',
+ Status => 413,
+ HTTPVersion => '1.0',
+ Reason => 'Your Request is Stupid',
+ );
my $res = new_ok($mod, [{
headers => { %headers },
body => $body,
- pseudo_headers => { Silly => 'wabbit' },
+ pseudo_headers => { %pseudo },
}]);
my %norm = ('res-is' => $headers{res_is});
is $res->body, $body, 'body in/out';
is $res->content, $body, 'content alias';
is_deeply $res->headers, { %norm }, 'headers in/out';
- is_deeply $res->pseudo_headers, { Silly => 'wabbit' }, 'pseudo headers';
+ is_deeply $res->pseudo_headers, { %pseudo }, 'pseudo headers';
+ my @single = qw( res_is res-is RES_IS RES-IS );
is $res->header( $_ ), 'less useful than req', 'single header'
- for qw( res_is res-is RES_IS RES-IS );
+ for @single;
+
+ is_deeply [ $res->args ], [ $body, { %norm, %pseudo } ], 'arg list';
- is_deeply [ $res->args ], [ $body, { %norm, Silly => 'wabbit' } ], 'arg list';
+ test_http_message $res, sub {
+ my $msg = shift;
+ ok!$msg->is_success, '413 is a bad request';
+ is $msg->header( $_ ), 'less useful than req', 'header via HTTP::Headers'
+ for @single;
+
+ is $msg->protocol, 'HTTP/1.0', 'HTTPVersion => protocol';
+ };
}
+# args via HTTP::Message
+test_http_message sub {
+ my $msg = new_ok('HTTP::Response', [200, 'Fine', [
+ X_Dog => 'Fluffy',
+ X_Dog => 'Fido',
+ ], "bark!"]);
+
+ # don't throw warnings if protocol was undefined
+ {
+ my @w;
+ local $SIG{__WARN__} = sub { push @w, [@_] };
+ is new_ok($mod, [$msg])->pseudo_headers->{HTTPVersion}, undef,
+ 'cannot set HTTPVersion without a protocol';
+ is_deeply \@w, [], 'no warnings';
+ }
+
+ $msg->protocol('HTTP/0.1');
+
+ my $res = new_ok($mod, [$msg]);
+ is_deeply
+ $res->pseudo_headers,
+ {
+ Status => 200,
+ Reason => 'Fine',
+ HTTPVersion => '.1',
+ },
+ 'psuedo headers transferred';
+ is $res->content, 'bark!', 'hush!';
+ like $res->header('x-dog'), qr/^Fluffy, ?Fido$/, 'combined header';
+};
+
done_testing;

0 comments on commit 2efc46a

Please sign in to comment.
Something went wrong with that request. Please try again.