line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mojo::Transaction; |
2
|
56
|
|
|
56
|
|
439
|
use Mojo::Base 'Mojo::EventEmitter'; |
|
56
|
|
|
|
|
147
|
|
|
56
|
|
|
|
|
448
|
|
3
|
|
|
|
|
|
|
|
4
|
56
|
|
|
56
|
|
379
|
use Carp qw(croak); |
|
56
|
|
|
|
|
156
|
|
|
56
|
|
|
|
|
3162
|
|
5
|
56
|
|
|
56
|
|
500
|
use List::Util qw(any); |
|
56
|
|
|
|
|
170
|
|
|
56
|
|
|
|
|
3973
|
|
6
|
56
|
|
|
56
|
|
27783
|
use Mojo::Message::Request; |
|
56
|
|
|
|
|
198
|
|
|
56
|
|
|
|
|
649
|
|
7
|
56
|
|
|
56
|
|
27259
|
use Mojo::Message::Response; |
|
56
|
|
|
|
|
206
|
|
|
56
|
|
|
|
|
659
|
|
8
|
56
|
|
|
56
|
|
428
|
use Mojo::Util qw(network_contains); |
|
56
|
|
|
|
|
161
|
|
|
56
|
|
|
|
|
48745
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
has [qw(kept_alive local_address local_port original_remote_address remote_port)]; |
11
|
|
|
|
|
|
|
has req => sub { Mojo::Message::Request->new }; |
12
|
|
|
|
|
|
|
has res => sub { Mojo::Message::Response->new }; |
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
1
|
2251
|
sub client_read { croak 'Method "client_read" not implemented by subclass' } |
15
|
1
|
|
|
1
|
1
|
877
|
sub client_write { croak 'Method "client_write" not implemented by subclass' } |
16
|
|
|
|
|
|
|
|
17
|
1893
|
|
|
1893
|
1
|
4066
|
sub closed { shift->completed->emit('finish') } |
18
|
|
|
|
|
|
|
|
19
|
4085
|
50
|
|
4085
|
1
|
16428
|
sub completed { ++$_[0]{completed} and return $_[0] } |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub connection { |
22
|
2727
|
|
|
2727
|
1
|
4784
|
my $self = shift; |
23
|
2727
|
100
|
|
|
|
10483
|
return $self->emit(connection => $self->{connection} = shift) if @_; |
24
|
855
|
|
|
|
|
5028
|
return $self->{connection}; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
2628
|
100
|
|
2628
|
1
|
10899
|
sub error { $_[0]->req->error || $_[0]->res->error } |
28
|
|
|
|
|
|
|
|
29
|
3355
|
|
|
3355
|
1
|
14478
|
sub is_finished { !!shift->{completed} } |
30
|
|
|
|
|
|
|
|
31
|
2788
|
|
|
2788
|
1
|
8088
|
sub is_websocket {undef} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub remote_address { |
34
|
1906
|
|
|
1906
|
1
|
67389
|
my $self = shift; |
35
|
|
|
|
|
|
|
|
36
|
1906
|
100
|
|
|
|
7531
|
return $self->original_remote_address(@_) if @_; |
37
|
17
|
100
|
|
|
|
53
|
return $self->original_remote_address unless $self->req->reverse_proxy; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Reverse proxy |
40
|
13
|
|
100
|
|
|
38
|
my @addrs = split /\s*,\s*/, ($self->req->headers->header('X-Forwarded-For') // ''); |
41
|
13
|
|
|
|
|
46
|
my $trusted = $self->req->trusted_proxies; |
42
|
13
|
100
|
|
|
|
62
|
return @addrs ? $addrs[-1] : $self->original_remote_address unless @$trusted; |
|
|
100
|
|
|
|
|
|
43
|
|
|
|
|
|
|
|
44
|
9
|
|
|
|
|
41
|
push @addrs, $self->original_remote_address; |
45
|
9
|
|
|
|
|
33
|
for my $addr (reverse @addrs) { |
46
|
23
|
100
|
|
37
|
|
136
|
return $addr unless any { network_contains($_, $addr) } @$trusted; |
|
37
|
|
|
|
|
100
|
|
47
|
|
|
|
|
|
|
} |
48
|
1
|
|
|
|
|
4
|
return $addrs[0]; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub result { |
52
|
23
|
|
|
23
|
1
|
72
|
my $self = shift; |
53
|
23
|
|
|
|
|
75
|
my $err = $self->error; |
54
|
23
|
100
|
100
|
|
|
1095
|
return !$err || $err->{code} ? $self->res : croak $err->{message}; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
1
|
|
|
1
|
1
|
788
|
sub server_read { croak 'Method "server_read" not implemented by subclass' } |
58
|
1
|
|
|
1
|
1
|
758
|
sub server_write { croak 'Method "server_write" not implemented by subclass' } |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
1; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=encoding utf8 |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head1 NAME |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
Mojo::Transaction - Transaction base class |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head1 SYNOPSIS |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
package Mojo::Transaction::MyTransaction; |
71
|
|
|
|
|
|
|
use Mojo::Base 'Mojo::Transaction'; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub client_read {...} |
74
|
|
|
|
|
|
|
sub client_write {...} |
75
|
|
|
|
|
|
|
sub server_read {...} |
76
|
|
|
|
|
|
|
sub server_write {...} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head1 DESCRIPTION |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
L is an abstract base class for transactions, like L and |
81
|
|
|
|
|
|
|
L. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 EVENTS |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
L inherits all events from L and can emit the following new ones. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head2 connection |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
$tx->on(connection => sub ($tx, $connection) {...}); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Emitted when a connection has been assigned to transaction. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head2 finish |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
$tx->on(finish => sub ($tx) {...}); |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Emitted when transaction is finished. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
L implements the following attributes. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head2 kept_alive |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
my $bool = $tx->kept_alive; |
106
|
|
|
|
|
|
|
$tx = $tx->kept_alive($bool); |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
Connection has been kept alive. |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head2 local_address |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
my $address = $tx->local_address; |
113
|
|
|
|
|
|
|
$tx = $tx->local_address('127.0.0.1'); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Local interface address. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head2 local_port |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
my $port = $tx->local_port; |
120
|
|
|
|
|
|
|
$tx = $tx->local_port(8080); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Local interface port. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head2 original_remote_address |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
my $address = $tx->original_remote_address; |
127
|
|
|
|
|
|
|
$tx = $tx->original_remote_address('127.0.0.1'); |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Remote interface address. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=head2 remote_port |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
my $port = $tx->remote_port; |
134
|
|
|
|
|
|
|
$tx = $tx->remote_port(8081); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Remote interface port. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head2 req |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
my $req = $tx->req; |
141
|
|
|
|
|
|
|
$tx = $tx->req(Mojo::Message::Request->new); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
HTTP request, defaults to a L object. |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# Access request information |
146
|
|
|
|
|
|
|
my $method = $tx->req->method; |
147
|
|
|
|
|
|
|
my $url = $tx->req->url->to_abs; |
148
|
|
|
|
|
|
|
my $info = $tx->req->url->to_abs->userinfo; |
149
|
|
|
|
|
|
|
my $host = $tx->req->url->to_abs->host; |
150
|
|
|
|
|
|
|
my $agent = $tx->req->headers->user_agent; |
151
|
|
|
|
|
|
|
my $custom = $tx->req->headers->header('Custom-Header'); |
152
|
|
|
|
|
|
|
my $bytes = $tx->req->body; |
153
|
|
|
|
|
|
|
my $str = $tx->req->text; |
154
|
|
|
|
|
|
|
my $hash = $tx->req->params->to_hash; |
155
|
|
|
|
|
|
|
my $all = $tx->req->uploads; |
156
|
|
|
|
|
|
|
my $value = $tx->req->json; |
157
|
|
|
|
|
|
|
my $foo = $tx->req->json('/23/foo'); |
158
|
|
|
|
|
|
|
my $dom = $tx->req->dom; |
159
|
|
|
|
|
|
|
my $bar = $tx->req->dom('div.bar')->first->text; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head2 res |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
my $res = $tx->res; |
164
|
|
|
|
|
|
|
$tx = $tx->res(Mojo::Message::Response->new); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
HTTP response, defaults to a L object. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# Access response information |
169
|
|
|
|
|
|
|
my $code = $tx->res->code; |
170
|
|
|
|
|
|
|
my $message = $tx->res->message; |
171
|
|
|
|
|
|
|
my $server = $tx->res->headers->server; |
172
|
|
|
|
|
|
|
my $custom = $tx->res->headers->header('Custom-Header'); |
173
|
|
|
|
|
|
|
my $bytes = $tx->res->body; |
174
|
|
|
|
|
|
|
my $str = $tx->res->text; |
175
|
|
|
|
|
|
|
my $value = $tx->res->json; |
176
|
|
|
|
|
|
|
my $foo = $tx->res->json('/23/foo'); |
177
|
|
|
|
|
|
|
my $dom = $tx->res->dom; |
178
|
|
|
|
|
|
|
my $bar = $tx->res->dom('div.bar')->first->text; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=head1 METHODS |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
L inherits all methods from L and implements the following new ones. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head2 client_read |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
$tx->client_read($bytes); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
Read data client-side, used to implement user agents such as L. Meant to be overloaded in a subclass. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head2 client_write |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
my $bytes = $tx->client_write; |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Write data client-side, used to implement user agents such as L. Meant to be overloaded in a subclass. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head2 closed |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
$tx = $tx->closed; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Same as L"completed">, but also indicates that all transaction data has been sent. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head2 completed |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
$tx = $tx->completed; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
Low-level method to finalize transaction. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head2 connection |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
my $id = $tx->connection; |
211
|
|
|
|
|
|
|
$tx = $tx->connection($id); |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Connection identifier. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=head2 error |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
my $err = $tx->error; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Get request or response error and return C if there is no error. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Longer version |
222
|
|
|
|
|
|
|
my $err = $tx->req->error || $tx->res->error; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# Check for 4xx/5xx response and connection errors |
225
|
|
|
|
|
|
|
if (my $err = $tx->error) { |
226
|
|
|
|
|
|
|
die "$err->{code} response: $err->{message}" if $err->{code}; |
227
|
|
|
|
|
|
|
die "Connection error: $err->{message}"; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head2 is_finished |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
my $bool = $tx->is_finished; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Check if transaction is finished. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head2 is_websocket |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
my $bool = $tx->is_websocket; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
False, this is not a L object. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head2 remote_address |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
my $address = $tx->remote_address; |
245
|
|
|
|
|
|
|
$tx = $tx->remote_address('127.0.0.1'); |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
Same as L"original_remote_address"> unless L"req"> has been performed via a L. |
248
|
|
|
|
|
|
|
If so then the last value of C header is returned. Additionally if |
249
|
|
|
|
|
|
|
L are also provided then the original address must be trusted and any |
250
|
|
|
|
|
|
|
C entries that are trusted are ignored, returning the last untrusted address or the first address if |
251
|
|
|
|
|
|
|
all are trusted. |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=head2 result |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
my $res = $tx->result; |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Returns the L object from L"res"> or dies if a connection error has occurred. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# Fine grained response handling (dies on connection errors) |
260
|
|
|
|
|
|
|
my $res = $tx->result; |
261
|
|
|
|
|
|
|
if ($res->is_success) { say $res->body } |
262
|
|
|
|
|
|
|
elsif ($res->is_error) { say $res->message } |
263
|
|
|
|
|
|
|
elsif ($res->code == 301) { say $res->headers->location } |
264
|
|
|
|
|
|
|
else { say 'Whatever...' } |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head2 server_read |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
$tx->server_read($bytes); |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
Read data server-side, used to implement web servers such as L. Meant to be overloaded in a |
271
|
|
|
|
|
|
|
subclass. |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=head2 server_write |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
my $bytes = $tx->server_write; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
Write data server-side, used to implement web servers such as L. Meant to be overloaded in a |
278
|
|
|
|
|
|
|
subclass. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=head1 SEE ALSO |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
L, L, L. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=cut |