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   91293 use 5.006; use strict; use warnings;
  3     3   18  
  3     3   14  
  3         4  
  3         47  
  3         12  
  3         4  
  3         168  
2              
3             package Plack::Middleware::Precompressed;
4              
5             our $VERSION = '1.104';
6              
7 3     3   13 BEGIN { require Plack::Middleware; our @ISA = 'Plack::Middleware' }
  3         133  
8              
9 3     3   15 use Plack::Util::Accessor qw( match rules env_keys );
  3         6  
  3         21  
10 3     3   1300 use Plack::MIME ();
  3         2020  
  3         62  
11 3     3   17 use Plack::Util ();
  3         4  
  3         36  
12 3     3   1048 use Array::RefElem ();
  3         1287  
  3         1201  
13              
14             sub rewrite {
15 7     7 0 8 my $self = shift;
16 7         13 my ( $env ) = @_;
17 7         15 my $rules = $self->rules;
18 7 50       39 $rules ? $rules->( defined $env ? $env : () ) : ( $_ .= '.gz' );
    100          
19             }
20              
21             sub call {
22 14     14 1 74345 my $self = shift;
23 14         26 my ( $env ) = @_;
24              
25 14         18 my $encoding;
26 14         24 my $path = $env->{'PATH_INFO'};
27 14 100       33 my $have_match = $self->match ? $path =~ $self->match : 1;
28              
29             # the `deflate` encoding is unreliably messy so we won't support it
30             # c.f. http://zoompf.com/2012/02/lose-the-wait-http-compression
31 14 100       230 if ( $have_match ) {
32             ( $encoding ) =
33 8 50       29 grep { $_ eq 'gzip' or $_ eq 'x-gzip' }
34 8         18 map { s!\s+!!g; split /,/, lc }
  8         25  
35 10         26 grep { defined }
36 10         21 $env->{'HTTP_ACCEPT_ENCODING'};
37             }
38              
39 14         34 my $res = do {
40 14   100     46 my $keys = $self->env_keys || [];
41 14 100       103 local @$env{ 'PATH_INFO', @$keys } = ( $path, @$env{ @$keys } ) if $encoding;
42 14 100       37 if ( $encoding ) {
43 8         12 my %pass_env;
44 8         22 Array::RefElem::hv_store %pass_env, $_, $env->{ $_ } for @$keys;
45 8         30 $self->rewrite( \%pass_env ) for $env->{'PATH_INFO'};
46             }
47 14 100       70 delete local $env->{'HTTP_ACCEPT_ENCODING'} if $encoding;
48 14         54 $self->app->( $env );
49             };
50              
51 14 100       155 return $res unless $have_match;
52              
53 10         14 my $is_fail;
54             my $final_res = Plack::Util::response_cb( $res, sub {
55 10     10   127 my $res = shift;
56 10         16 $is_fail = $res->[0] != 200;
57 10 100       31 return if $is_fail;
58 6         7 push @{ $res->[1] }, 'Vary', 'Accept-Encoding';
  6         19  
59 6 100       13 if ( $encoding ) {
60 5         20 my $mime = Plack::MIME->mime_type( $path );
61 5 100       44 Plack::Util::header_set( $res->[1], 'Content-Type', $mime ) if $mime;
62 5         53 push @{ $res->[1] }, 'Content-Encoding', $encoding;
  5         22  
63             }
64 6         22 return;
65 10         55 } );
66              
67 10 100       157 return $is_fail ? $self->app->( $env ) : $final_res;
68             }
69              
70             1;
71              
72             __END__