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   188597 use strict;
  6         16  
  6         143  
4 6     6   24 use warnings;
  6         9  
  6         107  
5 6     6   23 use Test2::API ();
  6         9  
  6         86  
6 6     6   25 use Carp ();
  6         9  
  6         2452  
7              
8             # ABSTRACT: Object representing the last transaction for Test2::Tools::HTTP
9             our $VERSION = '0.10'; # VERSION
10              
11              
12 25     25 1 604 sub req { shift->{req} }
13 31     31 1 158 sub res { shift->{res} }
14 8     8 1 33 sub ok { shift->{ok} }
15 2     2 1 10 sub connection_error { shift->{connection_error} }
16 3     3 1 13 sub location { shift->{location} }
17              
18             sub _note_or_diag
19             {
20 4     4   65 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         979 $ctx->$method($self->req->headers->as_string);
25 4   33     971 $ctx->$method($self->req->decoded_content || $self->req->content);
26 4 50       1161 if($self->res)
27             {
28 4         10 $ctx->$method($self->res->code . ' ' . $self->res->message);
29 4         806 $ctx->$method($self->res->headers->as_string);
30 4   33     1120 $ctx->$method($self->res->decoded_content || $self->res->content);
31             }
32 4         1981 $ctx->$method("ok = " . $self->ok);
33              
34 4         772 $ctx->release;
35             }
36              
37              
38             sub note
39             {
40 4     4 1 9 my($self) = shift;
41 4         11 my $ctx = Test2::API::context();
42 4         306 $self->_note_or_diag('note');
43 4         59 $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 2215 my(undef, $sig, $code) = @_;
59              
60 6         20 my($class, $name) = split /\./, $sig;
61              
62 6         20 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       18 $class = $class{lc $class} if $class{lc $class};
69              
70 6 100       219 Carp::croak("$class already can $name") if $class->can($name);
71              
72 6     6   39 no strict 'refs';
  6         11  
  6         406  
73 3         35 *{"${class}::${name}"} = $code;
  3         15  
74             }
75              
76             package Test2::Tools::HTTP::Tx::Request;
77              
78 6     6   36 use parent 'HTTP::Request';
  6         9  
  6         31  
79              
80             package Test2::Tools::HTTP::Tx::Response;
81              
82 6     6   15014 use parent 'HTTP::Response';
  6         28  
  6         36  
83              
84             1;
85              
86             __END__