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   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