File Coverage

blib/lib/Mojo/UserAgent/Cached.pm
Criterion Covered Total %
statement 260 292 89.0
branch 72 96 75.0
condition 29 73 39.7
subroutine 48 49 97.9
pod 8 12 66.6
total 417 522 79.8


line stmt bran cond sub pod time code
1             package Mojo::UserAgent::Cached;
2              
3 5     5   2434267 use warnings;
  5         49  
  5         169  
4 5     5   45 use strict;
  5         25  
  5         94  
5 5     5   85 use v5.10;
  5         19  
6 5     5   2385 use Algorithm::LCSS;
  5         32131  
  5         259  
7 5     5   3297 use CHI;
  5         392054  
  5         197  
8 5     5   51 use Cwd ();
  5         11  
  5         109  
9 5     5   2636 use Devel::StackTrace;
  5         17054  
  5         264  
10 5     5   2903 use English qw(-no_match_vars);
  5         8755  
  5         31  
11 5     5   1796 use File::Basename;
  5         11  
  5         356  
12 5     5   44 use File::Path;
  5         12  
  5         280  
13 5     5   31 use File::Spec;
  5         48  
  5         119  
14 5     5   27 use List::Util;
  5         10  
  5         317  
15 5     5   34 use Mojo::JSON qw/to_json/;
  5         10  
  5         273  
16 5     5   2284 use Mojo::Transaction::HTTP;
  5         80085  
  5         49  
17 5     5   175 use Mojo::URL;
  5         11  
  5         37  
18 5     5   2575 use Mojo::Log;
  5         67716  
  5         48  
19 5     5   195 use Mojo::Base 'Mojo::UserAgent';
  5         12  
  5         35  
20 5     5   116936 use Mojo::File;
  5         16  
  5         232  
21 5     5   35 use POSIX qw/O_WRONLY O_APPEND O_CREAT/;
  5         12  
  5         54  
22 5     5   3265 use Readonly;
  5         20958  
  5         277  
23 5     5   2553 use String::Truncate;
  5         23714  
  5         37  
24 5     5   1113 use Time::HiRes qw/time/;
  5         10  
  5         88  
