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

# File Coverage

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

line | stmt | bran | cond | sub | pod | time | code
--- | --- | --- | --- | --- | --- | --- | ---
1 |  |  |  |  |  |  | package Catalyst::Controller::Combine;
2 |
3 | 7 7 7 |  |  | 7 |  | 1513 11 58 | use Moose;
4 |  |  |  |  |  |  | # w/o BEGIN, :attrs will not work
5 | 7 |  |  | 7 |  | 23679 | BEGIN { extends 'Catalyst::Controller' }
6 |
7 | 7 7 7 |  |  | 7 |  | 21654 8 96 | use Path::Class ();
8 | 7 7 7 |  |  | 7 |  | 22 10 76 | use File::stat;
9 | 7 7 7 |  |  | 7 |  | 395 6 291 | use List::Util qw(max);
10 | 7 7 7 |  |  | 7 |  | 1362 4524 3840 | use Text::Glob qw(match_glob);
11 |
12 |  |  |  |  |  |  | has dir => (is => 'rw',
13 |  |  |  |  |  |  | default => sub { 'static/' . shift->action_namespace },
14 |  |  |  |  |  |  | lazy => 1);
15 |  |  |  |  |  |  | has extension => (is => 'rw',
16 |  |  |  |  |  |  | default => sub { shift->action_namespace },
17 |  |  |  |  |  |  | lazy => 1);
18 |  |  |  |  |  |  | has depend => (is => 'rw',
19 |  |  |  |  |  |  | default => sub { return {} });
20 |  |  |  |  |  |  | has 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);
29 |  |  |  |  |  |  | has replace => (is => 'rw',
30 |  |  |  |  |  |  | default => sub { {} },
31 |  |  |  |  |  |  | lazy => 1);
32 |  |  |  |  |  |  | has minifier => (is => 'rw',
33 |  |  |  |  |  |  | default => 'minify');
34 |  |  |  |  |  |  | has expire => (is => 'rw',
35 |  |  |  |  |  |  | default => 0);
36 |  |  |  |  |  |  | has 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 |
162 |  |  |  |  |  |  | sub BUILD {
163 | 13 |  |  | 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 |
209 |  |  |  |  |  |  | sub do_combine :Action {
210 | 18 |  |  | 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 | 0 |  |  |  | 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 | 0 |  |  |  | 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 | 50 |  |  |  | 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 |  | 0 | 15 |  | 119 195 | || sub { $_[0] }; # simple identity function
251 | 17 | 50 |  |  |  | 335 | $c->response->headers->content_type($self->mimetype)
252 |  |  |  |  |  |  | if ($self->mimetype);
253 | 17 | 50 |  |  |  | 1592 | $c->response->headers->last_modified($mtime)
254 |  |  |  |  |  |  | if ($mtime);
255 |
256 | 17 | 100 | 67 |  |  | 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 |  |  | 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 |
271 |  |  |  |  |  |  | sub default :Path {
272 | 11 |  |  | 11 | 1 | 85178 | my $self = shift;
273 | 11 |  |  |  |  | 20 | my $c = shift;
274 |
275 | 11 |  |  |  |  | 57 | $c->forward('do_combine');
276 | 7 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 |
331 |  |  |  |  |  |  | sub uri_for :Private {
332 | 7 |  |  | 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 | 0 |  |  |  | 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 | 50 |  |  |  | 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 |  |  | 7 |  | 6179 7 38 | }
360 |
361 |  |  |  |  |  |  | #
362 |  |  |  |  |  |  | # collect all files
363 |  |  |  |  |  |  | #
364 |  |  |  |  |  |  | sub _collect_files {
365 | 34 |  |  | 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 |  |  |  |  |  |  | #
386 |  |  |  |  |  |  | sub _check_dependencies {
387 | 57 |  |  | 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 |  | 100 |  |  | 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 | 100 |  |  |  | 488 | if (exists($self->{seen}->{$base_name})) {
399 | 7 |  | 67 |  |  | 15 | $self->{seen}->{$base_name} ||= $depends;
400 | 7 |  |  |  |  | 19 | return;
401 |  |  |  |  |  |  | }
402 |
403 | 50 | 100 | 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 | 50 |  |  |  | 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 | 0 |  |  |  | 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 | 0 |  |  |  | 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 | 0 | 0 |  |  | 268 | || !scalar(keys(%{$self->replace})));
441 | 0 0 |  |  |  |  | 0 0 | foreach my $glob (keys(%{$self->replace})) {
442 | 0 | 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 | 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 |
477 |  |  |  |  |  |  | 1;