| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Test2::Tools::HTTP::UA::Mojo; |
|
2
|
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
28095
|
use strict; |
|
|
3
|
|
|
|
|
6
|
|
|
|
3
|
|
|
|
|
94
|
|
|
4
|
3
|
|
|
3
|
|
17
|
use warnings; |
|
|
3
|
|
|
|
|
6
|
|
|
|
3
|
|
|
|
|
73
|
|
|
5
|
3
|
|
|
3
|
|
61
|
use 5.01001; |
|
|
3
|
|
|
|
|
17
|
|
|
6
|
3
|
|
|
3
|
|
467
|
use parent 'Test2::Tools::HTTP::UA'; |
|
|
3
|
|
|
|
|
288
|
|
|
|
3
|
|
|
|
|
21
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# ABSTRACT: Mojo user agent wrapper for Test2::Tools::HTTP |
|
9
|
|
|
|
|
|
|
our $VERSION = '0.04'; # VERSION |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub new |
|
13
|
|
|
|
|
|
|
{ |
|
14
|
2
|
|
|
2
|
1
|
16320
|
my $class = shift; |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# we want to require tese on demand here when the wrapper gets |
|
17
|
|
|
|
|
|
|
# created rather than use them up at the top, because this .pm |
|
18
|
|
|
|
|
|
|
# gets used every time Test2::Tool::HTTP::UA gets used, even |
|
19
|
|
|
|
|
|
|
# if we aren't using Mojolicious in the .t file. |
|
20
|
2
|
|
|
|
|
556
|
require Mojolicious; |
|
21
|
2
|
|
|
|
|
53615
|
require Mojo::URL; |
|
22
|
2
|
|
|
|
|
9
|
require IO::Socket::INET; |
|
23
|
2
|
|
|
|
|
9
|
require HTTP::Request; |
|
24
|
2
|
|
|
|
|
9
|
require HTTP::Response; |
|
25
|
2
|
|
|
|
|
8
|
require HTTP::Message::PSGI; |
|
26
|
2
|
|
|
|
|
1065
|
require Test2::Tools::HTTP::UA::Mojo::Proxy; |
|
27
|
|
|
|
|
|
|
|
|
28
|
2
|
|
|
|
|
31
|
$class->SUPER::new(@_); |
|
29
|
|
|
|
|
|
|
} |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub instrument |
|
32
|
|
|
|
|
|
|
{ |
|
33
|
2
|
|
|
2
|
0
|
54
|
my($self) = @_; |
|
34
|
|
|
|
|
|
|
|
|
35
|
2
|
100
|
|
|
|
15
|
if($self->ua->server->app) |
|
36
|
|
|
|
|
|
|
{ |
|
37
|
1
|
|
|
|
|
29
|
$self->apps->base_url($self->ua->server->url->to_string); |
|
38
|
|
|
|
|
|
|
} |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my $proxy_psgi_app = sub { |
|
41
|
2
|
|
|
2
|
|
12887
|
my $env = shift; |
|
42
|
|
|
|
|
|
|
|
|
43
|
2
|
|
|
|
|
11
|
my $app = $self->apps->uri_to_app($env->{REQUEST_URI}); |
|
44
|
2
|
50
|
|
|
|
432
|
$app |
|
45
|
|
|
|
|
|
|
? $app->($env) |
|
46
|
|
|
|
|
|
|
: [ 404, [ 'Content-Type' => 'text/plain' ], [ '404 Not Found' ] ]; |
|
47
|
2
|
|
|
|
|
7707
|
}; |
|
48
|
|
|
|
|
|
|
|
|
49
|
2
|
|
|
|
|
17
|
my $proxy_mojo_app = Mojolicious->new; |
|
50
|
2
|
|
|
|
|
27016
|
$proxy_mojo_app->plugin('Mojolicious::Plugin::MountPSGI' => { '/' => $proxy_psgi_app }); |
|
51
|
|
|
|
|
|
|
|
|
52
|
2
|
|
|
|
|
18650
|
my $proxy_url = Mojo::URL->new("http://127.0.0.1"); |
|
53
|
2
|
|
|
|
|
884
|
$proxy_url->port(do { |
|
54
|
2
|
|
|
|
|
37
|
IO::Socket::INET->new( |
|
55
|
|
|
|
|
|
|
Listen => 5, |
|
56
|
|
|
|
|
|
|
LocalAddr => '127.0.0.1', |
|
57
|
|
|
|
|
|
|
)->sockport; |
|
58
|
|
|
|
|
|
|
}); |
|
59
|
|
|
|
|
|
|
|
|
60
|
2
|
|
|
|
|
923
|
my $proxy_mojo_server = $self->{proxy_mojo_server} = Mojo::Server::Daemon->new( |
|
61
|
|
|
|
|
|
|
ioloop => $self->ua->ioloop, |
|
62
|
|
|
|
|
|
|
silent => 1, |
|
63
|
|
|
|
|
|
|
app => $proxy_mojo_app, |
|
64
|
|
|
|
|
|
|
listen => ["$proxy_url"], |
|
65
|
|
|
|
|
|
|
); |
|
66
|
2
|
|
|
|
|
857
|
$proxy_mojo_server->start; |
|
67
|
|
|
|
|
|
|
|
|
68
|
2
|
|
|
|
|
3641
|
my $old_proxy = $self->ua->proxy; |
|
69
|
2
|
|
|
|
|
45
|
my $new_proxy = Test2::Tools::HTTP::UA::Mojo::Proxy->new( |
|
70
|
|
|
|
|
|
|
apps => $self->apps, |
|
71
|
|
|
|
|
|
|
http => $old_proxy->http, |
|
72
|
|
|
|
|
|
|
https => $old_proxy->https, |
|
73
|
|
|
|
|
|
|
not => $old_proxy->not, |
|
74
|
|
|
|
|
|
|
apps_proxy_url => $proxy_url, |
|
75
|
|
|
|
|
|
|
); |
|
76
|
|
|
|
|
|
|
|
|
77
|
2
|
|
|
|
|
94
|
$self->ua->proxy($new_proxy); |
|
78
|
|
|
|
|
|
|
} |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub request |
|
81
|
|
|
|
|
|
|
{ |
|
82
|
15
|
|
|
15
|
0
|
127961
|
my($self, $req, %options) = @_; |
|
83
|
|
|
|
|
|
|
|
|
84
|
15
|
|
|
|
|
144
|
require Mojo::Transaction::HTTP; |
|
85
|
15
|
|
|
|
|
69
|
require Mojo::Message::Request; |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# Add the User-Agent header to the HTTP::Request |
|
88
|
|
|
|
|
|
|
# so that T2::T::HTTP can see it in diagnostics |
|
89
|
15
|
50
|
|
|
|
71
|
$req->header('User-Agent' => $self->ua->transactor->name) |
|
90
|
|
|
|
|
|
|
unless $req->header('User-Agent'); |
|
91
|
|
|
|
|
|
|
|
|
92
|
15
|
|
|
|
|
1928
|
my $mojo_req = Mojo::Message::Request->new; |
|
93
|
15
|
|
|
|
|
157
|
$mojo_req->parse($req->to_psgi); |
|
94
|
15
|
50
|
|
|
|
21971
|
$mojo_req->url(Mojo::URL->new($req->uri.'')) |
|
95
|
|
|
|
|
|
|
if $req->uri !~ /^\//; |
|
96
|
|
|
|
|
|
|
|
|
97
|
15
|
|
|
|
|
2460
|
my $tx = Mojo::Transaction::HTTP->new(req => $mojo_req); |
|
98
|
|
|
|
|
|
|
|
|
99
|
15
|
|
|
|
|
130
|
my $res; |
|
100
|
|
|
|
|
|
|
|
|
101
|
15
|
100
|
|
|
|
58
|
if($options{follow_redirects}) |
|
102
|
|
|
|
|
|
|
{ |
|
103
|
1
|
|
|
|
|
3
|
my $error; |
|
104
|
|
|
|
|
|
|
$self->ua->start_p($tx)->then(sub { |
|
105
|
1
|
|
|
1
|
|
6945
|
my $tx = shift; |
|
106
|
1
|
|
|
|
|
5
|
$res = HTTP::Response->parse($tx->res->to_string); |
|
107
|
1
|
|
|
|
|
703
|
$res->request(HTTP::Request->parse($tx->req->to_string)); |
|
108
|
|
|
|
|
|
|
})->catch(sub { |
|
109
|
0
|
|
|
0
|
|
0
|
$error = shift; |
|
110
|
1
|
|
|
|
|
6
|
})->wait; |
|
111
|
1
|
50
|
|
|
|
805
|
$self->error("connection error: $error") if $error; |
|
112
|
|
|
|
|
|
|
} |
|
113
|
|
|
|
|
|
|
else |
|
114
|
|
|
|
|
|
|
{ |
|
115
|
14
|
|
|
|
|
59
|
$self->ua->start($tx); |
|
116
|
14
|
|
|
|
|
999642
|
my $err = $tx->error; |
|
117
|
14
|
100
|
100
|
|
|
305
|
if($err && !$err->{code}) |
|
118
|
|
|
|
|
|
|
{ |
|
119
|
1
|
|
|
|
|
23
|
$self->error("connection error: " . $err->{message}); |
|
120
|
|
|
|
|
|
|
} |
|
121
|
13
|
|
|
|
|
45
|
$res = HTTP::Response->parse($tx->res->to_string); |
|
122
|
13
|
|
|
|
|
12398
|
$res->request($req); |
|
123
|
|
|
|
|
|
|
} |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# trim weird trailing stuff |
|
126
|
14
|
|
|
|
|
161
|
my $message = $res->message; |
|
127
|
14
|
|
|
|
|
208
|
$message =~ s/\s*$//; |
|
128
|
14
|
|
|
|
|
53
|
$res->message($message); |
|
129
|
|
|
|
|
|
|
|
|
130
|
14
|
|
|
|
|
177
|
$res; |
|
131
|
|
|
|
|
|
|
} |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
__PACKAGE__->register('Mojo::UserAgent', 'instance'); |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
1; |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
__END__ |