25              
26             Readonly my $HTTP_OK => 200;
27             Readonly my $HTTP_FILE_NOT_FOUND => 404;
28              
29             our $VERSION = '1.24';
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 195044 my ($class, %opts) = @_;
70              
71 37         123 my %mojo_agent_config = map { $_ => $opts{$_} } grep { exists $opts{$_} } qw/
  3         17  
  592         1019  
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         178 my $ua = $class->SUPER::new(%mojo_agent_config);
91              
92             # Populate attributes
93 37         275 map { $ua->$_( $opts{$_} ) } grep { exists $opts{$_} } qw/
  5         42  
  370         635  
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         146 $ua->created_stacktrace($ua->_get_stacktrace);
107              
108 37         943 return bless($ua, $class);
109             }
110              
111              
112             sub invalidate {
113 6     6 1 2011 my ($self, $key) = @_;
114              
115 6 50       21 if ($self->is_cacheable($key)) {
116 6         48 $self->logger->debug("Invalidating cache for '$key'");
117 6         1663 return $self->cache_agent->remove($key);
118             }
119              
120 0         0 return;
121             }
122              
123             sub expire {
124 2     2 1 9 my ($self, $key) = @_;
125              
126 2 50       9 if ($self->is_cacheable($key)) {
127 2         14 $self->logger->debug("Expiring cache for '$key'");
128 2         481 return $self->cache_agent->expire($key);
129             }
130              
131 0         0 return;
132             }
133              
134             sub build_tx {
135 101     101 1 2780028 my ($self, $method, $url, @more) = @_;
136              
137 101   66     357 $url = ($self->always_return_file || $url);
138              
139 101 100       1138 if ($url !~ m{^(/|[^/]+:)}) {
140 11 100       34 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         317 $url = 'file://' . Cwd::realpath("$url");
146             }
147             }
148              
149 101         772 $self->transactor->tx($method, $url, @more);
150             }
151              
152             sub start {
153 100     100 1 27799 my ($self, $tx, $cb) = @_;
154              
155 100         305 my $url = $tx->req->url->to_unsafe_string;
156 100         19159 my $method = $tx->req->method;
157 100         839 my $headers = $tx->req->headers->to_hash(1);
158 100         4236 my $content = $tx->req->content->asset->slurp;
159 100         2318 delete $headers->{'User-Agent'};
160 100         218 delete $headers->{'Accept-Encoding'};
161 100 100 100     402 my @opts = (($method eq 'GET' ? () : $method), (keys %{ $headers || {} } ? $headers : ()), $content || ());
  100 50       1266  
    100          
162 100         336 my $key = $self->generate_key($url, @opts);
163 100         348 my $start_time = time;
164              
165             # Fork-safety
166 100 100 100     792 $self->_cleanup->server->restart if $self->{pid} && $self->{pid} ne $$;
167 100   66     3789 $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   153180 my ($ua, $tx) = @_;
172 22         95 $cb->($ua, $ua->_post_process_get($tx, $start_time, $key, @opts));
173 100 100       457 } : ();
174              
175             # Is an absolute URL or an URL relative to the app eg. http://foo.com/ or /foo.txt
176 100 100 66     588 if ($url !~ m{ \A file:// }gmx && (Mojo::URL->new($url)->is_abs || ($url =~ m{ \A / }gmx && !$self->always_return_file))) {
      66        
177 88 100       7124 if ($self->is_cacheable($key)) {
178 27         1476 my $serialized = $self->cache_agent->get($key);
179 27 100       14652 if ($serialized) {
180 14         66 $serialized->{events} = $tx->{events};
181 14         56 $serialized->{req_events} = $tx->req->{events};
182 14         130 $serialized->{res_events} = $tx->res->{events};
183 14         274 my $cached_tx = _build_fake_tx($serialized);
184 14         100 $self->_log_line($cached_tx, {
185             start_time => $start_time,
186             key => $key,
187             type => 'cached result',
188             });
189 14         149 $cached_tx->req->finish;
190 14         369 $cached_tx->res->finish;
191 14         257 $cached_tx->closed;
192 14 100       225 return $cb->($self, $cached_tx) if $cb;
193 12         208 return $cached_tx;
194             }
195             }
196              
197             # Non-blocking
198 74 100       126748 if ($wrapper_cb) {
199 22         36 warn "-- Non-blocking request (@{[_url($tx)]})\n" if Mojo::UserAgent::DEBUG;
200 22         115 return $self->_start(Mojo::IOLoop->singleton, $tx, $wrapper_cb);
201             }
202              
203             # Blocking
204 52         101 warn "-- Blocking request (@{[_url($tx)]})\n" if Mojo::UserAgent::DEBUG;
205 52     52   185 $self->_start($self->ioloop, $tx => sub { shift->ioloop->stop; $tx = shift });
  52         1229142  
  52         1001  
206 52         67720 $self->ioloop->start;
207              
208 52         10326 return $self->_post_process_get( $tx, $start_time, $key, @opts );
209             } else { # Local file eg. t/data/foo.txt or file://.*/
210 12         54 $url =~ s{file://}{};
211 12         73 my $code = $HTTP_FILE_NOT_FOUND;
212 12         65 my $res;
213 12 100       18 eval {
214 12         33 $res = $self->_parse_local_file_res($url);
215 10         41 $code = $res->{code};
216             } or $self->logger->error($EVAL_ERROR);
217              
218 12         755 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         308 my $tx = _build_fake_tx($params);
222 12         72 $self->_log_line($tx, {
223             start_time => $start_time,
224             key => $key,
225             type => 'local file',
226             });
227              
228 12 100       363 return $cb->($self, $tx) if $cb;
229 11         93 return $tx;
230             }
231              
232 0         0 return $tx;
233             }
234              
235             sub _post_process_get {
236 74     74   241 my ($self, $tx, $start_time, $key) = @_;
237              
238 74 100 66     218 if ( $tx->req->url->scheme ne 'file' && $self->is_cacheable($key) ) {
239 13 100       249 if ( $self->is_considered_error($tx) ) {
240             # Return an expired+cached version of the page for other errors
241 4 50       71 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         371 my $serialized = $cache_obj->value;
244 1         159 $serialized->{headers}->{'X-Mojo-UserAgent-Cached-ExpiresAt'} = $cache_obj->expires_at($key);
245 1         6 $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         9 my $expired_tx = _build_fake_tx($serialized);
250 1         20 $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         14 $expired_tx->req->finish;
257 1         24 $expired_tx->res->finish;
258 1         18 $expired_tx->closed;
259              
260 1         40 return $expired_tx;
261             }
262             }
263             } else {
264             # Store object in cache
265 9         193 $self->cache_agent->set($key, _serialize_tx($tx), $self->_cache_url_opts($tx->req->url));
266             }
267             }
268              
269 73         31729 $self->_log_line($tx, {
270             start_time => $start_time,
271             key => $key,
272             type => 'fetched',
273             });
274              
275 73         1553 return $tx;
276             }
277              
278             sub _cache_url_opts {
279 9     9   3633 my ($self, $url) = @_;
280 9 50   1   48 my ($pat, $opts) = List::Util::pairfirst { $url =~ /$a/; } %{ $self->cache_url_opts || {} };
  1         30  
  9         35  
281 9   66     347 return $opts || ();
282             }
283              
284             sub set {
285 1     1 1 17 my ($self, $url, $value, @opts) = @_;
286              
287 1         4 my $key = $self->generate_key($url, @opts);
288 1 50 0     6 $self->logger->debug("Illegal cache key: $key") && return if ref $key;
289              
290 1         13 my $fake_tx = _build_fake_tx({
291             url => $key,
292             body => $value,
293             code => $HTTP_OK,
294             method => 'FILE'
295             });
296              
297 1         6 $self->logger->debug("Set cache key: $key");
298 1         615 $self->cache_agent->set($key, _serialize_tx($fake_tx));
299 1         1826 return $key;
300             }
301              
302             sub is_valid {
303 4     4 0 2663 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         704 return $self->cache_agent->is_valid($key);
309             }
310              
311             sub is_cacheable {
312 133     133 0 1010 my ($self, $url) = @_;
313              
314 133   66     344 return $self->cache_agent && ($url !~ m{ \A / }gmx);
315             }
316              
317             sub generate_key {
318 113     113 1 8077 my ($self, $url, @opts) = @_;
319              
320 113         371 return $self->key_generator->($self, $url, @opts);
321             }
322              
323             sub key_generator_cb {
324 113     113 0 1167 my ($self, $url, @opts) = @_;
325              
326 113 100       324 my $key = join q{,}, $self->sort_query($url), (@opts ? to_json(@opts > 1 ? \@opts : $opts[0]) : ());
    100          
327              
328 113         1741 return $key;
329             }
330              
331             sub is_considered_error {
332 13     13 0 36 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     43 if ( $tx->error && $self->accepted_error_codes ) {
336 2 50       44 my $codes = ref $self->accepted_error_codes ? $self->accepted_error_codes
337             : [ ( $self->accepted_error_codes ) ];
338 2 50   2   24 return if List::Util::first { $tx->error->{code} == $_ } @{$codes};
  2         7  
  2         9  
339             }
340              
341 11         192 return $tx->error;
342             }
343              
344             sub sort_query {
345 119     119 1 3867 my ($self, $url) = @_;
346 119 50       291 return $url unless $self->sorted_queries;
347              
348 119 100       996 $url = Mojo::URL->new($url) unless ref $url eq 'Mojo::URL';
349              
350 119 100       9065 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   31 $flattened_sorted_url .= '?' . join '&', sort { $a cmp $b } List::Util::pairmap { (($b ne '') ? (join '=', $a, $b) : $a); } @{ $url->query }
  21         466  
  14         1605  
356 119 100       11134 if scalar @{ $url->query };
  119         374  
357              
358 119         3740 return $flattened_sorted_url;
359             }
360              
361             sub _serialize_tx {
362 10     10   1378 my ($tx) = @_;
363              
364 10         36 $tx->res->headers->header('X-Mojo-UserAgent-Cached', time);
365              
366             return {
367 10         503 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   78 my ($opts) = @_;
378              
379             # Create transaction object to return so we look like a regular request
380 28         123 my $tx = Mojo::Transaction::HTTP->new();
381              
382 28         182 $tx->req->method($opts->{method});
383 28         517 $tx->req->url(Mojo::URL->new($opts->{url}));
384              
385 28         5988 $tx->res->headers->from_hash($opts->{headers});
386              
387 28         3227 my $now = time;
388 28   66     75 $tx->res->headers->header('X-Mojo-UserAgent-Cached-Age', $now - ($tx->res->headers->header('X-Mojo-UserAgent-Cached') || $now));
389              
390 28         1844 $tx->res->code($opts->{code});
391 28         305 $tx->res->{json} = $opts->{json};
392 28         136 $tx->res->body($opts->{body});
393              
394 28         1469 $tx->{events} = $opts->{events};
395 28         92 $tx->req->{events} = $opts->{req_events};
396 28         143 $tx->res->{events} = $opts->{res_events};
397              
398 28         132 return $tx;
399             }
400              
401             sub _parse_local_file_res {
402 12     12   28 my ($self, $url) = @_;
403              
404 12         18 my $headers;
405 12         72 my $body = Mojo::File->new($url)->slurp;
406 10         1260 my $code = $HTTP_OK;
407 10         63 my $msg = 'OK';
408              
409 10 100       75 if ($body =~ m{\A (?: DELETE | GET | HEAD | OPTIONS | PATCH | POST | PUT ) \s }gmx) {
410 2         11 my $code_msg_headers;
411             my $code_msg;
412 2         0 my $http;
413 2         0 my $msg;
414 2         37 (undef, $code_msg_headers, $body) = split m{(?:\r\n|\n){2,}}mx, $body, 3; ## no critic (ProhibitMagicNumbers)
415 2         19 ($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         17 $headers = Mojo::Headers->new->parse("$headers\n\n")->to_hash;
419             }
420              
421 10         437 return { body => $body, code => $code, message => $msg, headers => $headers };
422             }
423              
424             sub _write_local_file_res {
425 100     100   355 my ($self, $tx, $dir) = @_;
426              
427 100 0 33     359 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   246 my ($self, $tx, $opts) = @_;
448              
449 100         507 $self->_write_local_file_res($tx, $ENV{MUAC_CLIENT_WRITE_LOCAL_FILE_RES_DIR});
450              
451 100         366 my $callers = $self->_get_stacktrace;
452 100         1418 my $created_stacktrace = $self->created_stacktrace;
453              
454             # Remove common parts to get smaller created stacktrace
455 100         1048 my $strings = Algorithm::LCSS::CSS_Sorted( [ split /,/, $callers ] , [ split /,/, $created_stacktrace ] );
456             map {
457 24         46 my @lcss = @{$_};
  24         75  
458 24         101 my $pat = join ",", @lcss[1..$#lcss-1];
459 24 50       84 if (scalar @lcss > 2) { $created_stacktrace =~ s{$pat}{,}mx }
  24         308  
460 100 50       14636 } @{ $strings || [] };
  100         329  
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     354 ($tx->res->code || $tx->res->error->{code} || $tx->res->error->{message}),
466             $callers, $created_stacktrace
467             )));
468              
469 100 50       64506 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   309 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   107266 frame_filter => sub { ($_[0]->{caller}->[0] !~ m{ \A Mojo | Try }gmx) },
502 137         1286 )->frames() );
503              
504 137         10576 my $prev_package = '';
505             my $callers = join q{,}, map {
506 299         1566 my $package = $_->package;
507 299 50       1869 if ($package eq 'Template::Provider') {
508 0         0 $package = (join "/", grep { $_ } (split '/', $_->filename)[-3..-1]);
  0         0  
509             }
510 299 100       703 if ($prev_package eq $package) {
511 42         104 $package = '';
512             } else {
513 257         438 $prev_package = $package;
514 257         1037 $package =~ s/(?:(\w)\w*::)/$1./gmx;
515 257         569 $package .= ':';
516             }
517 299         682 $package . $_->line();
518 137         327 } grep { $_ } @frames;
  299         613  
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