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   55532 use 5.006;
  3         8  
  3         105  
2 3     3   12 use strict;
  3         3  
  3         93  
3 3     3   14 use warnings;
  3         3  
  3         168  
4              
5             package Plack::Middleware::Precompressed;
6             $Plack::Middleware::Precompressed::VERSION = '1.103';
7             # ABSTRACT: serve pre-gzipped content to compression-enabled clients
8              
9 3     3   12 use parent 'Plack::Middleware';
  3         4  
  3         24  
10              
11 3     3   190 use Plack::Util::Accessor qw( match rules env_keys );
  3         4  
  3         23  
12 3     3   2229 use Plack::MIME ();
  3         2045  
  3         65  
13 3     3   15 use Plack::Util ();
  3         3  
  3         43  
14 3     3   1289 use Array::RefElem ();
  3         1531  
  3         1218  
15              
16             sub rewrite {
17 7     7 0 9 my $self = shift;
18 7         8 my ( $env ) = @_;
19 7         34 my $rules = $self->rules;
20 7 50       44 $rules ? $rules->( defined $env ? $env : () ) : ( $_ .= '.gz' );
    100          
21             }
22              
23             sub call {
24 14     14 1 69712 my $self = shift;
25 14         24 my ( $env ) = @_;
26              
27 14         13 my $encoding;
28 14         23 my $path = $env->{'PATH_INFO'};
29 14 100       37 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       422 if ( $have_match ) {
34 8 50       30 ( $encoding ) =
35 8         16 grep { $_ eq 'gzip' or $_ eq 'x-gzip' }
36 8         28 map { s!\s+!!g; split /,/, lc }
  10         19  
37 10         20 grep { defined }
38             $env->{'HTTP_ACCEPT_ENCODING'};
39             }
40              
41 14         16 my $res = do {
42 14   100     36 my $keys = $self->env_keys || [];
43 14 100       127 local @$env{ 'PATH_INFO', @$keys } = ( $path, @$env{ @$keys } ) if $encoding;
44 14 100       25 if ( $encoding ) {
45 8         8 my %pass_env;
46 8         30 Array::RefElem::hv_store %pass_env, $_, $env->{ $_ } for @$keys;
47 8         31 $self->rewrite( \%pass_env ) for $env->{'PATH_INFO'};
48             }
49 14 100       80 delete local $env->{'HTTP_ACCEPT_ENCODING'} if $encoding;
50 14         48 $self->app->( $env );
51             };
52              
53 14 100       161 return $res unless $have_match;
54              
55 10         10 my $is_fail;
56             my $final_res = Plack::Util::response_cb( $res, sub {
57 10     10   102 my $res = shift;
58 10         16 $is_fail = $res->[0] != 200;
59 10 100       24 return if $is_fail;
60 6         19 Plack::Util::header_push( $res->[1], 'Vary', 'Accept-Encoding' );
61 6 100       32 if ( $encoding ) {
62 5         41 my $mime = Plack::MIME->mime_type( $path );
63 5 100       43 Plack::Util::header_set( $res->[1], 'Content-Type', $mime ) if $mime;
64 5         88 Plack::Util::header_push( $res->[1], 'Content-Encoding', $encoding );
65             }
66 6         25 return;
67 10         64 } );
68              
69 10 100       175 return $is_fail ? $self->app->( $env ) : $final_res;
70             }
71              
72             1;
73              
74             __END__