File Coverage

blib/lib/Test2/Tools/HTTP/Tx.pm
Criterion Covered Total %
statement 48 52 92.3
branch 4 6 66.6
condition 2 6 33.3
subroutine 15 16 93.7
pod 8 8 100.0
total 77 88 87.5


line stmt bran cond sub pod time code
1             package Test2::Tools::HTTP::Tx;
2              
3 6     6   188213 use strict;
  6         15  
  6         151  
4 6     6   27 use warnings;
  6         14  
  6         117  
5 6     6   24 use Test2::API ();
  6         10  
  6         102  
6 6     6   23 use Carp ();
  6         10  
  6         2573  
7              
8             # ABSTRACT: Object representing the last transaction for Test2::Tools::HTTP
9             our $VERSION = '0.11'; # VERSION
10              
11              
12 25     25 1 604 sub req { shift->{req} }
13 31     31 1 150 sub res { shift->{res} }
14 8     8 1 34 sub ok { shift->{ok} }
15 2     2 1 9 sub connection_error { shift->{connection_error} }
16 3     3 1 11 sub location { shift->{location} }
17              
18             sub _note_or_diag
19             {
20 4     4   49 my($self, $method) = @_;
21 4         12 my $ctx = Test2::API::context();
22              
23 4         211 $ctx->$method($self->req->method . ' ' . $self->req->uri);
24 4         960 $ctx->$method($self->req->headers->as_string);
25 4   33     1004 $ctx->$method($self->req->decoded_content || $self->req->content);
26 4 50       861 if($self->res)
27             {
28 4         8 $ctx->$method($self->res->code . ' ' . $self->res->message);
29 4         804 $ctx->$method($self->res->headers->as_string);
30 4   33     1099 $ctx->$method($self->res->decoded_content || $self->res->content);
31             }
32 4         1909 $ctx->$method("ok = " . $self->ok);
33              
34 4         767 $ctx->release;
35             }
36              
37              
38             sub note
39             {
40 4     4 1 8 my($self) = shift;
41 4         13 my $ctx = Test2::API::context();
42 4         311 $self->_note_or_diag('note');
43 4         58 $ctx->release;
44             }
45              
46              
47             sub diag
48             {
49 0     0 1 0 my($self) = shift;
50 0         0 my $ctx = Test2::API::context();
51 0         0 $self->_note_or_diag('diag');
52 0         0 $ctx->release;
53             }
54              
55              
56             sub add_helper
57             {
58 6     6 1 2267 my(undef, $sig, $code) = @_;
59              
60 6         20 my($class, $name) = split /\./, $sig;
61              
62 6         17 my %class = (
63             tx => 'Test2::Tools::HTTP::Tx',
64             req => 'Test2::Tools::HTTP::Tx::Request',
65             res => 'Test2::Tools::HTTP::Tx::Response',
66             );
67              
68 6 50       20 $class = $class{lc $class} if $class{lc $class};
69              
70 6 100       208 Carp::croak("$class already can $name") if $class->can($name);
71              
72 6     6   39 no strict 'refs';
  6         17  
  6         471  
73 3         36 *{"${class}::${name}"} = $code;
  3         16  
74             }
75              
76             package Test2::Tools::HTTP::Tx::Request;
77              
78 6     6   38 use parent 'HTTP::Request';
  6         12  
  6         44  
79              
80             package Test2::Tools::HTTP::Tx::Response;
81              
82 6     6   15152 use parent 'HTTP::Response';
  6         25  
  6         25  
83              
84             1;
85              
86             __END__