File Coverage

blib/lib/File/Assets.pm
Criterion Covered Total %
statement 273 297 91.9
branch 95 146 65.0
condition 50 95 52.6
subroutine 41 44 93.1
pod 18 24 75.0
total 477 606 78.7


line stmt bran cond sub pod time code
1             package File::Assets;
2              
3 23     23   1357754 use warnings;
  23         64  
  23         822  
4 23     23   116 use strict;
  23         92  
  23         2511  
5              
6             =head1 NAME
7              
8             File::Assets - Manage .css and .js assets for a web page or application
9              
10             =head1 VERSION
11              
12             Version 0.064
13              
14             =cut
15              
16             our $VERSION = '0.064';
17              
18             =head1 SYNOPSIS
19              
20             use File::Assets
21              
22             my $assets = File::Assets->new( base => [ $uri_root, $dir_root ] )
23              
24             # Put minified files in $dir_root/built/... (the trailing slash is important)
25             $assets->set_output_path("built/")
26              
27             # File::Assets will automatically detect the type based on the extension
28             $assets->include("/static/style.css")
29              
30             # You can also include external assets:
31             $assets->include("http://ajax.googleapis.com/ajax/libs/jquery/1.2.6/jquery.min.js");
32              
33             # This asset won't get included twice, as File::Assets will ignore repeats of a path
34             $assets->include("/static/style.css")
35              
36             # And finally ...
37             $assets->export
38              
39             # Or you can iterate (in order)
40             for my $asset ($assets->exports) {
41            
42             print $asset->uri, "\n";
43              
44             }
45              
46             In your .tt (Template Toolkit) files:
47              
48             [% WRAPPER page.tt %]
49              
50             [% assets.include("/static/special-style.css", 100) %] # The "100" is the rank, which makes sure it is exported after other assets
51              
52             [% asset = BLOCK %]
53             <style media="print">
54             body { font: serif; }
55             </style>
56             [% END %]
57             [% assets.include(asset) %] # This will include the css into an inline asset with the media type of "print"
58              
59             # ... finally, in your "main" template:
60              
61             [% CLEAR -%]
62             <html>
63              
64             <head>
65             [% assets.export("css") %]
66             </head>
67              
68             <body>
69              
70             [% content %]
71              
72             <!-- Generally, you want to include your JavaScript assets at the bottom of your html -->
73              
74             [% assets.export("js") %]
75              
76             </body>
77              
78             </html>
79              
80             Use the minify option to perform minification before export
81              
82             my $assets = File::Assets->new( minify => 1, ... )
83              
84             =head1 DESCRIPTION
85              
86             File::Assets is a tool for managing JavaScript and CSS assets in a (web) application. It allows you to "publish" assests in one place after having specified them in different parts of the application (e.g. throughout request and template processing phases).
87              
88             This package has the added bonus of assisting with minification and filtering of assets. Support is built-in for YUI Compressor (L<http://developer.yahoo.com/yui/compressor/>), L<JavaScript::Minifier>, L<CSS::Minifier>, L<JavaScript::Minifier::XS>, and L<CSS::Minifier::XS>.
89              
90             File::Assets was built with L<Catalyst> in mind, although this package is framework agnostic. Look at L<Catalyst::Plugin::Assets> for an easy way to integrate File::Assets with Catalyst.
91              
92             =head1 USAGE
93              
94             =head2 Cascading style sheets and their media types
95              
96             A cascading style sheet can be one of many different media types. For more information, look here: L<http://www.w3.org/TR/REC-CSS2/media.html>
97              
98             This can cause a problem when minifying, since, for example, you can't bundle a media type of screen with a media type of print. File::Assets handles this situation by treating .css files of different media types separately.
99              
100             To control the media type of a text/css asset, you can do the following:
101              
102             $assets->include("/path/to/printstyle.css", ..., { media => "print" }); # The asset will be exported with the print-media indicator
103              
104             $assets->include_content($content, "text/css", ..., { media => "screen" }); # Ditto, but for the screen type
105              
106             =head2 Including assets in the middle of processing a Template Toolkit template
107              
108             Sometimes, in the middle of a TT template, you want to include a new asset. Usually you would do something like this:
109              
110             [% assets.include("/include/style.css") %]
111              
112             But then this will show up in your output, because ->include returns an object:
113              
114             File::Assets::Asset=HASH(0x99047e4)
115              
116             The way around this is to use the TT "CALL" directive, as in the following:
117              
118             [% CALL assets.include("/include/style.css") %]
119              
120             =head2 Avoid minifying assets on every request (if you minify)
121              
122             By default, File::Assets will avoid re-minifying assets if nothing in the files have changed. However, in a web application, this can be a problem if you serve up two web pages that have different assets. That's because File::Assets will detect different assets being served in page A versus assets being served in page B (think AJAX interface vs. plain HTML with some CSS). The way around this problem is to name your assets object with a unique name per assets bundle. By default, the name is "assets", but can be changed with $assets->name(<a new name>):
123              
124             my $assets = File::Assets->new(...);
125             $assets->name("standard");
126              
127             You can change the name of the assets at anytime before exporting.
128              
129             =head2 YUI Compressor 2.2.5 is required
130              
131             If you want to use the YUI Compressor, you should have version 2.2.5 or above.
132              
133             YUI Compressor 2.1.1 (and below) will *NOT WORK*
134              
135             To use the compressor for minification specify the path to the .jar like so:
136              
137             my $assets = File::Assets->new( minify => "/path/to/yuicompressor.jar", ... )
138              
139             =head2 Specifying an C<output_path> pattern
140              
141             When aggregating or minifying assets, you need to put the result in a new file.
142              
143             You can use the following directives when crafting a path/filename pattern:
144              
145             %n The name of the asset, "assets" by default
146             %e The extension of the asset (e.g. css, js)
147             %f The fingerprint of the asset collection (a hexadecimal digest of the concatenated digest of each asset in the collection)
148             %k The kind of the asset (e.g. css-screen, css, css-print, js)
149             %h The kind head-part of the asset (e.g. css, js)
150             %l The kind tail-part of the asset (e.g. screen, print) (essentially the media type of a .css asset)
151              
152             In addition, in each of the above, a ".", "/" or "-" can be placed in between the "%" and directive character.
153             This will result in a ".", "/", or "-" being prepended to the directive value.
154              
155             The default pattern is:
156              
157             %n%-l%-f.%e
158              
159             A pattern of C<%n%-l.%e> can result in the following:
160              
161             assets.css # name of "assets", no media type, an asset type of CSS (.css)
162             assets-screen.css # name of "assets", media type of "screen", an asset type of CSS (.css)
163             assets.js # name of "assets", an asset type of JavaScript (.js)
164              
165             If the pattern ends with a "/", then the default pattern will be appended
166              
167             xyzzy/ => xyzzy/%n%-l-%f.%e
168              
169             If the pattern does not have an extension-like ending, then "%.e" will be appended
170              
171             xyzzy => xyzzy.%e
172              
173             =head2 Strange output or "sticky" content
174              
175             File::Assets uses built-in caching to share content across different objects (via File::Assets::Cache). If you're having problems
176             try disabling the cache by passing "cache => 0" to File::Assets->new
177              
178             =head1 METHODS
179              
180             =cut
181              
182             # If the pattern does NOT begin with a "/", then the base dir will be prepended
183              
184 23     23   129 use strict;
  23         50  
  23         720  
185 23     23   124 use warnings;
  23         39  
  23         963  
186              
187 23     23   22069 use Object::Tiny qw/cache registry _registry_hash rsc filter_scheme output_path_scheme output_asset_scheme/;
  23         11343  
  23         149  
188 23     23   20482 use File::Assets::Carp;
  23         87  
  23         171  
189              
190 23     23   32718 use Tie::LLHash;
  23         44037  
  23         924  
191 23     23   23280 use Path::Resource;
  23         2537032  
  23         511  
192 23     23   963 use Scalar::Util qw/blessed refaddr/;
  23         37  
  23         1326  
193 23     23   22124 use HTML::Declare qw/LINK SCRIPT STYLE/;
  23         263811  
  23         3385  
194              
195 23     23   28626 use File::Assets::Asset;
  23         91  
  23         244  
196 23     23   14981 use File::Assets::Cache;
  23         67  
  23         226  
197 23     23   13523 use File::Assets::Kind;
  23         69  
  23         223  
198 23     23   13767 use File::Assets::Bucket;
  23         62  
  23         206  
199              
200             =head2 File::Assets->new( base => <base>, output_path => <output_path>, minify => <minify> )
201              
202             Create and return a new File::Assets object.
203              
204             You can configure the object with the following:
205            
206             base # A hash reference with a "uri" key/value and a "dir" key/value.
207             For example: { uri => http://example.com/assets, dir => /var/www/htdocs/assets }
208            
209             # A URI::ToDisk object
210              
211             # A Path::Resource object
212              
213             minify # "1" or "best" - Will either use JavaScript::Minifier::XS> & CSS::Minifier::XS or
214             JavaScript::Minifier> & CSS::Minifier (depending on availability)
215             for minification
216              
217             # "0" or "" or undef - Don't do any minfication (this is the default)
218              
219             # "./path/to/yuicompressor.jar" - Will use YUI Compressor via the given .jar for minification
220              
221             # "minifier" - Will use JavaScript::Minifier & CSS::Minifier for minification
222              
223             # "xs" or "minifier-xs" - Will use JavaScript::Minifier::XS & CSS::Minifier::XS for minification
224              
225             output_path # Designates the output path for minified .css and .js assets
226             The default output path pattern is "%n%-l%-d.%e" (rooted at the dir of <base>)
227             See above in "Specifying an output_path pattern" for details
228              
229             =cut
230              
231             sub new {
232 36     36 1 700898 my $self = bless {}, shift;
233 36         269 local %_ = @_;
234              
235 36   33     650 $self->set_base($_{rsc} || $_{base_rsc} || $_{base});
236 36 50 0     261649 $self->set_base_uri($_{uri} || $_{base_uri}) if $_{uri} || $_{base_uri};
      33        
237 36 50 0     333 $self->set_base_dir($_{dir} || $_{base_dir}) if $_{dir} || $_{base_dir};
      33        
238 36 50       410 $self->set_base_path($_{base_path}) if $_{base_path};
239              
240 36   100     490 $self->set_output_path($_{output_path} || $_{output_path_scheme} || []);
241              
242 36         295 $self->name($_{name});
243            
244 36 50       281 $_{cache} = 1 unless exists $_{cache};
245 36 50       265 $self->set_cache($_{cache}) if $_{cache};
246              
247             # my $rsc = File::Assets::Util->parse_rsc($_{rsc} || $_{base_rsc} || $_{base});
248             # $rsc->uri($_{uri} || $_{base_uri}) if $_{uri} || $_{base_uri};
249             # $rsc->dir($_{dir} || $_{base_dir}) if $_{dir} || $_{base_dir};
250             # $rsc->path($_{base_path}) if $_{base_path};
251             # $self->{rsc} = $rsc;
252              
253 36         61 my %registry;
254 36         499 $self->{registry} = tie(%registry, qw/Tie::LLHash/, { lazy => 1 });
255 36         2370 $self->{_registry_hash} = \%registry;
256              
257 36         183 $self->{filter_scheme} = {};
258 36   100     575 my $filter_scheme = $_{filter} || $_{filters} || $_{filter_scheme} || [];
259 36         147 for my $rule (@$filter_scheme) {
260 5         24 $self->filter(@$rule);
261             }
262              
263 36 100       195 if (my $minify = $_{minify}) {
264 16 100 66     374 if ($minify eq 1 || $minify =~ m/^\s*(?:minifier-)?best\s*$/i) { $self->filter("minifier-best") }
  1 50       7  
    50          
    100          
    50          
    50          
265 0         0 elsif ($minify =~ m/^\s*yui-?compressor:/) { $self->filter($minify) }
266 0         0 elsif ($minify =~ m/\.jar/i) { $self->filter("yuicompressor:$minify") }
267 1         3 elsif ($minify =~ m/^\s*(?:minifier-)?xs\s*$/i) { $self->filter("minifier-xs") }
268 0         0 elsif ($minify =~ m/^\s*minifier\s*$/i) { $self->filter("minifier") }
269 14         70 elsif ($minify =~ m/^\s*concat\s*$/i) { $self->filter("concat") }
270 0         0 else { croak "Don't understand minify option ($minify)" }
271             }
272              
273 36         315 return $self;
274             }
275              
276             =head2 $asset = $assets->include(<path>, [ <rank>, <type>, { ... } ])
277              
278             =head2 $asset = $assets->include_path(<path>, [ <rank>, <type>, { ... } ])
279              
280             First, if <path> is a scalar reference or "looks like" some HTML (starts with a angle bracket, e.g.: <script></script>), then
281             it will be treated as inline content.
282              
283             Otherwise, this will include an asset located at "<base.dir>/<path>" for processing. The asset will be exported as "<base.uri>/<path>"
284              
285             Optionally, you can specify a rank, where a lower number (i.e. -2, -100) causes the asset to appear earlier in the exports
286             list, and a higher number (i.e. 6, 39) causes the asset to appear later in the exports list. By default, all assets start out
287             with a neutral rank of 0.
288              
289             Also, optionally, you can specify a type override as the third argument.
290              
291             By default, the newly created $asset is NOT inline.
292              
293             Returns the newly created asset.
294              
295             NOTE: See below for how the extra hash on the end is handled
296              
297             =head2 $asset = $assets->include({ ... })
298              
299             Another way to invoke include is by passing in a hash reference.
300              
301             The hash reference should contain the follwing information:
302            
303             path # The path to the asset file, relative to base
304             content # The content of the asset
305              
306             type # Optional if a path is given, required for content
307             rank # Optional, 0 by default (Less than zero is earlier, greater than zero is later)
308             inline # Optional, by default true if content was given, false is a path was given
309             base # Optional, by default the base of $assets
310              
311             You can also pass extra information through the hash. Any extra information will be bundled in the ->attributes hash of $asset.
312             For example, you can control the media type of a text/css asset by doing something like:
313              
314             $assets->include("/path/to/printstyle.css", ..., { media => "print" }) # The asset will be exported with the print-media indicator
315              
316             NOTE: The order of <rank> and <type> doesn't really matter, since we can detect whether something looks like a rank (number) or
317             not, and correct for it (and it does).
318              
319             =cut
320              
321             sub include_path {
322 0     0 1 0 my $self = shift;
323 0         0 return $self->include(@_);
324             }
325              
326             my $rankish = qr/^[\-\+]?[\.\d]+$/; # A regular expression for a string that looks like a rank
327             sub _correct_for_proper_rank_and_type_order ($) {
328 115     115   223 my $asset = shift;
329 115 50 66     1171 if (defined $asset->{type} && $asset->{type} =~ $rankish ||
      66        
      33        
330             defined $asset->{rank} && $asset->{rank} !~ $rankish) {
331             # Looks like someone entered a rank as the type or vice versa, so we'll switch them
332 0         0 my $rank = delete $asset->{type};
333 0         0 my $type = delete $asset->{rank};
334 0 0       0 $asset->{type} = $type if defined $type;
335 0 0       0 $asset->{rank} = $rank if defined $rank;
336             }
337             }
338              
339             sub include {
340 110     110 1 2081284 my $self = shift;
341              
342 110         273 my (@asset, $path);
343 110 50       405 if (ref $_[0] ne "HASH") {
344 110         218 $path = shift;
345 110 50 33     738 croak "Don't have a path to include" unless defined $path && length $path;
346 110 100 100     711 if (ref $path eq "SCALAR" || $path =~ m/^\s*</) {
347 3         11 push @asset, content => $path;
348             }
349             else {
350 107 100       357 return $self->fetch($path) if $self->exists($path);
351 106         1884 push @asset, path => $path;
352             }
353             }
354              
355 109         265 for (qw/rank type/) {
356 116 100 100     521 last if ! @_ || ref $_[0] eq "HASH";
357 8         21 push @asset, $_ => shift;
358             }
359 109 100 66     380 push @asset, %{ $_[0] } if @_ && ref $_[0] eq "HASH";
  4         16  
360 109         360 my %asset = @asset;
361 109         357 _correct_for_proper_rank_and_type_order \%asset;
362              
363 109         2857 my $asset = File::Assets::Asset->new(base => $self->rsc, cache => $self->cache, %asset);
364              
365 109         439 return $self->fetch_or_store($asset);
366             }
367              
368             =head2 $asset = $assets->include_content(<content>, [ <type>, <rank>, { ... } ])
369              
370             Include an asset with some content and of the supplied type. The value of <content> can be a "plain" string or a scalar reference.
371              
372             You can include content that looks like HTML:
373              
374             <style media="print">
375             body {
376             font: serif;
377             }
378             </style>
379              
380             In the above case, <type> is optional, as File::Assets can detect from the tag that you're supplying a style sheet. Furthermore,
381             the method will find all the attributes in the tag and put them into the asset. So the resulting asset from including the above
382             will have a type of "text/css" and media of "print".
383              
384             For now, only <style> and <script> will map to types (.css and .js, respectively)
385              
386             See ->include for more information on <rank>.
387              
388             By default, the newly created $asset is inline.
389              
390             Returns the newly created asset.
391              
392             NOTE: The order of the <type> and <rank> arguments are reversed from ->include and ->include_path
393             Still, the order of <rank> and <type> doesn't really matter, since we can detect whether something looks like a rank (number) or
394             not, and correct for it (and it does).
395              
396             =cut
397              
398             sub include_content {
399 6     6 1 1342 my $self = shift;
400              
401 6         11 my @asset;
402 6         14 for (qw/content type rank/) {
403 17 100 100     92 last if ! @_ || ref $_[0] eq "HASH";
404 11         30 push @asset, $_ => shift;
405             }
406 6 100 66     35 push @asset, %{ $_[0] } if @_ && ref $_[0] eq "HASH";
  2         5  
407 6         22 my %asset = @asset;
408 6         18 _correct_for_proper_rank_and_type_order \%asset;
409              
410 6         31 my $asset = File::Assets::Asset->new(%asset);
411              
412 6         22 $self->store($asset);
413              
414 6         210 return $asset;
415             }
416              
417             =head2 $name = $assets->name([ <name> ])
418              
419             Retrieve and/or change the "name" of $assets; by default it is "assets"
420              
421             This is useful for controlling the name of minified assets files.
422              
423             Returns the name of $assets
424              
425             =cut
426              
427             sub name {
428 93     93 1 3457 my $self = shift;
429 93 100       399 $self->{name} = shift if @_;
430 93         295 my $name = $self->{name};
431 93 100 66     582 return defined $name && length $name ? $name : "assets";
432             }
433              
434             =head2 $html = $assets->export([ <type> ])
435              
436             Generate and return HTML for the assets of <type>. If no type is specified, then assets of every type are exported.
437              
438             $html will be something like this:
439              
440             <link rel="stylesheet" type="text/css" href="http://example.com/assets.css">
441             <script src="http://example.com/assets.js" type="text/javascript"></script>
442              
443             =cut
444              
445             sub export {
446 60     60 1 6047786 my $self = shift;
447 60         154 my $type = shift;
448 60         114 my $format = shift;
449 60 50       249 $format = "html" unless defined $format;
450 60         304 my @assets = $self->exports($type);
451              
452 60 50       248 if ($format eq "html") {
453 60         270 return $self->_export_html(\@assets);
454             }
455             else {
456 0         0 croak "Don't know how to export for format ($format)";
457             }
458             }
459              
460             sub _export_html {
461 60     60   118 my $self = shift;
462 60         102 my $assets = shift;
463              
464 60         104 my @content;
465 60         163 for my $asset (@$assets) {
466 126         19237 my %attributes = %{ $asset->attributes };
  126         3997  
467 126 100 66     3373 if ($asset->type->type eq "text/css") {
    50 33        
468             # if ($asset->kind->extension eq "css") {
469 74 100       791 if (! $asset->inline) {
470 66         1699 push @content, LINK({ rel => "stylesheet", type => $asset->type->type, href => $asset->uri, %attributes });
471             }
472             else {
473 8         162 push @content, STYLE({ type => $asset->type->type, %attributes, _ => [ "\n${ $asset->content }" ] });
  8         115  
474             }
475             }
476             # elsif ($asset->kind->extension eq "js") {
477             elsif ($asset->type->type eq "application/javascript" ||
478             $asset->type->type eq "application/x-javascript" || # Handle different MIME::Types versions.
479             $asset->type->type =~ m/\bjavascript\b/) {
480 52 100       2096 if (! $asset->inline) {
481 50         203 push @content, SCRIPT({ type => "text/javascript", src => $asset->uri, _ => "", %attributes });
482             }
483             else {
484 2         20 push @content, SCRIPT({ type => "text/javascript", %attributes, _ => [ "\n${ $asset->content }" ] });
  2         7  
485             }
486             }
487              
488             else {
489 0 0       0 croak "Don't know how to handle asset $asset" unless ! $asset->inline;
490 0         0 push @content, LINK({ type => $asset->type->type, href => $asset->uri });
491             }
492             }
493 60         12440 return join "\n", @content;
494             }
495              
496             =head2 @assets = $assets->exports([ <type> ])
497              
498             Returns a list of assets, in ranking order, that are exported. If no type is specified, then assets of every type are exported.
499              
500             You can use this method to generate your own HTML, if necessary.
501              
502             =cut
503              
504             sub exports {
505 60     60 1 143 my $self = shift;
506 60         298 my @assets = sort { $a->rank <=> $b->rank } $self->_exports(@_);
  84         2508  
507 60         558 return @assets;
508             }
509              
510             =head2 $assets->empty
511              
512             Returns 1 if no assets have been included yet, 0 otherwise.
513              
514             =cut
515              
516             sub empty {
517 0     0 1 0 my $self = shift;
518 0 0       0 return keys %{ $self->_registry_hash } ? 0 : 1;
  0         0  
519             }
520              
521             =head2 $assets->exists( <path> )
522              
523             Returns true if <path> has been included, 0 otherwise.
524              
525             =cut
526              
527             sub exists {
528 216     216 1 7020 my $self = shift;
529 216         349 my $key = shift;
530              
531 216 100       6267 return exists $self->_registry_hash->{$key} ? 1 : 0;
532             }
533              
534             =head2 $assets->store( <asset> )
535              
536             Store <asset> in $assets
537              
538             =cut
539              
540             sub store {
541 115     115 1 219 my $self = shift;
542 115         183 my $asset = shift;
543              
544 115         2945 return $self->_registry_hash->{$asset->key} = $asset;
545             }
546              
547             =head2 $asset = $assets->fetch( <path> )
548              
549             Fetch the asset located at <path>
550              
551             Returns undef if nothing at <path> exists yet
552              
553             =cut
554              
555             sub fetch {
556 10     10 1 18903 my $self = shift;
557 10         21 my $key = shift;
558              
559 10         266 return $self->_registry_hash->{$key};
560             }
561              
562             sub fetch_or_store {
563 109     109 0 171 my $self = shift;
564 109         170 my $asset = shift;
565              
566 109 50       411 return $self->fetch($asset->key) if $self->exists($asset->key);
567              
568 109         2618 return $self->store($asset);
569             }
570              
571             sub kind {
572 188     188 0 1130 my $self = shift;
573 188         264 my $asset = shift;
574 188         4751 my $type = $asset->type;
575              
576 188         1214 my $kind = File::Assets::Util->type_extension($type);
577 188 100       1530 if (File::Assets::Util->same_type("css", $type)) {
578             # my $media = $asset->attributes->{media} || "screen"; # W3C says to assume screen by default, so we'll do the same.
579 126         4307 my $media = $asset->attributes->{media};
580 126 100 66     1106 $kind = "$kind-$media" if defined $media && length $media;
581             }
582              
583 188         1547 return File::Assets::Kind->new($kind, $type);
584             }
585              
586             sub _exports {
587 60     60   101 my $self = shift;
588 60         115 my $type = shift;
589 60         374 $type = File::Assets::Util->parse_type($type);
590 60         2124 my $hash = $self->_registry_hash;
591 60         286 my @assets;
592 60 100       213 if (defined $type) {
593 6         41 @assets = grep { $type->type eq $_->type->type } values %$hash;
  20         946  
594             }
595             else {
596 54         344 @assets = values %$hash;
597             }
598              
599 60         4964 my %bucket;
600 60         152 for my $asset (@assets) {
601 185         474 my $kind = $self->kind($asset);
602 185   66     4766 my $bucket = $bucket{$kind->kind} ||= File::Assets::Bucket->new($kind, $self);
603 185         1055 $bucket->add_asset($asset);
604             }
605              
606 60         179 my $filter_scheme = $self->{filter_scheme};
607 60 100       126 my @global = @{ $filter_scheme->{'*'} || [] };
  60         341  
608 60         134 my @bucket;
609 60         386 for my $kind (sort keys %bucket) {
610 100         277 push @bucket, my $bucket = $bucket{$kind};
611 100         331 $bucket->add_filter($_) for @global;
612 100         2708 my $head = $bucket->kind->head;
613 100         3123 for my $category (sort grep { ! m/^$head-/ } keys %$filter_scheme) {
  69         1049  
614 69 100       254 next if length $category > length $kind; # Too specific
615 61 100       366 next unless 0 == index $kind, $category;
616 11         20 $bucket->add_filter($_) for (@{ $filter_scheme->{$category} });
  11         67  
617             }
618             }
619              
620 60         165 return map { $_->exports } @bucket;
  100         407  
621             }
622              
623             =head2 $assets->set_name( <name> )
624              
625             Set the name of $assets
626              
627             This is exactly the same as
628              
629             $assets->name( <name> )
630              
631             =cut
632              
633              
634             =head2 $assets->set_base( <base> )
635              
636             Set the base uri, dir, and path for assets
637              
638             <base> can be a L<Path::Resource>, L<URI::ToDisk>, or a hash reference of the form:
639              
640             { uri => ..., dir => ..., path => ... }
641              
642             Given a dir of C</var/www/htdocs>, a uri of C<http://example.com/static>, and a
643             path of C<assets> then:
644              
645             $assets will look for files in "/var/www/htdocs/assets"
646              
647             $assets will "serve" files with "http://example.com/static/assets"
648              
649             =cut
650              
651             sub set_base {
652 39     39 1 3018 my $self = shift;
653 39 50       247 croak "No base given" unless @_;
654 39 100       188 my $base = 1 == @_ ? shift : { @_ };
655 39 50       170 croak "No base given" unless $base;
656              
657 39         428 $self->{rsc} = File::Assets::Util->parse_rsc($base);
658             }
659              
660             =head2 $assets->set_base_uri( <uri> )
661              
662             Set the base uri for assets
663              
664             =cut
665              
666             sub set_base_uri {
667 1     1 1 77 my $self = shift;
668 1 50       5 croak "No base uri given" unless defined $_[0];
669              
670 1         5 $self->{rsc}->base->uri(shift);
671             }
672              
673             =head2 $assets->set_base_dir( <dir> )
674              
675             Set the base dir for assets
676              
677             =cut
678              
679             sub set_base_dir {
680 1     1 1 117 my $self = shift;
681 1 50       7 croak "No base dir given" unless defined $_[0];
682              
683 1         9 $self->{rsc}->base->dir(shift);
684             }
685              
686             =head2 $assets->set_base_path( <path> )
687              
688             Set the base path for assets
689              
690             Passing an undefined value for <path> will clear/get-rid-of the path
691              
692             =cut
693              
694             sub set_base_path {
695 2     2 1 46 my $self = shift;
696 2         3 my $path;
697 2 50       28 $path = defined $_[0] ? Path::Abstract->new(shift) : Path::Abstract->new;
698             # TODO-b This is very bad
699 2         88 $self->{rsc}->_path($path);
700             }
701              
702             sub set_output_path_scheme {
703 40     40 0 2671 my $self = shift;
704 40         97 my $scheme = shift;
705              
706 40 100 66     338 if ($scheme && ref $scheme ne "ARRAY") {
707 11         49 $scheme = [ [ qw/*/ => $scheme ] ];
708             }
709              
710 40         208 $self->{output_path_scheme} = $scheme;
711             }
712              
713             =head2 $assets->set_output_path( <path> )
714              
715             Set the output path for assets generated by $assets
716              
717             See "Specifying an C<output_path> pattern" above
718              
719             =cut
720              
721             sub set_output_path {
722 38     38 1 220 my $self = shift;
723 38         176 $self->set_output_path_scheme(@_);
724             }
725              
726             =head2 $assets->set_cache( <cache> )
727              
728             Specify the cache object or cache name to use
729              
730             =cut
731              
732             sub set_cache {
733 36     36 1 144 my $self = shift;
734 36         77 my $cache = shift;
735              
736 36 50       132 if ($cache) {
737 36 50 33     953 $cache = File::Assets::Cache->new(name => $cache) unless blessed $cache && $cache->isa("File::Assets::Cache");
738 36         128 $self->{cache} = $cache;
739             }
740             else {
741 0         0 delete $self->{cache};
742             }
743             }
744              
745             sub filter {
746 28     28 0 11975 my $self = shift;
747 28         56 my ($kind, $filter);
748 28 100       107 if (@_ == 1) {
749 20         52 $filter = shift;
750             }
751             else {
752 8         72 $kind = File::Assets::Kind->new(shift);
753 8         21 $filter = shift;
754             }
755              
756 28 100       367 my $name = $kind ? $kind->kind : '*';
757              
758 28   100     278 my $category = $self->{filter_scheme}->{$name} ||= [];
759              
760 28         64 my $_filter = $filter;
761 28 100       171 unless (blessed $_filter) {
762 27 50       361 croak "Couldn't find filter for ($filter)" unless $_filter = File::Assets::Util->parse_filter($_filter, @_, assets => $self);
763             }
764              
765 28         91 push @$category, $_filter;
766              
767 28         214 return $_filter;
768             }
769              
770             sub filter_clear {
771 2     2 0 4241 my $self = shift;
772 2 100 66     40 if (blessed $_[0] && $_[0]->isa("File::Assets::Filter")) {
773 1         2 my $target = shift;
774 1         2 while (my ($name, $category) = each %{ $self->{filter_scheme} }) {
  3         19  
775 2         196 my @filters = grep { $_ != $target } @$category;
  2         8  
776 2         6 $self->{filter_scheme}->{$name} = \@filters;
777             }
778 1         4 return;
779             }
780 1 50 0     4 carp __PACKAGE__, "::filter_clear(\$type) is deprecated, nothing happens" and return if @_;
781 1         4 $self->{filter_scheme} = {};
782             }
783              
784             sub _calculate_best {
785 56     56   92 my $self = shift;
786 56         125 my $scheme = shift;
787 56         77 my $kind = shift;
788 56         114 my $signature = shift;
789 56         98 my $handler = shift;
790 56         91 my $default = shift;
791              
792 56         1362 my $key = join ":", $kind->kind, $signature;
793              
794 56         350 my ($best_kind, %return);
795 56 50       165 %return = %$default if $default;
796              
797             # TODO-f Cache the result of this
798 56         158 for my $rule (@$scheme) {
799 45         133 my ($condition, $action, $flags) = @$rule;
800              
801 45         106 my $result; # 1 - A better match; -1 - A match, but worse; undef - Skip, not a match!
802              
803 45 50       234 if (ref $condition eq "CODE") {
    50          
804 0 0       0 next unless defined ($result = $condition->($kind, $signature, $best_kind));
805             }
806             elsif (ref $condition eq "") {
807 45 50 66     258 if ($condition eq $key) {
    100          
808             # Best possible match
809 0         0 $result = 1;
810 0         0 $best_kind = $kind;
811             }
812             elsif ($condition eq "*" || $condition eq "default") {
813 44 50       118 $result = $best_kind ? -1 : 1;
814             }
815             }
816              
817 45         159 my ($condition_kind, $condition_signature) = split m/:/, $condition, 2;
818            
819 45 100       138 unless (defined $result) {
820              
821             # No exact match, try to find the best fit...
822              
823             # Signature doesn't match or is not a wildcard, so move on to the next rule
824 1 0 33     6 next if defined $condition_signature && $condition_signature ne '*' && $condition_signature ne $signature;
      33        
825              
826 1 50 33     7 if (length $condition_kind && $condition_kind ne '*') {
827 1         9 $condition_kind = File::Assets::Kind->new($condition_kind);
828              
829             # Type isn't the same as the asset (or whatever) kind, so move on to the next rule
830 1 50       30 next unless File::Assets::Util->same_type($condition_kind->type, $kind->type);
831             }
832             }
833              
834             # At this point, we have a match, but is it a better match then one we already have?
835 45 50 0     181 if (! $best_kind || ($condition_kind && $condition_kind->is_better_than($best_kind))) {
      33        
836 45         82 $result = 1;
837             }
838              
839 45 50       130 next unless defined $result;
840              
841 45         63 my %action;
842 45         123 %action = $handler->($action);
843              
844 45 50       144 if ($result > 0) {
845 45         341 $return{$_} = $action{$_} for keys %action;
846             }
847             else {
848 0         0 for (keys %action) {
849 0 0       0 $return{$_} = $action{$_} unless defined $action{$_};
850             }
851             }
852             }
853              
854 56         174 return \%return;
855             }
856              
857             sub output_path {
858 56     56 1 107 my $self = shift;
859 56         108 my $filter = shift;
860              
861             my $result = $self->_calculate_best($self->{output_path_scheme}, $filter->kind, $filter->signature, sub {
862 45     45   73 my $action = shift;
863 45 50       250 return ref $action eq "CODE" ? %$action : path => $action;
864 56         226 });
865              
866 56         375 return $result;
867             }
868              
869             sub output_asset {
870 56     56 0 100 my $self = shift;
871 56         105 my $filter = shift;
872              
873 56         75 if (0) {
874             my $result = $self->_calculate_best($self->{output_asset_scheme}, $filter->kind, $filter->signature, sub {
875 0     0     my $action = shift;
876 0           return %$action;
877             });
878             }
879              
880 56         270 my $kind = $filter->kind;
881 56 50       546 my $output_path = $self->output_path($filter) or croak "Couldn't get output path for ", $kind->kind;
882 56         334 $output_path = File::Assets::Util->build_output_path($output_path, $filter);
883              
884 56         1865 my $asset = File::Assets::Asset->new(path => $output_path, base => $self->rsc, type => $kind->type);
885 56         381 return $asset;
886             }
887              
888             1;
889              
890             =head1 AUTHOR
891              
892             Robert Krimen, C<< <rkrimen at cpan.org> >>
893              
894             =head1 SEE ALSO
895              
896             L<Catalyst::Plugin::Assets>
897              
898             L<Google::AJAX::Library>
899              
900             L<JS::YUI::Loader>
901              
902             L<JS::jQuery::Loader>
903              
904             =head1 SOURCE
905              
906             You can contribute or fork this project via GitHub:
907              
908             L<http://github.com/robertkrimen/file-assets/tree/master>
909              
910             git clone git://github.com/robertkrimen/file-assets.git File-Assets
911              
912             =head1 BUGS
913              
914             Please report any bugs or feature requests to C<bug-file-assets at rt.cpan.org>, or through
915             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-Assets>. I will be notified, and then you'll
916             automatically be notified of progress on your bug as I make changes.
917              
918             =head1 SUPPORT
919              
920             You can find documentation for this module with the perldoc command.
921              
922             perldoc File::Assets
923              
924              
925             You can also look for information at:
926              
927             =over 4
928              
929             =item * RT: CPAN's request tracker
930              
931             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Assets>
932              
933             =item * AnnoCPAN: Annotated CPAN documentation
934              
935             L<http://annocpan.org/dist/File-Assets>
936              
937             =item * CPAN Ratings
938              
939             L<http://cpanratings.perl.org/d/File-Assets>
940              
941             =item * Search CPAN
942              
943             L<http://search.cpan.org/dist/File-Assets>
944              
945             =back
946              
947              
948             =head1 ACKNOWLEDGEMENTS
949              
950              
951             =head1 COPYRIGHT & LICENSE
952              
953             Copyright 2008 Robert Krimen
954              
955             This program is free software; you can redistribute it and/or modify it
956             under the same terms as Perl itself.
957              
958              
959             =cut
960              
961             1; # End of File::Assets
962              
963             __END__
964              
965             # if (my $cache = $self->cache) {
966             # return 1 if $cache->exists($self->rsc->dir, $key);
967             # }
968              
969             # if (my $cache = $self->cache) {
970             # $cache->store($self->rsc->dir, $asset);
971             # }
972              
973             # if (my $cache = $self->cache) {
974             # if ($asset = $cache->fetch($self->rsc->dir, $key)) {
975             # return $self->store($asset);
976             # }
977             # }
978