line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mojo::UserAgent::Cached; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
2389507
|
use warnings; |
|
5
|
|
|
|
|
44
|
|
|
5
|
|
|
|
|
166
|
|
4
|
5
|
|
|
5
|
|
30
|
use strict; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
97
|
|
5
|
5
|
|
|
5
|
|
74
|
use v5.10; |
|
5
|
|
|
|
|
19
|
|
6
|
5
|
|
|
5
|
|
2280
|
use Algorithm::LCSS; |
|
5
|
|
|
|
|
31236
|
|
|
5
|
|
|
|
|
248
|
|
7
|
5
|
|
|
5
|
|
3176
|
use CHI; |
|
5
|
|
|
|
|
402290
|
|
|
5
|
|
|
|
|
199
|
|
8
|
5
|
|
|
5
|
|
49
|
use Cwd (); |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
118
|
|
9
|
5
|
|
|
5
|
|
2564
|
use Devel::StackTrace; |
|
5
|
|
|
|
|
16947
|
|
|
5
|
|
|
|
|
254
|
|
10
|
5
|
|
|
5
|
|
2902
|
use English qw(-no_match_vars); |
|
5
|
|
|
|
|
8738
|
|
|
5
|
|
|
|
|
33
|
|
11
|
5
|
|
|
5
|
|
1834
|
use File::Basename; |
|
5
|
|
|
|
|
28
|
|
|
5
|
|
|
|
|
380
|
|
12
|
5
|
|
|
5
|
|
42
|
use File::Path; |
|
5
|
|
|
|
|
18
|
|
|
5
|
|
|
|
|
327
|
|
13
|
5
|
|
|
5
|
|
31
|
use File::Spec; |
|
5
|
|
|
|
|
39
|
|
|
5
|
|
|
|
|
129
|
|
14
|
5
|
|
|
5
|
|
25
|
use List::Util; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
371
|
|
15
|
5
|
|
|
5
|
|
38
|
use Mojo::JSON qw/to_json/; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
302
|
|
16
|
5
|
|
|
5
|
|
2054
|
use Mojo::Transaction::HTTP; |
|
5
|
|
|
|
|
79286
|
|
|
5
|
|
|
|
|
52
|
|
17
|
5
|
|
|
5
|
|
177
|
use Mojo::URL; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
30
|
|
18
|
5
|
|
|
5
|
|
2592
|
use Mojo::Log; |
|
5
|
|
|
|
|
68507
|
|
|
5
|
|
|
|
|
53
|
|
19
|
5
|
|
|
5
|
|
208
|
use Mojo::Base 'Mojo::UserAgent'; |
|
5
|
|
|
|
|
17
|
|
|
5
|
|
|
|
|
58
|
|
20
|
5
|
|
|
5
|
|
115966
|
use Mojo::File; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
209
|
|
21
|
5
|
|
|
5
|
|
31
|
use POSIX qw/O_WRONLY O_APPEND O_CREAT/; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
69
|
|
22
|
5
|
|
|
5
|
|
3519
|
use Readonly; |
|
5
|
|
|
|
|
20148
|
|
|
5
|
|
|
|
|
272
|
|
23
|
5
|
|
|
5
|
|
2612
|
use String::Truncate; |
|
5
|
|
|
|
|
22978
|
|
|
5
|
|
|
|
|
35
|
|
24
|
5
|
|
|
5
|
|
1019
|
use Time::HiRes qw/time/; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
76
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
Readonly my $HTTP_OK => 200; |
27
|
|
|
|
|
|
|
Readonly my $HTTP_FILE_NOT_FOUND => 404; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
our $VERSION = '1.23'; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# TODO: Timeout, fallback |
32
|
|
|
|
|
|
|
# TODO: Expected result content (json etc) |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# MOJO_USERAGENT_CONFIG |
35
|
|
|
|
|
|
|
## no critic (ProhibitMagicNumbers) |
36
|
|
|
|
|
|
|
has 'connect_timeout' => sub { $ENV{MOJO_CONNECT_TIMEOUT} // 10 }; |
37
|
|
|
|
|
|
|
has 'inactivity_timeout' => sub { $ENV{MOJO_INACTIVITY_TIMEOUT} // 20 }; |
38
|
|
|
|
|
|
|
has 'max_redirects' => sub { $ENV{MOJO_MAX_REDIRECTS} // 4 }; |
39
|
|
|
|
|
|
|
has 'request_timeout' => sub { $ENV{MOJO_REQUEST_TIMEOUT} // 0 }; |
40
|
|
|
|
|
|
|
## use critic |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# MUAC_CLIENT_CONFIG |
43
|
|
|
|
|
|
|
has 'local_dir' => sub { $ENV{MUAC_LOCAL_DIR} // q{} }; |
44
|
|
|
|
|
|
|
has 'always_return_file' => sub { $ENV{MUAC_ALWAYS_RETURN_FILE} // undef }; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
has 'cache_agent' => sub { |
47
|
|
|
|
|
|
|
$ENV{MUAC_NOCACHE} ? () : CHI->new( |
48
|
|
|
|
|
|
|
driver => $ENV{MUAC_CACHE_DRIVER} || 'File', |
49
|
|
|
|
|
|
|
root_dir => $ENV{MUAC_CACHE_ROOT_DIR} || '/tmp/mojo-useragent-cached', |
50
|
|
|
|
|
|
|
serializer => $ENV{MUAC_CACHE_SERIALIZER} || 'Storable', |
51
|
|
|
|
|
|
|
namespace => $ENV{MUAC_CACHE_NAMESPACE} || 'MUAC_Client', |
52
|
|
|
|
|
|
|
expires_in => $ENV{MUAC_CACHE_EXPIRES_IN} // '1 minute', |
53
|
|
|
|
|
|
|
expires_on_backend => $ENV{MUAC_CACHE_EXPIRES_ON_BACKEND} // 1, |
54
|
|
|
|
|
|
|
%{ shift->cache_opts || {} }, |
55
|
|
|
|
|
|
|
) |
56
|
|
|
|
|
|
|
}; |
57
|
|
|
|
|
|
|
has 'cache_opts' => sub { {} }; |
58
|
|
|
|
|
|
|
has 'cache_url_opts' => sub { {} }; |
59
|
|
|
|
|
|
|
has 'key_generator' => sub { \&key_generator_cb; }; |
60
|
|
|
|
|
|
|
has 'logger' => sub { Mojo::Log->new() }; |
61
|
|
|
|
|
|
|
has 'access_log' => sub { $ENV{MUAC_ACCESS_LOG} || '' }; |
62
|
|
|
|
|
|
|
has 'use_expired_cached_content' => sub { $ENV{MUAC_USE_EXPIRED_CACHED_CONTENT} // 1 }; |
63
|
|
|
|
|
|
|
has 'accepted_error_codes' => sub { $ENV{MUAC_ACCEPTED_ERROR_CODES} || '' }; |
64
|
|
|
|
|
|
|
has 'sorted_queries' => 1; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
has 'created_stacktrace' => ''; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub new { |
69
|
37
|
|
|
37
|
1
|
194789
|
my ($class, %opts) = @_; |
70
|
|
|
|
|
|
|
|
71
|
37
|
|
|
|
|
125
|
my %mojo_agent_config = map { $_ => $opts{$_} } grep { exists $opts{$_} } qw/ |
|
3
|
|
|
|
|
25
|
|
|
592
|
|
|
|
|
1081
|
|
72
|
|
|
|
|
|
|
ca |
73
|
|
|
|
|
|
|
cert |
74
|
|
|
|
|
|
|
connect_timeout |
75
|
|
|
|
|
|
|
cookie_jar |
76
|
|
|
|
|
|
|
inactivity_timeout |
77
|
|
|
|
|
|
|
insecure |
78
|
|
|
|
|
|
|
ioloop |
79
|
|
|
|
|
|
|
key |
80
|
|
|
|
|
|
|
local_address |
81
|
|
|
|
|
|
|
max_connections |
82
|
|
|
|
|
|
|
max_redirects |
83
|
|
|
|
|
|
|
max_response_size |
84
|
|
|
|
|
|
|
proxy |
85
|
|
|
|
|
|
|
request_timeout |
86
|
|
|
|
|
|
|
server |
87
|
|
|
|
|
|
|
transactor |
88
|
|
|
|
|
|
|
/; |
89
|
|
|
|
|
|
|
|
90
|
37
|
|
|
|
|
164
|
my $ua = $class->SUPER::new(%mojo_agent_config); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# Populate attributes |
93
|
37
|
|
|
|
|
281
|
map { $ua->$_( $opts{$_} ) } grep { exists $opts{$_} } qw/ |
|
5
|
|
|
|
|
48
|
|
|
370
|
|
|
|
|
653
|
|
94
|
|
|
|
|
|
|
local_dir |
95
|
|
|
|
|
|
|
always_return_file |
96
|
|
|
|
|
|
|
cache_opts |
97
|
|
|
|
|
|
|
cache_agent |
98
|
|
|
|
|
|
|
cache_url_opts |
99
|
|
|
|
|
|
|
logger |
100
|
|
|
|
|
|
|
access_log |
101
|
|
|
|
|
|
|
use_expired_cached_content |
102
|
|
|
|
|
|
|
accepted_error_codes |
103
|
|
|
|
|
|
|
sorted_queries |
104
|
|
|
|
|
|
|
/; |
105
|
|
|
|
|
|
|
|
106
|
37
|
|
|
|
|
142
|
$ua->created_stacktrace($ua->_get_stacktrace); |
107
|
|
|
|
|
|
|
|
108
|
37
|
|
|
|
|
889
|
return bless($ua, $class); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub invalidate { |
113
|
6
|
|
|
6
|
1
|
1984
|
my ($self, $key) = @_; |
114
|
|
|
|
|
|
|
|
115
|
6
|
50
|
|
|
|
21
|
if ($self->is_cacheable($key)) { |
116
|
6
|
|
|
|
|
46
|
$self->logger->debug("Invalidating cache for '$key'"); |
117
|
6
|
|
|
|
|
1670
|
return $self->cache_agent->remove($key); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
0
|
|
|
|
|
0
|
return; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub expire { |
124
|
2
|
|
|
2
|
1
|
7
|
my ($self, $key) = @_; |
125
|
|
|
|
|
|
|
|
126
|
2
|
50
|
|
|
|
7
|
if ($self->is_cacheable($key)) { |
127
|
2
|
|
|
|
|
13
|
$self->logger->debug("Expiring cache for '$key'"); |
128
|
2
|
|
|
|
|
474
|
return $self->cache_agent->expire($key); |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
0
|
return; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub build_tx { |
135
|
101
|
|
|
101
|
1
|
2777785
|
my ($self, $method, $url, @more) = @_; |
136
|
|
|
|
|
|
|
|
137
|
101
|
|
66
|
|
|
348
|
$url = ($self->always_return_file || $url); |
138
|
|
|
|
|
|
|
|
139
|
101
|
100
|
|
|
|
1051
|
if ($url !~ m{^(/|[^/]+:)}) { |
140
|
11
|
100
|
|
|
|
36
|
if ($self->local_dir) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
141
|
5
|
|
|
|
|
32
|
$url = 'file://' . File::Spec->catfile($self->local_dir, "$url"); |
142
|
|
|
|
|
|
|
} elsif ($self->always_return_file) { |
143
|
0
|
|
|
|
|
0
|
$url = 'file://' . "$url"; |
144
|
|
|
|
|
|
|
} elsif ($url !~ m{^(/|[^/]+:)}) { |
145
|
6
|
|
|
|
|
292
|
$url = 'file://' . Cwd::realpath("$url"); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
101
|
|
|
|
|
769
|
$self->transactor->tx($method, $url, @more); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub start { |
153
|
100
|
|
|
100
|
1
|
26760
|
my ($self, $tx, $cb) = @_; |
154
|
|
|
|
|
|
|
|
155
|
100
|
|
|
|
|
309
|
my $url = $tx->req->url; |
156
|
100
|
|
|
|
|
762
|
my $method = $tx->req->method; |
157
|
100
|
|
|
|
|
840
|
my $headers = $tx->req->headers->to_hash(1); |
158
|
100
|
|
|
|
|
4023
|
my $content = $tx->req->content->asset->slurp; |
159
|
100
|
|
|
|
|
2236
|
delete $headers->{'User-Agent'}; |
160
|
100
|
|
|
|
|
196
|
delete $headers->{'Accept-Encoding'}; |
161
|
100
|
100
|
100
|
|
|
334
|
my @opts = (($method eq 'GET' ? () : $method), (keys %{ $headers || {} } ? $headers : ()), $content || ()); |
|
100
|
50
|
|
|
|
707
|
|
|
|
100
|
|
|
|
|
|
162
|
100
|
|
|
|
|
336
|
my $key = $self->generate_key($url, @opts); |
163
|
100
|
|
|
|
|
369
|
my $start_time = time; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Fork-safety |
166
|
100
|
100
|
100
|
|
|
640
|
$self->_cleanup->server->restart if $self->{pid} && $self->{pid} ne $$; |
167
|
100
|
|
66
|
|
|
3867
|
$self->{pid} //= $$; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
# We wrap the incoming callback in our own callback to be able to cache the response |
170
|
|
|
|
|
|
|
my $wrapper_cb = $cb ? sub { |
171
|
22
|
|
|
22
|
|
157093
|
my ($ua, $tx) = @_; |
172
|
22
|
|
|
|
|
93
|
$cb->($ua, $ua->_post_process_get($tx, $start_time, $key, @opts)); |
173
|
100
|
100
|
|
|
|
347
|
} : (); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# Is an absolute URL or an URL relative to the app eg. http://foo.com/ or /foo.txt |
176
|
100
|
100
|
66
|
|
|
295
|
if ($url !~ m{ \A file:// }gmx && (Mojo::URL->new($url)->is_abs || ($url =~ m{ \A / }gmx && !$self->always_return_file))) { |
|
|
|
66
|
|
|
|
|
177
|
88
|
100
|
|
|
|
41803
|
if ($self->is_cacheable($key)) { |
178
|
27
|
|
|
|
|
1558
|
my $serialized = $self->cache_agent->get($key); |
179
|
27
|
100
|
|
|
|
13942
|
if ($serialized) { |
180
|
14
|
|
|
|
|
61
|
$serialized->{events} = $tx->{events}; |
181
|
14
|
|
|
|
|
52
|
$serialized->{req_events} = $tx->req->{events}; |
182
|
14
|
|
|
|
|
121
|
$serialized->{res_events} = $tx->res->{events}; |
183
|
14
|
|
|
|
|
283
|
my $cached_tx = _build_fake_tx($serialized); |
184
|
14
|
|
|
|
|
90
|
$self->_log_line($cached_tx, { |
185
|
|
|
|
|
|
|
start_time => $start_time, |
186
|
|
|
|
|
|
|
key => $key, |
187
|
|
|
|
|
|
|
type => 'cached result', |
188
|
|
|
|
|
|
|
}); |
189
|
14
|
|
|
|
|
176
|
$cached_tx->req->finish; |
190
|
14
|
|
|
|
|
331
|
$cached_tx->res->finish; |
191
|
14
|
|
|
|
|
248
|
$cached_tx->closed; |
192
|
14
|
100
|
|
|
|
216
|
return $cb->($self, $cached_tx) if $cb; |
193
|
12
|
|
|
|
|
194
|
return $cached_tx; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# Non-blocking |
198
|
74
|
100
|
|
|
|
120171
|
if ($wrapper_cb) { |
199
|
22
|
|
|
|
|
87
|
warn "-- Non-blocking request (@{[_url($tx)]})\n" if Mojo::UserAgent::DEBUG; |
200
|
22
|
|
|
|
|
114
|
return $self->_start(Mojo::IOLoop->singleton, $tx, $wrapper_cb); |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# Blocking |
204
|
52
|
|
|
|
|
75
|
warn "-- Blocking request (@{[_url($tx)]})\n" if Mojo::UserAgent::DEBUG; |
205
|
52
|
|
|
52
|
|
184
|
$self->_start($self->ioloop, $tx => sub { shift->ioloop->stop; $tx = shift }); |
|
52
|
|
|
|
|
1232089
|
|
|
52
|
|
|
|
|
986
|
|
206
|
52
|
|
|
|
|
67298
|
$self->ioloop->start; |
207
|
|
|
|
|
|
|
|
208
|
52
|
|
|
|
|
7305
|
return $self->_post_process_get( $tx, $start_time, $key, @opts ); |
209
|
|
|
|
|
|
|
} else { # Local file eg. t/data/foo.txt or file://.*/ |
210
|
12
|
|
|
|
|
2311
|
$url =~ s{file://}{}; |
211
|
12
|
|
|
|
|
3723
|
my $code = $HTTP_FILE_NOT_FOUND; |
212
|
12
|
|
|
|
|
580
|
my $res; |
213
|
12
|
100
|
|
|
|
21
|
eval { |
214
|
12
|
|
|
|
|
30
|
$res = $self->_parse_local_file_res($url); |
215
|
10
|
|
|
|
|
39
|
$code = $res->{code}; |
216
|
|
|
|
|
|
|
} or $self->logger->error($EVAL_ERROR); |
217
|
|
|
|
|
|
|
|
218
|
12
|
|
|
|
|
743
|
my $params = { url => $url, body => $res->{body}, code => $code, method => 'FILE', headers => $res->{headers}, events => $tx->{events}, req_events => $tx->req->{events}, res_events => $tx->res->{events} }; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# first non-blocking, if no callback, regular post process |
221
|
12
|
|
|
|
|
299
|
my $tx = _build_fake_tx($params); |
222
|
12
|
|
|
|
|
77
|
$self->_log_line($tx, { |
223
|
|
|
|
|
|
|
start_time => $start_time, |
224
|
|
|
|
|
|
|
key => $key, |
225
|
|
|
|
|
|
|
type => 'local file', |
226
|
|
|
|
|
|
|
}); |
227
|
|
|
|
|
|
|
|
228
|
12
|
100
|
|
|
|
77
|
return $cb->($self, $tx) if $cb; |
229
|
11
|
|
|
|
|
103
|
return $tx; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
0
|
|
|
|
|
0
|
return $tx; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub _post_process_get { |
236
|
74
|
|
|
74
|
|
245
|
my ($self, $tx, $start_time, $key) = @_; |
237
|
|
|
|
|
|
|
|
238
|
74
|
100
|
66
|
|
|
216
|
if ( $tx->req->url->scheme ne 'file' && $self->is_cacheable($key) ) { |
239
|
13
|
100
|
|
|
|
222
|
if ( $self->is_considered_error($tx) ) { |
240
|
|
|
|
|
|
|
# Return an expired+cached version of the page for other errors |
241
|
4
|
50
|
|
|
|
72
|
if ( $self->use_expired_cached_content ) { # TODO: URL by URL, and case-by-case expiration |
242
|
4
|
100
|
|
|
|
20
|
if (my $cache_obj = $self->cache_agent->get_object($key)) { |
243
|
1
|
|
|
|
|
247
|
my $serialized = $cache_obj->value; |
244
|
1
|
|
|
|
|
120
|
$serialized->{headers}->{'X-Mojo-UserAgent-Cached-ExpiresAt'} = $cache_obj->expires_at($key); |
245
|
1
|
|
|
|
|
7
|
$serialized->{events} = $tx->{events}; |
246
|
1
|
|
|
|
|
4
|
$serialized->{req_events} = $tx->req->{events}; |
247
|
1
|
|
|
|
|
9
|
$serialized->{res_events} = $tx->res->{events}; |
248
|
|
|
|
|
|
|
|
249
|
1
|
|
|
|
|
7
|
my $expired_tx = _build_fake_tx($serialized); |
250
|
1
|
|
|
|
|
9
|
$self->_log_line( $expired_tx, { |
251
|
|
|
|
|
|
|
start_time => $start_time, |
252
|
|
|
|
|
|
|
key => $key, |
253
|
|
|
|
|
|
|
type => 'expired and cached', |
254
|
|
|
|
|
|
|
orig_tx => $tx, |
255
|
|
|
|
|
|
|
}); |
256
|
1
|
|
|
|
|
18
|
$expired_tx->req->finish; |
257
|
1
|
|
|
|
|
21
|
$expired_tx->res->finish; |
258
|
1
|
|
|
|
|
19
|
$expired_tx->closed; |
259
|
|
|
|
|
|
|
|
260
|
1
|
|
|
|
|
36
|
return $expired_tx; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
} else { |
264
|
|
|
|
|
|
|
# Store object in cache |
265
|
9
|
|
|
|
|
164
|
$self->cache_agent->set($key, _serialize_tx($tx), $self->_cache_url_opts($tx->req->url)); |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
73
|
|
|
|
|
14352
|
$self->_log_line($tx, { |
270
|
|
|
|
|
|
|
start_time => $start_time, |
271
|
|
|
|
|
|
|
key => $key, |
272
|
|
|
|
|
|
|
type => 'fetched', |
273
|
|
|
|
|
|
|
}); |
274
|
|
|
|
|
|
|
|
275
|
73
|
|
|
|
|
1614
|
return $tx; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub _cache_url_opts { |
279
|
9
|
|
|
9
|
|
3440
|
my ($self, $url) = @_; |
280
|
9
|
50
|
|
1
|
|
43
|
my ($pat, $opts) = List::Util::pairfirst { $url =~ /$a/; } %{ $self->cache_url_opts || {} }; |
|
1
|
|
|
|
|
29
|
|
|
9
|
|
|
|
|
46
|
|
281
|
9
|
|
66
|
|
|
382
|
return $opts || (); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
sub set { |
285
|
1
|
|
|
1
|
1
|
20
|
my ($self, $url, $value, @opts) = @_; |
286
|
|
|
|
|
|
|
|
287
|
1
|
|
|
|
|
6
|
my $key = $self->generate_key($url, @opts); |
288
|
1
|
50
|
0
|
|
|
9
|
$self->logger->debug("Illegal cache key: $key") && return if ref $key; |
289
|
|
|
|
|
|
|
|
290
|
1
|
|
|
|
|
16
|
my $fake_tx = _build_fake_tx({ |
291
|
|
|
|
|
|
|
url => $key, |
292
|
|
|
|
|
|
|
body => $value, |
293
|
|
|
|
|
|
|
code => $HTTP_OK, |
294
|
|
|
|
|
|
|
method => 'FILE' |
295
|
|
|
|
|
|
|
}); |
296
|
|
|
|
|
|
|
|
297
|
1
|
|
|
|
|
5
|
$self->logger->debug("Set cache key: $key"); |
298
|
1
|
|
|
|
|
235
|
$self->cache_agent->set($key, _serialize_tx($fake_tx)); |
299
|
1
|
|
|
|
|
1380
|
return $key; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub is_valid { |
303
|
4
|
|
|
4
|
0
|
2431
|
my ($self, $key) = @_; |
304
|
|
|
|
|
|
|
|
305
|
4
|
100
|
50
|
|
|
17
|
($self->logger->debug("Illegal cache key: $key") && return) if ref $key; |
306
|
|
|
|
|
|
|
|
307
|
3
|
|
|
|
|
11
|
$self->logger->debug("Checking if key is valid: $key"); |
308
|
3
|
|
|
|
|
691
|
return $self->cache_agent->is_valid($key); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub is_cacheable { |
312
|
133
|
|
|
133
|
0
|
993
|
my ($self, $url) = @_; |
313
|
|
|
|
|
|
|
|
314
|
133
|
|
66
|
|
|
365
|
return $self->cache_agent && ($url !~ m{ \A / }gmx); |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub generate_key { |
318
|
113
|
|
|
113
|
1
|
8024
|
my ($self, $url, @opts) = @_; |
319
|
|
|
|
|
|
|
|
320
|
113
|
|
|
|
|
368
|
return $self->key_generator->($self, $url, @opts); |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub key_generator_cb { |
324
|
113
|
|
|
113
|
0
|
1090
|
my ($self, $url, @opts) = @_; |
325
|
|
|
|
|
|
|
|
326
|
113
|
100
|
|
|
|
333
|
my $key = join q{,}, $self->sort_query($url), (@opts ? to_json(@opts > 1 ? \@opts : $opts[0]) : ()); |
|
|
100
|
|
|
|
|
|
327
|
|
|
|
|
|
|
|
328
|
113
|
|
|
|
|
1803
|
return $key; |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
sub is_considered_error { |
332
|
13
|
|
|
13
|
0
|
29
|
my ($self, $tx) = @_; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# If we find some error codes that should be accepted, we don't consider this an error |
335
|
13
|
100
|
100
|
|
|
42
|
if ( $tx->error && $self->accepted_error_codes ) { |
336
|
2
|
50
|
|
|
|
50
|
my $codes = ref $self->accepted_error_codes ? $self->accepted_error_codes |
337
|
|
|
|
|
|
|
: [ ( $self->accepted_error_codes ) ]; |
338
|
2
|
50
|
|
2
|
|
31
|
return if List::Util::first { $tx->error->{code} == $_ } @{$codes}; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
23
|
|
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
11
|
|
|
|
|
202
|
return $tx->error; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub sort_query { |
345
|
119
|
|
|
119
|
1
|
3871
|
my ($self, $url) = @_; |
346
|
119
|
50
|
|
|
|
331
|
return $url unless $self->sorted_queries; |
347
|
|
|
|
|
|
|
|
348
|
119
|
100
|
|
|
|
796
|
$url = Mojo::URL->new($url) unless ref $url eq 'Mojo::URL'; |
349
|
|
|
|
|
|
|
|
350
|
119
|
100
|
|
|
|
2714
|
my $flattened_sorted_url = ($url->protocol ? ( $url->protocol . '://' ) : '' ) . |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
351
|
|
|
|
|
|
|
($url->userinfo ? ( $url->userinfo . '@' ) : '' ) . |
352
|
|
|
|
|
|
|
($url->host ? ( $url->host_port ) : '' ) . |
353
|
|
|
|
|
|
|
($url->path ? ( $url->path ) : '' ) ; |
354
|
|
|
|
|
|
|
|
355
|
7
|
100
|
|
21
|
|
30
|
$flattened_sorted_url .= '?' . join '&', sort { $a cmp $b } List::Util::pairmap { (($b ne '') ? (join '=', $a, $b) : $a); } @{ $url->query } |
|
21
|
|
|
|
|
384
|
|
|
14
|
|
|
|
|
1679
|
|
356
|
119
|
100
|
|
|
|
13100
|
if scalar @{ $url->query }; |
|
119
|
|
|
|
|
355
|
|
357
|
|
|
|
|
|
|
|
358
|
119
|
|
|
|
|
3678
|
return $flattened_sorted_url; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
sub _serialize_tx { |
362
|
10
|
|
|
10
|
|
1373
|
my ($tx) = @_; |
363
|
|
|
|
|
|
|
|
364
|
10
|
|
|
|
|
28
|
$tx->res->headers->header('X-Mojo-UserAgent-Cached', time); |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
return { |
367
|
10
|
|
|
|
|
499
|
method => $tx->req->method, |
368
|
|
|
|
|
|
|
url => $tx->req->url, |
369
|
|
|
|
|
|
|
code => $tx->res->code, |
370
|
|
|
|
|
|
|
body => $tx->res->body, |
371
|
|
|
|
|
|
|
json => $tx->res->json, |
372
|
|
|
|
|
|
|
headers => $tx->res->headers->to_hash, |
373
|
|
|
|
|
|
|
}; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub _build_fake_tx { |
377
|
28
|
|
|
28
|
|
76
|
my ($opts) = @_; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# Create transaction object to return so we look like a regular request |
380
|
28
|
|
|
|
|
164
|
my $tx = Mojo::Transaction::HTTP->new(); |
381
|
|
|
|
|
|
|
|
382
|
28
|
|
|
|
|
172
|
$tx->req->method($opts->{method}); |
383
|
28
|
|
|
|
|
578
|
$tx->req->url(Mojo::URL->new($opts->{url})); |
384
|
|
|
|
|
|
|
|
385
|
28
|
|
|
|
|
5539
|
$tx->res->headers->from_hash($opts->{headers}); |
386
|
|
|
|
|
|
|
|
387
|
28
|
|
|
|
|
3219
|
my $now = time; |
388
|
28
|
|
66
|
|
|
87
|
$tx->res->headers->header('X-Mojo-UserAgent-Cached-Age', $now - ($tx->res->headers->header('X-Mojo-UserAgent-Cached') || $now)); |
389
|
|
|
|
|
|
|
|
390
|
28
|
|
|
|
|
1785
|
$tx->res->code($opts->{code}); |
391
|
28
|
|
|
|
|
326
|
$tx->res->{json} = $opts->{json}; |
392
|
28
|
|
|
|
|
152
|
$tx->res->body($opts->{body}); |
393
|
|
|
|
|
|
|
|
394
|
28
|
|
|
|
|
1436
|
$tx->{events} = $opts->{events}; |
395
|
28
|
|
|
|
|
84
|
$tx->req->{events} = $opts->{req_events}; |
396
|
28
|
|
|
|
|
155
|
$tx->res->{events} = $opts->{res_events}; |
397
|
|
|
|
|
|
|
|
398
|
28
|
|
|
|
|
149
|
return $tx; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
sub _parse_local_file_res { |
402
|
12
|
|
|
12
|
|
30
|
my ($self, $url) = @_; |
403
|
|
|
|
|
|
|
|
404
|
12
|
|
|
|
|
21
|
my $headers; |
405
|
12
|
|
|
|
|
71
|
my $body = Mojo::File->new($url)->slurp; |
406
|
10
|
|
|
|
|
1318
|
my $code = $HTTP_OK; |
407
|
10
|
|
|
|
|
67
|
my $msg = 'OK'; |
408
|
|
|
|
|
|
|
|
409
|
10
|
100
|
|
|
|
58
|
if ($body =~ m{\A (?: DELETE | GET | HEAD | OPTIONS | PATCH | POST | PUT ) \s }gmx) { |
410
|
2
|
|
|
|
|
14
|
my $code_msg_headers; |
411
|
|
|
|
|
|
|
my $code_msg; |
412
|
2
|
|
|
|
|
0
|
my $http; |
413
|
2
|
|
|
|
|
0
|
my $msg; |
414
|
2
|
|
|
|
|
38
|
(undef, $code_msg_headers, $body) = split m{(?:\r\n|\n){2,}}mx, $body, 3; ## no critic (ProhibitMagicNumbers) |
415
|
2
|
|
|
|
|
18
|
($code_msg, $headers) = split m{(?:\r\n|\n)}mx, $code_msg_headers, 2; |
416
|
2
|
|
|
|
|
16
|
($http, $code, $msg) = $code_msg =~ m{ \A (?:(\S+) \s+)? (\d+) \s+ (.*) \z}mx; |
417
|
|
|
|
|
|
|
|
418
|
2
|
|
|
|
|
15
|
$headers = Mojo::Headers->new->parse("$headers\n\n")->to_hash; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
10
|
|
|
|
|
444
|
return { body => $body, code => $code, message => $msg, headers => $headers }; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
sub _write_local_file_res { |
425
|
100
|
|
|
100
|
|
329
|
my ($self, $tx, $dir) = @_; |
426
|
|
|
|
|
|
|
|
427
|
100
|
0
|
33
|
|
|
323
|
return unless ($dir && -e $dir && -d $dir); |
|
|
|
33
|
|
|
|
|
428
|
|
|
|
|
|
|
|
429
|
0
|
|
|
|
|
0
|
my $method = $tx->req->method; |
430
|
0
|
|
|
|
|
0
|
my $url = $tx->req->url; |
431
|
0
|
|
|
|
|
0
|
my $body = $tx->res->body; |
432
|
0
|
|
|
|
|
0
|
my $code = $tx->res->code; |
433
|
0
|
|
|
|
|
0
|
my $message = $tx->res->message; |
434
|
|
|
|
|
|
|
|
435
|
0
|
|
|
|
|
0
|
my $target_file = File::Spec->catfile($dir, split '/', $url->path_query); |
436
|
0
|
|
|
|
|
0
|
File::Path::make_path(File::Basename::dirname($target_file)); |
437
|
0
|
0
|
|
|
|
0
|
Mojo::File->new($target_file)->spurt(( |
438
|
|
|
|
|
|
|
join "\n\n", |
439
|
|
|
|
|
|
|
(join " ", $method, "$url\n" ) . $tx->req->headers->to_string, |
440
|
|
|
|
|
|
|
(join " ", $code, "$message\n") . $tx->res->headers->to_string, |
441
|
|
|
|
|
|
|
$body |
442
|
|
|
|
|
|
|
) |
443
|
|
|
|
|
|
|
) and $self->logger->debug("Wrote request+response to: '$target_file'"); |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
sub _log_line { |
447
|
100
|
|
|
100
|
|
228
|
my ($self, $tx, $opts) = @_; |
448
|
|
|
|
|
|
|
|
449
|
100
|
|
|
|
|
452
|
$self->_write_local_file_res($tx, $ENV{MUAC_CLIENT_WRITE_LOCAL_FILE_RES_DIR}); |
450
|
|
|
|
|
|
|
|
451
|
100
|
|
|
|
|
346
|
my $callers = $self->_get_stacktrace; |
452
|
100
|
|
|
|
|
1455
|
my $created_stacktrace = $self->created_stacktrace; |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
# Remove common parts to get smaller created stacktrace |
455
|
100
|
|
|
|
|
1070
|
my $strings = Algorithm::LCSS::CSS_Sorted( [ split /,/, $callers ] , [ split /,/, $created_stacktrace ] ); |
456
|
|
|
|
|
|
|
map { |
457
|
24
|
|
|
|
|
42
|
my @lcss = @{$_}; |
|
24
|
|
|
|
|
71
|
|
458
|
24
|
|
|
|
|
116
|
my $pat = join ",", @lcss[1..$#lcss-1]; |
459
|
24
|
50
|
|
|
|
88
|
if (scalar @lcss > 2) { $created_stacktrace =~ s{$pat}{,}mx } |
|
24
|
|
|
|
|
264
|
|
460
|
100
|
50
|
|
|
|
14861
|
} @{ $strings || [] }; |
|
100
|
|
|
|
|
349
|
|
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
$self->logger->debug(sprintf(q{Returning %s '%s' => %s for %s (%s)}, ( |
463
|
|
|
|
|
|
|
$opts->{type}, |
464
|
|
|
|
|
|
|
String::Truncate::elide( $tx->req->url, 150, { truncate => 'middle'} ), |
465
|
100
|
|
33
|
|
|
349
|
($tx->res->code || $tx->res->error->{code} || $tx->res->error->{message}), |
466
|
|
|
|
|
|
|
$callers, $created_stacktrace |
467
|
|
|
|
|
|
|
))); |
468
|
|
|
|
|
|
|
|
469
|
100
|
50
|
|
|
|
63116
|
return unless $self->access_log; |
470
|
|
|
|
|
|
|
|
471
|
0
|
|
|
|
|
0
|
my $elapsed_time = sprintf '%.3f', (time-$opts->{start_time}); |
472
|
|
|
|
|
|
|
|
473
|
0
|
|
|
|
|
0
|
my $NONE = q{-}; |
474
|
|
|
|
|
|
|
|
475
|
0
|
|
0
|
|
|
0
|
my $http_host = $tx->req->url->host || $NONE; |
476
|
0
|
|
|
|
|
0
|
my $remote_addr = $NONE; |
477
|
0
|
|
0
|
|
|
0
|
my $time_local = POSIX::strftime('%d/%b/%Y:%H:%M:%S %z', localtime) || $NONE; |
478
|
0
|
|
0
|
|
|
0
|
my $request = ($tx->req->method . q{ } . $tx->req->url->path_query) || $NONE; |
479
|
0
|
|
0
|
|
|
0
|
my $status = $tx->res->code || $NONE; |
480
|
0
|
|
0
|
|
|
0
|
my $body_bytes_sent = length $tx->res->body || $NONE; |
481
|
0
|
|
0
|
|
|
0
|
my $http_referer = $callers || $NONE; |
482
|
0
|
|
0
|
|
|
0
|
my $http_user_agent = __PACKAGE__ . "(" . $opts->{type} .")" || $NONE; |
483
|
0
|
|
0
|
|
|
0
|
my $request_time = $elapsed_time || $NONE; |
484
|
0
|
|
0
|
|
|
0
|
my $upstream_response_time = $elapsed_time || $NONE; |
485
|
0
|
|
|
|
|
0
|
my $http_x_forwarded_for = $NONE; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
# Use sysopen, slightly slower and hits disk, but avoids clobbering |
488
|
0
|
|
|
|
|
0
|
sysopen my $fh, $self->access_log, O_WRONLY | O_APPEND | O_CREAT; ## no critic (ProhibitBitwiseOperators) |
489
|
0
|
0
|
|
|
|
0
|
syswrite $fh, qq{$http_host $remote_addr [$time_local] "$request" $status $body_bytes_sent "$http_referer" "$http_user_agent" $request_time $upstream_response_time "$http_x_forwarded_for"\n} |
490
|
|
|
|
|
|
|
or $self->logger->warn("Unable to write to '" . $self->access_log . "': $OS_ERROR"); |
491
|
0
|
0
|
|
|
|
0
|
close $fh or $self->logger->warn("Unable to close '" . $self->access_log . "': $OS_ERROR"); |
492
|
|
|
|
|
|
|
|
493
|
0
|
|
|
|
|
0
|
return; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
sub _get_stacktrace { |
497
|
137
|
|
|
137
|
|
292
|
my ($self) = @_; |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
my @frames = ( Devel::StackTrace->new( |
500
|
|
|
|
|
|
|
ignore_class => [ 'Devel::StackTrace', 'Mojo::UserAgent::Cached', 'Template::Document', 'Template::Context', 'Template::Service' ], |
501
|
618
|
|
|
618
|
|
106738
|
frame_filter => sub { ($_[0]->{caller}->[0] !~ m{ \A Mojo | Try }gmx) }, |
502
|
137
|
|
|
|
|
1251
|
)->frames() ); |
503
|
|
|
|
|
|
|
|
504
|
137
|
|
|
|
|
10083
|
my $prev_package = ''; |
505
|
|
|
|
|
|
|
my $callers = join q{,}, map { |
506
|
299
|
|
|
|
|
1497
|
my $package = $_->package; |
507
|
299
|
50
|
|
|
|
1791
|
if ($package eq 'Template::Provider') { |
508
|
0
|
|
|
|
|
0
|
$package = (join "/", grep { $_ } (split '/', $_->filename)[-3..-1]); |
|
0
|
|
|
|
|
0
|
|
509
|
|
|
|
|
|
|
} |
510
|
299
|
100
|
|
|
|
629
|
if ($prev_package eq $package) { |
511
|
42
|
|
|
|
|
84
|
$package = ''; |
512
|
|
|
|
|
|
|
} else { |
513
|
257
|
|
|
|
|
416
|
$prev_package = $package; |
514
|
257
|
|
|
|
|
973
|
$package =~ s/(?:(\w)\w*::)/$1./gmx; |
515
|
257
|
|
|
|
|
570
|
$package .= ':'; |
516
|
|
|
|
|
|
|
} |
517
|
299
|
|
|
|
|
665
|
$package . $_->line(); |
518
|
137
|
|
|
|
|
381
|
} grep { $_ } @frames; |
|
299
|
|
|
|
|
629
|
|
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
0
|
|
|
0
|
|
|
sub _url { shift->req->url->to_abs } |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
1; |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
=encoding utf8 |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=head1 NAME |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
Mojo::UserAgent::Cached - Caching, Non-blocking I/O HTTP, Local file and WebSocket user agent |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
=head1 SYNOPSIS |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
use Mojo::UserAgent::Cached; |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
my $ua = Mojo::UserAgent::Cached->new; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
=head1 DESCRIPTION |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
L is a full featured caching, non-blocking I/O HTTP, Local file and WebSocket user |
540
|
|
|
|
|
|
|
agent, with IPv6, TLS, SNI, IDNA, Comet (long polling), keep-alive, connection |
541
|
|
|
|
|
|
|
pooling, timeout, cookie, multipart, proxy, gzip compression and multiple |
542
|
|
|
|
|
|
|
event loop support. |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
It inherits all of the features L provides but in addition allows you to |
545
|
|
|
|
|
|
|
retrieve cached content using a L compatible caching engine. |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
See L and L for more. |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
L inherits all attributes from L and implements the following new ones. |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
=head2 local_dir |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
my $local_dir = $ua->local_dir; |
556
|
|
|
|
|
|
|
$ua->local_dir('/path/to/local_files'); |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
Sets the local dir, used as a prefix where relative URLs are fetched from. A C request would |
559
|
|
|
|
|
|
|
read the file '/tmp/foobar.txt' if local_dir is set to '/tmp', defaults to the value of the |
560
|
|
|
|
|
|
|
C environment variable and if not set, to ''. |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
=head2 always_return_file |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
my $file = $ua->always_return_file; |
565
|
|
|
|
|
|
|
$ua->always_return_file('/tmp/default_file.txt'); |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
Makes all consecutive request return the same file, no matter what file or URL is requested with C, defaults |
568
|
|
|
|
|
|
|
to the value of the C environment value and if not, it respects the File/URL in the request. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=head2 cache_agent |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
my $cache_agent = $ua->cache_agent; |
573
|
|
|
|
|
|
|
$ua->cache_agent(CHI->new( |
574
|
|
|
|
|
|
|
driver => $ENV{MUAC_CACHE_DRIVER} || 'File', |
575
|
|
|
|
|
|
|
root_dir => $ENV{MUAC_CACHE_ROOT_DIR} || '/tmp/mojo-useragent-cached', |
576
|
|
|
|
|
|
|
serializer => $ENV{MUAC_CACHE_SERIALIZER} || 'Storable', |
577
|
|
|
|
|
|
|
namespace => $ENV{MUAC_CACHE_NAMESPACE} || 'MUAC_Client', |
578
|
|
|
|
|
|
|
expires_in => $ENV{MUAC_CACHE_EXPIRES_IN} // '1 minute', |
579
|
|
|
|
|
|
|
expires_on_backend => $ENV{MUAC_CACHE_EXPIRES_ON_BACKEND} // 1, |
580
|
|
|
|
|
|
|
)); |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
Tells L which cache_agent to use. It needs to be CHI-compliant and defaults to the above settings. |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
You may also set the C<$ENV{MUAC_NOCACHE}> environment variable to avoid caching at all. |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
=head2 cache_opts |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
my $cache_opts = $ua->cache_opts; |
589
|
|
|
|
|
|
|
$ua->cache_opts({ expires_in => '5 minutes' }); |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
Allows passing in cache options that will be appended to existing options in default cache agent creation. |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=head2 cache_url_opts |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
my $urls_href = $ua->cache_url_opts; |
596
|
|
|
|
|
|
|
$ua->cache_url_opts({ |
597
|
|
|
|
|
|
|
'https?://foo.com/long-lasting-data.*' => { expires_in => '2 weeks' }, # Cache some data two weeks |
598
|
|
|
|
|
|
|
'.*' => { expires_at => 0 }, # Don't store anything in cache |
599
|
|
|
|
|
|
|
}); |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
Accepts a hash ref of regexp strings and expire times, this allows you to define cache validity time for individual URLs, hosts etc. |
602
|
|
|
|
|
|
|
The first match will be used. |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
=head2 key_generator |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
A callback method to generate keys. The method gets ($self, $url, @opts) passed as parameters. The default is set to C |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
=head2 logger |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
Provide a logging object, defaults to Mojo::Log |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
# Example: |
613
|
|
|
|
|
|
|
# Returning fetched 'https://graph.facebook.com?ids=http%3A%2F%2Fexample.com%2Flivet%2F20...-lommebok&access_token=1234' => 200 for A.C.Facebook:133,185,183,A.M.F.ArticleList:19,9,A.M.Selector:47,responsive/modules/most-shared.html.tt:15,15,13,templates/inc/macros.tt:125,138,templates/responsive/frontpage.html.tt:10,10,16,Template:66,A.G.C.Article:338,147,main:14 (A.C.Facebook:68,E.C.Sandbox_874:7,A.C.Facebook:133,,,main:14) |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
Format: |
616
|
|
|
|
|
|
|
Returning '' => 'HTTP code' for () |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
cache-status: (cached|fetched|cached+expired) |
619
|
|
|
|
|
|
|
URL: the URL requested, shortened when it is really long |
620
|
|
|
|
|
|
|
request_stacktrace: Simplified stacktrace with leading module names shortened, also includes TT stacktrace support. Line numbers in the same module are grouped (order kept of course). |
621
|
|
|
|
|
|
|
created_stacktrace: Stack trace for creation of UA object, useful to see what options went in, and which object is used. Same format as normal stacktrace, but skips common parts. |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
Example: |
624
|
|
|
|
|
|
|
created_stacktrace: A.C.Facebook:68,E.C.Sandbox_874:7,A.C.Facebook:133,,main:14 |
625
|
|
|
|
|
|
|
stacktrace: A.C.Facebook:133,< common part: 185,183,A.M.F.ArticleList:19,9,A.M.Selector:47,responsive/modules/most-shared.html.tt:15,15,13,templates/inc/macros.tt:125,138,templates/responsive/frontpage.html.tt:10,10,16,Template:66,A.G.C.Article:338,147 >,main:14 |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=head2 access_log |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
A file that will get logs of every request, the format is a hybrid of Apache combined log, including time spent for the request. |
630
|
|
|
|
|
|
|
If provided the file will be written to. Defaults to C<$ENV{MUAC_ACCESS_LOG} || ''> which means no log will be written. |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
=head2 use_expired_cached_content |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
Indicates that we will send expired, cached content back. This means that if a request fails, and the cache has expired, you |
635
|
|
|
|
|
|
|
will get back the last successful content. Defaults to C<$ENV{MUAC_EXPIRED_CONTENT} // 1> |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=head2 accepted_error_codes |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
A list of error codes that should not be considered as errors. For instance this means that the client will not look for expired |
640
|
|
|
|
|
|
|
cached content for requests that result in this response. Defaults to C<$ENV{MUAC_ACCEPTED_ERROR_CODES} || ''> |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
=head2 sorted_queries |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
Setting this to a true value will sort query parameters in the resulting URL. This means that requests will be identical if the key/value pairs |
645
|
|
|
|
|
|
|
are the same. This helps when URLs have been built up using hashes that may have random orders. |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=head1 OVERRIDEN ATTRIBUTES |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
In addition L overrides the following L attributes. |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=head2 connect_timeout |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
Defaults to C<$ENV{MOJO_CONNECT_TIMEOUT} // 2> |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=head2 inactivity_timeout |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
Defaults to C<$ENV{MOJO_INACTIVITY_TIMEOUT} // 5> |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
=head2 max_redirects |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
Defaults to C<$ENV{MOJO_MAX_REDIRECTS} // 4> |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=head2 request_timeout |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
Defaults to C<$ENV{MOJO_REQUEST_TIMEOUT} // 10> |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=head1 METHODS |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
L inherits all methods from L and |
670
|
|
|
|
|
|
|
implements the following new ones. |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=head2 invalidate |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
$ua->invalidate($key); |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
Deletes the cache of the given $key. |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=head2 expire |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
$ua->expire($key); |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
Set the cache of the given $key as expired. |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
=head2 set |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
my $tx = $ua->build_tx(GET => "http://localhost:$port", ...); |
687
|
|
|
|
|
|
|
$tx = $ua->start($tx); |
688
|
|
|
|
|
|
|
my $cache_key = $ua->generate_key("http://localhost:$port", ...); |
689
|
|
|
|
|
|
|
$ua->set($cache_key, $tx); |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
Set allows setting data directly for a given URL |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
=head2 generate_key(@params) |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
Returns a key to be used for the cache agent. It accepts the same parameters |
696
|
|
|
|
|
|
|
that a normal ->get() request does. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=head2 validate_key |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
my $status = $ua4->validate_key('http://example.com'); |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
Fast validates if key is valid in cache without doing fetch. |
703
|
|
|
|
|
|
|
Return 1 if true. |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=head2 sort_query($url) |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
Returns a string with the URL passed, with sorted query parameters suitable for cache lookup |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=head1 OVERRIDEN METHODS |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
=head2 new |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
my $ua = Mojo::UserAgent::Cached->new( request_timeout => 1, ... ); |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
Accepts the attributes listed above and all attributes from L. |
716
|
|
|
|
|
|
|
Stores its own attributes and passes on the relevant ones when creating a |
717
|
|
|
|
|
|
|
parent L object that it inherits from. Returns a L object |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=head2 get(@params) |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
my $tx = $ua->get('http://example.com'); |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
Accepts the same arguments and returns the same as L. |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
It will try to return a cached version of the $url, adhering to the set or default attributes. |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
In addition if a relative file path is given, it tries to return the file appended to |
728
|
|
|
|
|
|
|
the attribute C. In this case a fake L object is returned, |
729
|
|
|
|
|
|
|
populated with a L with method and url, and a L |
730
|
|
|
|
|
|
|
with headers, code and body set. |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=head1 ENVIRONMENT VARIABLES |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
C<$ENV{MUAC_CLIENT_WRITE_LOCAL_FILE_RES_DIR}> can be set to a directory to store a request in: |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
# Re-usable local file with headers and metadata ends up at 't/data/dir/lol/foo.html?bar=1' |
737
|
|
|
|
|
|
|
$ENV{MUAC_CLIENT_WRITE_LOCAL_FILE_RES_DIR}='t/data/dir'; |
738
|
|
|
|
|
|
|
Mojo::UserAgent::Cached->new->get("http://foo.com/lol/foo.html?bar=1"); |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=head1 SEE ALSO |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
L, L, L, L. |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
=head1 COPYRIGHT |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
Nicolas Mendoza (2015-), ABC Startsiden (2015) |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=head1 LICENSE |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Same as Perl licence as per agreement with ABC Startsiden on 2015-06-02 |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=cut |