File Coverage

File:lib/Catalyst/Controller/Combine.pm
Coverage:72.4%

linestmtbrancondsubpodtimecode
1package Catalyst::Controller::Combine;
2
3
7
7
7
1513
11
58
use Moose;
4# w/o BEGIN, :attrs will not work
5
7
23679
BEGIN { extends 'Catalyst::Controller' }
6
7
7
7
7
21654
8
96
use Path::Class ();
8
7
7
7
22
10
76
use File::stat;
9
7
7
7
395
6
291
use List::Util qw(max);
10
7
7
7
1362
4524
3840
use Text::Glob qw(match_glob);
11
12has dir => (is => 'rw',
13                  default => sub { 'static/' . shift->action_namespace },
14                  lazy => 1);
15has extension => (is => 'rw',
16                  default => sub { shift->action_namespace },
17                  lazy => 1);
18has depend => (is => 'rw',
19                  default => sub { return {} });
20has mimetype => (is => 'rw',
21                  default => sub {
22                                    my $ext = shift->extension;
23
24                                    return $ext eq 'js' ? 'application/javascript'
25                                         : $ext eq 'css' ? 'text/css'
26                                         : 'text/plain';
27                                 },
28                  lazy => 1);
29has replace => (is => 'rw',
30                  default => sub { {} },
31                  lazy => 1);
32has minifier => (is => 'rw',
33                  default => 'minify');
34has expire => (is => 'rw',
35                  default => 0);
36has expire_in => (is => 'rw',
37                  default => 60 * 60 * 24 * 365 * 3); # 3 years
38
39
40 - 160
=head1 NAME

Catalyst::Controller::Combine - Combine JS/CSS Files

=head1 SYNOPSIS

    # use the helper to create your Controller
    script/myapp_create.pl controller Js Combine

    # or:
    script/myapp_create.pl controller Css Combine

    # DONE. READY FOR USE.

    # Just use it in your template:
    # will deliver all JavaScript files concatenated (in Js-Controller)
    <script type="text/javascript" src="/js/file1/file2/.../filex.js"></script>

    # will deliver all CSS files concatenated (in Css-Controller)
    <link rel="stylesheet" type="text/css" href="/css/file1/file2/.../filex.css" />


    # in the generated controller you may add this to allow minification
    # the trick behind is the existence of a sub named 'minify'
    # inside your Controller.

    use JavaScript::Minifier::XS qw(minify);
        # or:
    use CSS::Minifier::XS qw(minify);


=head1 DESCRIPTION

Catalyst Controller that concatenates (and optionally minifies) static files
like JavaScript or CSS into a single request. Depending on your configuration,
files are also auto-added with a simple dependency-management.

The basic idea behind concatenation is that all files one Controller should
handle reside in a common directory.

Assuming you have a directory with JavaScript files like:

    root/static/js
     |
     +-- prototype.js
     |
     +-- helpers.js
     |
     +-- site.js

Then you could combine all files in a single tag (assuming your directory for
the Controller is set to 'static/js' -- which is the default):

    <script type="text/javascript" src="/js/prototype/helpers/site.js"></script>

If you add a dependency into your Controller's config like:

    __PACKAGE__->config(
        ...
        depend => {
            helpers => 'prototype',
            site    => 'helpers',
        },
        ...
    );

Now, the URI to retrieve the very same JavaScript files can be shortened:

    <script type="text/javascript" src="/js/site.js"></script>

=head1 CONFIGURATION

A simple configuration of your Controller could look like this:

    __PACKAGE__->config(
        # the directory to look for files
        # defaults to 'static/<<action_namespace>>'
        dir => 'static/js',

        # the (optional) file extension in the URL
        # defaults to action_namespace
        extension => 'js',

        # optional dependencies
        depend => {
            scriptaculous => 'prototype',
            builder       => 'scriptaculous',
            effects       => 'scriptaculous',
            dragdrop      => 'effects',
            slider        => 'scriptaculous',
            myscript      => [ qw(slider dragdrop) ],
        },

        # name of the minifying routine (defaults to 'minify')
        # will be used if present in the package
        minifier => 'minify',

        # should a HTTP expire header be set? This usually means, 
        # you have to change your filenames, if there a was change!
        expire => 1,

        # time offset (in seconds), in which the file will expire
        expire_in => 60 * 60 * 24 * 365 * 3, # 3 years

        # mimetype of response if wanted
        # will be guessed from extension if possible and not given
        # falls back to 'text/plain' if not guessable
        mimetype => 'application/javascript',
    );

=head2 CONFIGURATION OPTIONS

TODO: writeme...

=head1 METHODS

=head2 BUILD

constructor for this Moose-driven class

=cut
161
162sub BUILD {
163
13
1
33686
    my $self = shift;
164
13
103
    my $c = $self->_app;
165
166    ### THIS STUPID BLOCK BREAKS TESTS UNDER DIFFERENT C::MOP / MOOSE VERSIONS...
167    ### $self->dir wants to know action_namespace...
168    # $c->log->warn(ref($self) . " - directory '" . $self->dir . "' not present.")
169    # if (!-d $c->path_to('root', $self->dir));
170    #
171    # $c->log->debug(ref($self) . " - " .
172    # "directory: '" . $self->dir . "', " .
173    # "extension: '" . $self->extension . "', " .
174    # "mimetype: '" . $self->mimetype . "', " .
175    # "minifier: '" . $self->minifier . "'")
176    # if ($c->debug);
177}
178
179 - 207
=head2 do_combine :Action

