File Coverage

blib/lib/Mojolicious/Plugin/AssetPack/Store.pm
Criterion Covered Total %
statement 58 147 39.4
branch 12 68 17.6
condition 5 21 23.8
subroutine 11 20 55.0
pod 5 5 100.0
total 91 261 34.8


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::AssetPack::Store;
2 11     11   67 use Mojo::Base 'Mojolicious::Static';
  11         21  
  11         59  
3              
4 11     11   1532 use Mojo::File 'path';
  11         24  
  11         508  
5 11     11   67 use Mojo::URL;
  11         24  
  11         71  
6 11     11   250 use Mojolicious::Types;
  11         22  
  11         78  
7 11     11   284 use Mojolicious::Plugin::AssetPack::Asset;
  11         24  
  11         75  
8 11     11   285 use Mojolicious::Plugin::AssetPack::Util qw(diag checksum has_ro DEBUG);
  11         26  
  11         599  
9              
10 11     11   76 use constant CACHE_DIR => 'cache';
  11         23  
  11         928  
11              
12             # MOJO_ASSETPACK_DB_FILE is used in tests
13 11   100 11   73 use constant DB_FILE => $ENV{MOJO_ASSETPACK_DB_FILE} || 'assetpack.db';
  11         21  
  11         26010  
14             our %DB_KEYS = map { $_ => 1 } qw(checksum format minified rel);
15              
16             has asset_class => 'Mojolicious::Plugin::AssetPack::Asset';
17             has default_headers => sub { +{"Cache-Control" => "max-age=31536000"} };
18              
19             has _types => sub {
20             my $t = Mojolicious::Types->new;
21             $t->type(eot => 'application/vnd.ms-fontobject');
22             $t->type(otf => 'application/font-otf');
23             $t->type(ttf => 'application/font-ttf');
24             $t->type(woff2 => 'application/font-woff2');
25             delete $t->mapping->{$_} for qw(atom bin htm html txt xml zip);
26             $t;
27             };
28              
29             has_ro 'ua';
30              
31             has_ro _db => sub {
32             my $self = shift;
33             my ($db, $key, $url) = ({});
34             for my $path (reverse map { path($_, DB_FILE) } @{$self->paths}) {
35             open my $DB, '<', $path or next;
36             while (my $line = <$DB>) {
37             ($key, $url) = ($1, $2) if $line =~ /^\[([\w-]+):(.+)\]$/;
38             $db->{$url}{$key}{$1} = $2 if $key and $line =~ /^(\w+)=(.*)/ and $DB_KEYS{$1};
39             }
40             }
41             return $db;
42             };
43              
44             sub asset {
45 20     20 1 171 my ($self, $urls, $paths) = @_;
46 20         41 my $asset;
47              
48 20 50       74 for my $url (ref $urls eq 'ARRAY' ? @$urls : ($urls)) {
49 20 50       35 for my $path (@{$paths || $self->paths}) {
  20         148  
50 20 50       162 next unless $path =~ m!^https?://!;
51 0         0 my $abs = Mojo::URL->new($path);
52 0         0 $abs->path->merge($url);
53 0 0       0 return $asset if $asset = $self->_already_downloaded($abs);
54             }
55             }
56              
57 20 50       192 for my $url (ref $urls eq 'ARRAY' ? @$urls : ($urls)) {
58 20 50 33     77 return $asset
59             if $url =~ m!^https?://! and $asset = $self->_download(Mojo::URL->new($url));
60              
61 20 50       49 for my $path (@{$paths || $self->paths}) {
  20         85  
62 20 50       124 if ($path =~ m!^https?://!) {
63 0         0 my $abs = Mojo::URL->new($path);
64 0         0 $abs->path->merge($url);
65 0 0       0 return $asset if $asset = $self->_download($abs);
66             }
67             else {
68 20         155 local $self->{paths} = [$path];
69 20 100       93 next unless $asset = $self->file($url);
70 18         1936 return $self->asset_class->new(url => $url, content => $asset);
71             }
72             }
73             }
74              
75 2         217 return undef;
76             }
77              
78             sub load {
79 0     0 1 0 my ($self, $attrs) = @_;
80 0 0       0 my $db_attr = $self->_db_get($attrs) or return undef;
81 0         0 my @rel = $self->_cache_path($attrs);
82 0         0 my $asset = $self->asset(join '/', @rel);
83              
84 0 0       0 return undef unless $asset;
85 0 0       0 return undef unless $db_attr->{checksum} eq $attrs->{checksum};
86 0         0 diag 'Load "%s" = 1', $asset->path || $asset->url if DEBUG;
87 0         0 return $asset;
88             }
89              
90             sub persist {
91 10     10 1 61 my $self = shift;
92 10         46 my $db = $self->_db;
93 10         39 my $path = path($self->paths->[0], DB_FILE);
94 10         329 my @db_keys = sort keys %DB_KEYS;
95 10         24 my $DB;
96              
97 10 100       64 unless (open $DB, '>', $path) {
98 2         27 diag 'Save "%s" = 0 (%s)', $path, $! if DEBUG;
99 2         8 return $self;
100             }
101              
102 8         755 diag 'Save "%s" = 1', $path if DEBUG;
103 8         58 for my $url (sort keys %$db) {
104 0         0 for my $key (sort keys %{$db->{$url}}) {
  0         0  
105 0 0       0 Carp::confess("Invalid key '$key'. Need to be [a-z-].") unless $key =~ /^[\w-]+$/;
106 0         0 printf $DB "[%s:%s]\n", $key, $url;
107 0         0 for my $attr (@db_keys) {
108 0 0       0 next unless defined $db->{$url}{$key}{$attr};
109 0         0 printf $DB "%s=%s\n", $attr, $db->{$url}{$key}{$attr};
110             }
111             }
112             }
113              
114 8         128 return $self;
115             }
116              
117             sub save {
118 0     0 1 0 my ($self, $ref, $attrs) = @_;
119 0         0 my $path = path($self->paths->[0], $self->_cache_path($attrs));
120 0         0 my $dir = $path->dirname;
121              
122             # Do not care if this fail. Can fallback to temp files.
123 0 0 0     0 mkdir $dir if !-d $dir and -w $dir->dirname;
124 0         0 diag 'Save "%s" = %s', $path, -d $dir ? 1 : 0 if DEBUG;
125              
126 0 0       0 return $self->asset_class->new(%$attrs, content => $$ref) unless -w $dir;
127              
128 0         0 $path->spurt($$ref);
129 0         0 $self->_db_set(%$attrs);
130 0         0 return $self->asset_class->new(%$attrs, path => $path);
131             }
132              
133             sub serve_asset {
134 18     18 1 186 my ($self, $c, $asset) = @_;
135 18         94 my $d = $self->default_headers;
136 18         103 my $h = $c->res->headers;
137 18   100     347 my $ct = $self->_types->type($asset->format) || 'application/octet-stream';
138              
139 18         456 $h->header($_ => $d->{$_}) for keys %$d;
140 18         534 $h->content_type($ct);
141 18 50       301 $self->SUPER::serve_asset($c, $asset->can('asset') ? $asset->asset : $asset);
142 18         5686 $self;
143             }
144              
145             sub _already_downloaded {
146 0     0     my ($self, $url) = @_;
147 0           my $asset = $self->asset_class->new(url => "$url");
148 0           my @dirname = $self->_url2path($url, '');
149 0           my $basename = pop @dirname;
150              
151 0           for my $path (map { path $_, @dirname } @{$self->paths}) {
  0            
  0            
152              
153             # URL with extension
154 0           my $file = $path->child($basename);
155 0 0 0       return $asset->format($1)->path($file) if -e $file and $file =~ m!\.(\w+)$!;
156              
157             # URL without extension - https://fonts.googleapis.com/css?family=Roboto
158 0           for my $file ($path->list->each) {
159 0 0         next unless $file->basename =~ /^$basename(\w+)$/;
160 0           return $asset->format($1)->path($file);
161             }
162             }
163              
164 0           return undef;
165             }
166              
167             sub _cache_path {
168 0     0     my ($self, $attrs) = @_;
169             return (
170             CACHE_DIR, sprintf '%s-%s.%s%s',
171             $attrs->{name},
172             checksum($attrs->{url}),
173             $attrs->{minified} ? 'min.' : '',
174             $attrs->{format}
175 0 0         );
176             }
177              
178             sub _db_get {
179 0     0     my ($self, $attrs) = @_;
180 0           my $db = $self->_db;
181 0 0         return undef unless my $data = $db->{$attrs->{url}};
182 0 0         return undef unless $data = $data->{$attrs->{key}};
183 0           return {%$attrs, %$data};
184             }
185              
186             sub _db_set {
187 0 0   0     return if $ENV{MOJO_ASSETPACK_LAZY};
188 0           my ($self, %attrs) = @_;
189 0           my ($key, $url) = @attrs{qw(key url)};
190 0           $self->_db->{$url}{$key} = {%attrs};
191             }
192              
193             sub _download {
194 0     0     my ($self, $url) = @_;
195 0           my %attrs = (url => $url->clone);
196 0           my ($asset, $path);
197              
198 0 0         if ($attrs{url}->host eq 'local') {
199 0           my $base = $self->ua->server->url;
200 0           $url = $url->clone->scheme($base->scheme)->host_port($base->host_port);
201             }
202              
203             return $asset
204 0 0 0       if $attrs{url}->host ne 'local' and $asset = $self->_already_downloaded($url);
205              
206 0           my $tx = $self->ua->get($url);
207 0           my $h = $tx->res->headers;
208              
209 0 0         if (my $err = $tx->error) {
210 0           $self->_log->warn("[AssetPack] Unable to download $url: $err->{message}");
211 0           return undef;
212             }
213              
214 0   0       my $ct = $h->content_type || '';
215 0 0         if ($ct ne 'text/plain') {
216 0           $ct =~ s!;.*$!!;
217 0           $attrs{format} = $self->_types->detect($ct)->[0];
218             }
219              
220 0 0 0       $attrs{format} ||= $tx->req->url->path->[-1] =~ /\.(\w+)$/ ? $1 : 'bin';
221              
222 0 0         if ($attrs{url}->host ne 'local') {
223 0           $path = path($self->paths->[0], $self->_url2path($attrs{url}, $attrs{format}));
224 0           $self->_log->info(qq(Caching "$url" to "$path".));
225 0 0         $path->dirname->make_path unless -d $path->dirname;
226 0           $path->spurt($tx->res->body);
227             }
228              
229 0           $attrs{url} = "$attrs{url}";
230 0 0         return $self->asset_class->new(%attrs, path => $path) if $path;
231 0           return $self->asset_class->new(%attrs)->content($tx->res->body);
232             }
233              
234 0     0     sub _log { shift->ua->server->app->log }
235              
236             sub _url2path {
237 0     0     my ($self, $url, $format) = @_;
238 0           my $query = $url->query->to_string;
239 0           my @path;
240              
241 0           push @path, $url->host;
242 0           push @path, @{$url->path};
  0            
243              
244 0           $query =~ s!\W!_!g;
245 0 0         $path[-1] .= "_$query.$format" if $query;
246              
247 0           return CACHE_DIR, @path;
248             }
249              
250             1;
251              
252             =encoding utf8
253              
254             =head1 NAME
255              
256             Mojolicious::Plugin::AssetPack::Store - Storage for assets
257              
258             =head1 SYNOPSIS
259              
260             use Mojolicious::Lite;
261              
262             # Load plugin and pipes in the right order
263             plugin AssetPack => {pipes => \@pipes};
264              
265             # Change where assets can be found
266             app->asset->store->paths([
267             app->home->rel_file("some/directory"),
268             "/some/other/directory",
269             ]);
270              
271             # Change where assets are stored
272             app->asset->store->paths->[0] = app->home->rel_file("some/directory");
273              
274             # Define asset
275             app->asset->process($moniker => @assets);
276              
277             # Retrieve a Mojolicious::Plugin::AssetPack::Asset object
278             my $asset = app->asset->store->asset("some/file.js");
279              
280             =head1 DESCRIPTION
281              
282             L is an object to manage cached
283             assets on disk.
284              
285             The idea is that a L object can store
286             an asset after it is processed. This will speed up development, since only
287             changed assets will be processed and it will also allow processing tools to
288             be optional in production environment.
289              
290             This module will document meta data about each asset which is saved to disk, so
291             it can be looked up later as a unique item using L.
292              
293             =head1 ATTRIBUTES
294              
295             L inherits all attributes from
296             L implements the following new ones.
297              
298             =head2 asset_class
299              
300             $str = $self->asset_class;
301             $self = $self->asset_class("Mojolicious::Plugin::AssetPack::Asset");
302              
303             Holds the classname of which new assets will be constructed from.
304              
305             =head2 default_headers
306              
307             $hash_ref = $self->default_headers;
308             $self = $self->default_headers({"Cache-Control" => "max-age=31536000"});
309              
310             Used to set default headers used by L.
311              
312             =head2 paths
313              
314             $paths = $self->paths;
315             $self = $self->paths([$app->home->rel_file("assets")]);
316              
317             See L for details.
318              
319             =head2 ua
320              
321             $ua = $self->ua;
322              
323             See L.
324              
325             =head1 METHODS
326              
327             L inherits all attributes from
328             L implements the following new ones.
329              
330             =head2 asset
331              
332             $asset = $self->asset($url, $paths);
333              
334             Returns a L object or undef unless
335             C<$url> can be found in C<$paths>. C<$paths> default to
336             L. C<$paths> and C<$url> can be...
337              
338             =over 2
339              
340             =item * http://example.com/foo/bar
341              
342             An absolute URL will be downloaded from web, unless the host is "local":
343             "local" is a special host which will run the request through the current
344             L application.
345              
346             =item * foo/bar
347              
348             An relative URL will be looked up using L.
349              
350             =back
351              
352             Note that assets from web will be cached locally, which means that you need to
353             delete the files on disk to download a new version.
354              
355             =head2 load
356              
357             $bool = $self->load($asset, \%attr);
358              
359             Used to load an existing asset from disk. C<%attr> will override the
360             way an asset is looked up. The example below will ignore
361             L and rather use
362             the value from C<%attr>:
363              
364             $bool = $self->load($asset, {minified => $bool});
365              
366             =head2 persist
367              
368             $self = $self->persist;
369              
370             Used to save the internal state of the store to disk.
371              
372             This method is EXPERIMENTAL, and may change without warning.
373              
374             =head2 save
375              
376             $bool = $self->save($asset, \%attr);
377              
378             Used to save an asset to disk. C<%attr> are usually the same as
379             L and used to document metadata
380             about the C<$asset> so it can be looked up using L.
381              
382             =head2 serve_asset
383              
384             Override L with the functionality to set
385             response headers first, from L.
386              
387             =head1 SEE ALSO
388              
389             L.
390              
391             =cut