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   220817 use strict;
  6         16  
  6         171  
4 6     6   28 use warnings;
  6         13  
  6         128  
5 6     6   29 use Test2::API ();
  6         23  
  6         86  
6 6     6   29 use Carp ();
  6         11  
  6         2795  
7              
8             # ABSTRACT: Object representing the last transaction for Test2::Tools::HTTP
9             our $VERSION = '0.09'; # VERSION
10              
11              
12 25     25 1 712 sub req { shift->{req} }
13 31     31 1 181 sub res { shift->{res} }
14 8     8 1 42 sub ok { shift->{ok} }
15 2     2 1 11 sub connection_error { shift->{connection_error} }
16 3     3 1 16 sub location { shift->{location} }
17              
18             sub _note_or_diag
19             {
20 4     4   10 my($self, $method) = @_;
21 4         36 my $ctx = Test2::API::context();
22              
23 4         245 $ctx->$method($self->req->method . ' ' . $self->req->uri);
24 4         1176 $ctx->$method($self->req->headers->as_string);
25 4   33     1215 $ctx->$method($self->req->decoded_content || $self->req->content);
26 4 50       988 if($self->res)
27             {
28 4         11 $ctx->$method($self->res->code . ' ' . $self->res->message);
29 4         1011 $ctx->$method($self->res->headers->as_string);
30 4   33     1291 $ctx->$method($self->res->decoded_content || $self->res->content);
31             }
32 4         2435 $ctx->$method("ok = " . $self->ok);
33            
34 4         941 $ctx->release;
35             }
36              
37              
38             sub note
39             {
40 4     4 1 60 my($self) = shift;
41 4         12 my $ctx = Test2::API::context();
42 4         370 $self->_note_or_diag('note');
43 4         74 $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 2535 my(undef, $sig, $code) = @_;
59            
60 6         25 my($class, $name) = split /\./, $sig;
61            
62 6         23 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       23 $class = $class{lc $class} if $class{lc $class};
69            
70 6 100       468 Carp::croak("$class already can $name") if $class->can($name);
71              
72 6     6   44 no strict 'refs';
  6         14  
  6         470  
73 3         7 *{"${class}::${name}"} = $code;
  3         18  
74             }
75              
76             package Test2::Tools::HTTP::Tx::Request;
77              
78 6     6   454 use parent 'HTTP::Request';
  6         313  
  6         33  
79              
80             package Test2::Tools::HTTP::Tx::Response;
81              
82 6     6   21560 use parent 'HTTP::Response';
  6         30  
  6         35  
83              
84             1;
85              
86             __END__