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__ |