File Coverage

blib/lib/Plack/Middleware/Precompressed.pm
Criterion Covered Total %
statement 61 61 100.0
branch 24 26 92.3
condition 2 2 100.0
subroutine 11 11 100.0
pod 1 2 50.0
total 99 102 97.0


line stmt bran cond sub pod time code
1 3     3   57804 use 5.006;
  3         9  
  3         135  
2 3     3   17 use strict;
  3         5  
  3         116  
3 3     3   15 use warnings;
  3         3  
  3         229  
4              
5             package Plack::Middleware::Precompressed;
6             $Plack::Middleware::Precompressed::VERSION = '1.102';
7             # ABSTRACT: serve pre-gzipped content to compression-enabled clients
8              
9 3     3   17 use parent 'Plack::Middleware';
  3         5  
  3         29  
10              
11 3     3   239 use Plack::Util::Accessor qw( match rules env_keys );
  3         5  
  3         27  
12 3     3   2768 use Plack::MIME ();
  3         2432  
  3         83  
13 3     3   21 use Plack::Util ();
  3         4  
  3         56  
14 3     3   1729 use Array::RefElem ();
  3         46163  
  3         1617  
15              
16             sub rewrite {
17 7     7 0 10 my $self = shift;
18 7         8 my ( $env ) = @_;
19 7         36 my $rules = $self->rules;
20 7 50       56 $rules ? $rules->( defined $env ? $env : () ) : ( $_ .= '.gz' );
    100          
21             }
22              
23             sub call {
24 14     14 1 84400 my $self = shift;
25 14         26 my ( $env ) = @_;
26              
27 14         15 my $encoding;
28 14         21 my $path = $env->{'PATH_INFO'};
29 14 100       49 my $have_match = $self->match ? $path =~ $self->match : 1;
30              
31             # the `deflate` encoding is unreliably messy so we won't support it
32             # c.f. http://zoompf.com/2012/02/lose-the-wait-http-compression
33 14 100       426 if ( $have_match ) {
34 8 50       35 ( $encoding ) =
35 8         20 grep { $_ eq 'gzip' or $_ eq 'x-gzip' }
36 8         28 map { s!\s+!!g; split /,/, lc }
  10         22  
37 10         25 grep { defined }
38             $env->{'HTTP_ACCEPT_ENCODING'};
39             }
40              
41 14         18 my $res = do {
42 14   100     38 my $keys = $self->env_keys || [];
43 14 100       141 local @$env{ 'PATH_INFO', @$keys } = ( $path, @$env{ @$keys } ) if $encoding;
44 14 100       31 if ( $encoding ) {
45 8         10 my %pass_env;
46 8         33 Array::RefElem::hv_store %pass_env, $_, $env->{ $_ } for @$keys;
47 8         34 $self->rewrite( \%pass_env ) for $env->{'PATH_INFO'};
48             }
49 14 100       84 delete local $env->{'HTTP_ACCEPT_ENCODING'} if $encoding;
50 14         48 $self->app->( $env );
51             };
52              
53 14 100       200 return $res unless $have_match;
54              
55 10         14 my $is_fail;
56             my $final_res = Plack::Util::response_cb( $res, sub {
57 10     10   134 my $res = shift;
58 10         18 $is_fail = $res->[0] != 200;
59 10 100       32 return if $is_fail;
60 6         23 Plack::Util::header_push( $res->[1], 'Vary', 'Accept-Encoding' );
61 6 100       37 if ( $encoding ) {
62 5         54 my $mime = Plack::MIME->mime_type( $path );
63 5 100       52 Plack::Util::header_set( $res->[1], 'Content-Type', $mime ) if $mime;
64 5         60 Plack::Util::header_push( $res->[1], 'Content-Encoding', $encoding );
65             }
66 6         27 return;
67 10         81 } );
68              
69 10 100       211 return $is_fail ? $self->app->( $env ) : $final_res;
70             }
71              
72             1;
73              
74             __END__