the C<do_combine> Action-method may be used like this (eg in YourApp:Controller:Js):

    sub default :Path {
        my $self = shift;
        my $c = shift;

        $c->forward('do_combine');
    }

However, a predeclared C<default> method like this is already present -- see
below.

All files in the remaining URL will be concatenated to a single resulting
stream and optionally minified if a sub named 'minify' in your Controller's
package namespace exists.

Thus, inside your Controller a simple

    # for JavaScript you may do
    use JavaScript::Minifier::XS qw(minify);

    # for CSS quite similar:
    use CSS::Minifier::XS qw(minify);

will do the job and auto-minify the stream.

=cut
208
209sub do_combine :Action {
210
18
1
3360
    my $self = shift;
211
18
16
    my $c = shift;
212
213
18
51
    $self->_collect_files($c, @_);
214
215    #
216    # concatenate
217    #
218
17
19
    my $mtime = 0;
219
17
25
    my $response = '';
220
17
17
15
36
    foreach my $file_path (@{$self->{files}}) {
221
22
924
        if (open(my $file, '<', $file_path)) {
222
22
3085
            local $/ = undef;
223
22
417
            my $file_content = <$file>;
224
225            # do replacements if wanted
226
22
166
            if (exists($self->{replacement_for}->{$file_path})) {
227
0
0
                my @replacement = (
228                    # poor man's deep-copy
229
0
0
                    @{$self->{replacement_for}->{$file_path}}
230                );
231
0
0
                while (my ($regex, $replace) = splice(@replacement,0,2)) {
232
0
0
0
0
                    $file_content =~ s{$regex}{qq{qq{$replace}}}gmsee;
233                }
234            }
235
236            # append to output stream
237
22
1178
            $response .= $file_content;
238
22
266
            close($file);
239
22
149
            $mtime = max($mtime, (stat $file_path)->mtime);
240        }
241        # silently ignore any errors that might occur
242    }
243
244
17
2350
    die 'no files given for combining' if (!$mtime);
245
246    #
247    # deliver -- at least an empty line to make catalyst happy ;-)
248    #
249    my $minifier = $self->can($self->minifier)
250
17
15
119
195
        || sub { $_[0] }; # simple identity function
251
17
335
    $c->response->headers->content_type($self->mimetype)
252        if ($self->mimetype);
253
17
1592
    $c->response->headers->last_modified($mtime)
254        if ($mtime);
255
256
17
11765
    if ($self->{expire} && $self->{expire_in}) {
257
2
11
        $c->response->headers->expires(time() + $self->{expire_in});
258    }
259
260
17
259
    $c->response->body($minifier->($response) . "\n");
261
7
7
7
30
5
74
}
262
263 - 269
=head2 default :Path

a standard handler for your application's controller

maps to the path_prefix of your actual controller and consumes the entire URI

=cut
270
271sub default :Path {
272
11
1
85178
    my $self = shift;
273
11
20
    my $c = shift;
274
275
11
57
    $c->forward('do_combine');
276
7
7
7
30893
11
51
}
277
278 - 329
=head2 uri_for :Private

handle uri_for requests (not intentionally a Catalyst-feature :-) requires a
patched C<uri_for> method in your app! my one looks like the sub below.

If this method is used, the URI will only contain files that will not
automatically get added in by dependency resolution. Also, a simple
GET-parameter is added that reflects the unix-timestamp of the most resent
file that will be in the list of combined files. This helps the browser
to do proper caching even if files will change. Admittedly this is most of
the time needed during development.

    # in my app.pm:
    sub uri_for {
        my $c = shift;
        my $path = shift;
        my @args = @_;

        if (blessed($path) && $path->class && $path->class->can('uri_for')) {
            #
            # the path-argument was a component that can help
            # let the controller handle this for us
            #   believe me, it can do it!
            #
            return $c->component($path->class)->uri_for($c, $path, @args);
        }

        #
        # otherwise fall back into the well-known behavior
        #
        $c->next::method($path, @args);
    }

    # alternatively, using Catalyst 5.8 you may do this:
    around 'uri_for' => sub {
        my $orig = shift;
        my $c = shift;
        my $path = shift;
        my @args = @_;

        if (blessed($path) && $path->class && $path->class->can('uri_for')) {
            #
            # let the controller handle this for us
            #   believe me, it can do it!
            #
            return $c->component($path->class)->uri_for($c, $path, @args);
        }

        return $c->$orig($path, @args);
    };

