File Coverage

blib/lib/Mojo/Transaction.pm
Criterion Covered Total %
statement 44 44 100.0
branch 17 18 94.4
condition 5 5 100.0
subroutine 19 19 100.0
pod 12 12 100.0
total 97 98 98.9


line stmt bran cond sub pod time code
1             package Mojo::Transaction;
2 56     56   425 use Mojo::Base 'Mojo::EventEmitter';
  56         127  
  56         381  
3              
4 56     56   397 use Carp qw(croak);
  56         155  
  56         2908  
5 56     56   415 use List::Util qw(any);
  56         183  
  56         3671  
6 56     56   26558 use Mojo::Message::Request;
  56         204  
  56         608  
7 56     56   25838 use Mojo::Message::Response;
  56         183  
  56         640  
8 56     56   426 use Mojo::Util qw(network_contains);
  56         151  
  56         46488  
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 2433 sub client_read { croak 'Method "client_read" not implemented by subclass' }
15 1     1 1 998 sub client_write { croak 'Method "client_write" not implemented by subclass' }
16              
17 1893     1893 1 3995 sub closed { shift->completed->emit('finish') }
18              
19 4086 50   4086 1 15863 sub completed { ++$_[0]{completed} and return $_[0] }
20              
21             sub connection {
22 2727     2727 1 5012 my $self = shift;
23 2727 100       10397 return $self->emit(connection => $self->{connection} = shift) if @_;
24 855         4732 return $self->{connection};
25             }
26              
27 2628 100   2628 1 6921 sub error { $_[0]->req->error || $_[0]->res->error }
28              
29 3361     3361 1 13598 sub is_finished { !!shift->{completed} }
30              
31 2788     2788 1 7984 sub is_websocket {undef}
32              
33             sub remote_address {
34 1906     1906 1 66063 my $self = shift;
35              
36 1906 100       7114 return $self->original_remote_address(@_) if @_;
37 17 100       50 return $self->original_remote_address unless $self->req->reverse_proxy;
38              
39             # Reverse proxy
40 13   100     47 my @addrs = split /\s*,\s*/, ($self->req->headers->header('X-Forwarded-For') // '');
41 13         44 my $trusted = $self->req->trusted_proxies;
42 13 100       67 return @addrs ? $addrs[-1] : $self->original_remote_address unless @$trusted;
    100          
43              
44 9         51 push @addrs, $self->original_remote_address;
45 9         37 for my $addr (reverse @addrs) {
46 23 100   37   127 return $addr unless any { network_contains($_, $addr) } @$trusted;
  37         105  
47             }
48 1         5 return $addrs[0];
49             }
50              
51             sub result {
52 23     23 1 62 my $self = shift;
53 23         72 my $err = $self->error;
54 23 100 100     821 return !$err || $err->{code} ? $self->res : croak $err->{message};
55             }
56              
57 1     1 1 823 sub server_read { croak 'Method "server_read" not implemented by subclass' }
58 1     1 1 844 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, 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 unless L 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 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