|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Mojolicious::Plugin::Gzip;  | 
| 
2
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
22684
 | 
 use Mojo::Base 'Mojolicious::Plugin::Config';  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
33
 | 
    | 
| 
3
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
5989
 | 
 use Mojo::Util qw/gzip/;  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
224
 | 
    | 
| 
4
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
43
 | 
 use Scalar::Util qw/reftype/;  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2023
 | 
    | 
| 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $VERSION = '0.02';  | 
| 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub register {  | 
| 
9
 | 
18
 | 
 
 | 
 
 | 
  
18
  
 | 
  
1
  
 | 
10500
 | 
     my (undef, $app, $config) = @_;  | 
| 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
11
 | 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
     my $min_size;  | 
| 
12
 | 
18
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
49
 | 
     if (defined $config) {  | 
| 
13
 | 
18
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
80
 | 
         die 'config must be a hash reference'  | 
| 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             unless reftype($config) eq 'HASH';  | 
| 
15
 | 
17
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
54
 | 
         if (keys %$config) {  | 
| 
16
 | 
12
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
38
 | 
             $min_size = delete $config->{min_size} // '';  | 
| 
17
 | 
12
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
40
 | 
             die 'invalid key passed to Mojolicious::Plugin::Gzip (only min_size is allowed)'  | 
| 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 if keys %$config;  | 
| 
19
 | 
10
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
104
 | 
             die 'min_size must be a positive integer'  | 
| 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 unless $min_size =~ /^\d+$/ and $min_size > 0;  | 
| 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
23
 | 
9
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
41
 | 
     $min_size //= 860;  | 
| 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $app->hook(after_dispatch => sub {  | 
| 
26
 | 
32
 | 
 
 | 
 
 | 
  
32
  
 | 
 
 | 
316354
 | 
         my ($c) = @_;  | 
| 
27
 | 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
118
 | 
         my $req = $c->req;  | 
| 
28
 | 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
340
 | 
         my $res = $c->res;  | 
| 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
30
 | 
32
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
300
 | 
         my $accept_encoding = $req->headers->accept_encoding // '';  | 
| 
31
 | 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
621
 | 
         my $body = $res->body;  | 
| 
32
 | 
32
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
549
 | 
         my $body_size = $res->body_size // 0;  | 
| 
33
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
34
 | 
32
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
907
 | 
         return unless $accept_encoding =~ /gzip/i  | 
| 
 
 | 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
35
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 and $body_size >= $min_size  | 
| 
36
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 and $res->code == 200  | 
| 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 and not $res->headers->content_encoding;  | 
| 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
39
 | 
19
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
425
 | 
         if (my $etag = $res->headers->etag) {  | 
| 
40
 | 
10
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
222
 | 
             if (length $etag > 2 and substr($etag, 0, 1) eq '"' and substr($etag, -1, 1) eq '"') {  | 
| 
 
 | 
 
 | 
 
 | 
  
 66
  
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
41
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22
 | 
                 $etag = substr($etag, 1, length($etag) - 2);  | 
| 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             } else {  | 
| 
43
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
                 $app->log->warn("Found either empty ETag or ETag not surrounded by quotes: '$etag'");  | 
| 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             }  | 
| 
45
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
46
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
106
 | 
             $res->headers->etag(qq{"$etag-gzip"});  | 
| 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
49
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
321
 | 
         my $zipped_body = gzip $body;  | 
| 
50
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34391
 | 
         $res->body($zipped_body);  | 
| 
51
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
867
 | 
         $res->fix_headers;  | 
| 
52
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2848
 | 
         $res->headers->content_length(length $zipped_body);  | 
| 
53
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
271
 | 
         $res->headers->append(Vary => 'Accept-Encoding');  | 
| 
54
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
857
 | 
         $res->headers->content_encoding('gzip');  | 
| 
55
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
78
 | 
     });  | 
| 
56
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
58
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  | 
| 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 __END__  |