=cut
330
331sub uri_for :Private {
332
7
1
336
    my $self = shift;
333
7
5
    my $c = shift;
334
7
7
    my $path = shift; # actually an action...
335
7
10
    my @args = @_;
336
337
7
35
    my $actual_path = $c->dispatcher->uri_for_action($path);
338
7
1111
    $actual_path = '/' if $actual_path eq '';
339
340    #
341    # generate max mtime as query value for the uri
342    #
343
7
52
    $self->_collect_files($c, @args);
344
7
11
7
6
481
10
    my $mtime = max map { (stat $_)->mtime } @{$self->{files}};
345
346    #
347    # get rid of redundancies as dependency rules will
348    # add them in at fulfilment of the real request...
349    #
350
7
11
7
799
28
10
    my @parts = grep {!$self->{seen}->{$_}} @{$self->{parts}};
351
7
52
    $parts[-1] .= '.' . $self->extension if (scalar(@parts));
352
353    #
354    # CAUTION: $actual_path must get stringified!
355    # otherwise bad loops and misbehavior would occur.
356    #
357
358
7
79
    $c->uri_for("$actual_path", @parts, {m => $mtime});
359
7
7
7
6179
7
38
}
360
361#
362# collect all files
363#
364sub _collect_files {
365
34
79
    my $self = shift;
366
34
34
    my $c = shift;
367
368
34
196
    my $ext = $self->extension;
369
34
1287
    $self->{parts} = []; # list of plain file names
370
34
59
    $self->{files} = []; # list of full paths
371
34
170
    $self->{replacement_for} = {}; # replacements for every full path
372
34
80
    $self->{seen} = {}; # easy lookup of parts and count of dependencies
373
34
62
    foreach my $file (@_) {
374
46
204
        my $base_name = $file;
375
46
190
        $base_name =~ s{\.$ext\z}{}xms;
376
377
46
140
        $self->_check_dependencies($c, $base_name, ['', ".$ext"]);
378    }
379
380
33
489
    return;
381}
382
383#
384# check dependencies on files
385#
386sub _check_dependencies {
387
57
56
    my $self = shift;
388
57
41
    my $c = shift;
389
57
46
    my $base_name = shift;
390
57
43
    my $extensions = shift;
391
57
271
    my $depends = shift || 0;
392
393
57
397
    my $dependency_for = $self->depend;
394
395    #
396    # check if we already saw this file. Update dependency flag
397    #
398
57
488
    if (exists($self->{seen}->{$base_name})) {
399
7
15
        $self->{seen}->{$base_name} ||= $depends;
400
7
19
        return;
401    }
402
403
50
353
    if ($dependency_for &&
404        ref($dependency_for) eq 'HASH' &&
405        exists($dependency_for->{$base_name})) {
406        #
407        # we have a dependency -- resolve it.
408        #
409
0
0
        my @depend_on = ref($dependency_for->{$base_name}) eq 'ARRAY'
410
11
59
                        ? @{$dependency_for->{$base_name}}
411                        : $dependency_for->{$base_name};
412        $self->_check_dependencies($c, $_, $extensions, 1)
413
11
11
9
40
            for @depend_on;
414    }
415
416    #
417    # add the file if existing
418    #
419
50
377
    my $dir = $c->path_to('root', $self->dir);
420
50
100
50
12117
18331
62
    foreach my $file_path (map { $dir->file("$base_name$_") } @{$extensions}) {
421
97
20064
        next if (!-f $file_path);
422
423        # the file we want exists. Time to do a security check
424        # hint: a call to resolve() will die under windows
425        # if the path requested does not exist on the filesystem.
426        # therefore, we check as late as possible
427
44
2885
        $dir->subsumes($file_path->resolve)
428            or die 'security violation - tried to access file outside of: '
429                   . $self->dir();
430
431        # looks like we are secure -- are there any secret unicodes
432        # we forgot to double-check? *g*
433
43
43
68570
90
        push @{$self->{parts}}, $base_name;
434
43
43
33
57
        push @{$self->{files}}, $file_path;
435
43
73
        $self->{seen}->{$base_name} = $depends;
436
437        # check replacements
438
43
640
        return if (!$self->replace
439                || ref($self->replace) ne 'HASH'
440
43
268
                || !scalar(keys(%{$self->replace})));
441
0
0
0
0
        foreach my $glob (keys(%{$self->replace})) {
442
0
0
            next if (!match_glob($glob, $base_name));
443
0
0
            my $replacements = $self->replace->{$glob};
444
0
0
            next if (!$replacements
445                  || ref($replacements) ne 'ARRAY'
446
0
0
                  || !scalar(@{$replacements}));
447
0
0
0
0
0
0
            push @{$self->{replacement_for}->{$file_path}}, @{$replacements};
448        }
449
450        # done
451
0
0
        return;
452    }
453
454
6
418
    $c->log->warn("$base_name.* --> NOT EXISTING, ignored");
455
6
401
    return;
456}
457
458 - 475
=head1 GOTCHAS

Please do not use C<namespace::autoclean> if you intend to enable a minifier.
The black magic behind the scenes tries to determine your intention to minify
by searching for a sub called C<minify> inside the controller's package.
However, this sub is imported by eg C<JavaScript::Minifier::XS> and will be
kicked out of the controller by C<namespace::autoclean>.

=head1 AUTHOR

Wolfgang Kinkeldei, E<lt>wolfgang@kinkeldei.deE<gt>

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
476
4771;