File Coverage

blib/lib/Mojo/Transaction.pm
Criterion Covered Total %
statement 34 36 94.4
branch 13 16 81.2
condition 5 5 100.0
subroutine 17 18 94.4
pod 12 13 92.3
total 81 88 92.0


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