1package Plack::Middleware::Deflater;
2use strict;
3use 5.008001;
4our $VERSION = '0.12';
5use parent qw(Plack::Middleware);
6use Plack::Util::Accessor qw( content_type vary_user_agent);
7use Plack::Util;
8
9sub prepare_app {
10    my $self = shift;
11    if ( my $match_cts = $self->content_type ) {
12        $match_cts = [$match_cts] if ! ref $match_cts;
13        $self->content_type($match_cts);
14    }
15}
16
17sub call {
18    my($self, $env) = @_;
19
20    my $res = $self->app->($env);
21
22    $self->response_cb($res, sub {
23        my $res = shift;
24
25        # can't operate on Content-Ranges
26        return if $env->{HTTP_CONTENT_RANGE};
27
28        return if $env->{"plack.skip-deflater"};
29
30        my $h = Plack::Util::headers($res->[1]);
31        my $content_type = $h->get('Content-Type') || '';
32        $content_type =~ s/(;.*)$//;
33        if ( my $match_cts = $self->content_type ) {
34            my $match=0;
35            for my $match_ct ( @{$match_cts} ) {
36                if ( $content_type eq $match_ct ) {
37                    $match++;
38                    last;
39                }
40            }
41            return unless $match;
42        }
43
44        if (Plack::Util::status_with_no_entity_body($res->[0]) or
45            $h->exists('Cache-Control') && $h->get('Cache-Control') =~ /\bno-transform\b/) {
46            return;
47        }
48
49        my @vary = split /\s*,\s*/, ($h->get('Vary') || '');
50        push @vary, 'Accept-Encoding';
51        push @vary, 'User-Agent' if $self->vary_user_agent;
52        $h->set('Vary' => join(",", @vary));
53
54        # some browsers might have problems, so set no-compress
55        return if $env->{"psgix.no-compress"};
56
57        # Some browsers might have problems with content types
58        # other than text/html, so set compress-only-text/html
59        if ( $env->{"psgix.compress-only-text/html"} ) {
60            return if $content_type ne 'text/html';
61        }
62
63        # TODO check quality
64        my $encoding = 'identity';
65        if ( defined $env->{HTTP_ACCEPT_ENCODING} ) {
66            for my $enc (qw(gzip deflate identity)) {
67                if ( $env->{HTTP_ACCEPT_ENCODING} =~ /\b$enc\b/ ) {
68                    $encoding = $enc;
69                    last;
70                }
71            }
72        }
73
74        my $encoder;
75        if ($encoding eq 'gzip' || $encoding eq 'deflate') {
76            $encoder = Plack::Middleware::Deflater::Encoder->new($encoding);
77        } elsif ($encoding ne 'identity') {
78            my $msg = "An acceptable encoding for the requested resource is not found.";
79            @$res = (406, ['Content-Type' => 'text/plain'], [ $msg ]);
80            return;
81        }
82
83        if ($encoder) {
84            $h->set('Content-Encoding' => $encoding);
85            $h->remove('Content-Length');
86
87            # normal response
88            if ( $res->[2] && ref($res->[2]) && ref($res->[2]) eq 'ARRAY' ) {
89                my $buf = '';
90                foreach (@{$res->[2]}) {
91                    $buf .= $encoder->print($_) if defined $_;
92                }
93                $buf .= $encoder->close();
94                $res->[2] = [$buf];
95                return;
96            }
97
98            # delayed or stream
99            return sub {
100                $encoder->print(shift);
101            };
102        }
103    });
104}
105
1061;
107
108package Plack::Middleware::Deflater::Encoder;
109
110use strict;
111use warnings;
112use Compress::Zlib;
113
114use constant GZIP_MAGIC => 0x1f8b;
115
116sub new {
117    my $class = shift;
118    my $encoding = shift;
119    my ($encoder,$status) = $encoding eq 'gzip'
120        ? deflateInit(-WindowBits => -MAX_WBITS())
121        : deflateInit(-WindowBits => MAX_WBITS());
122    die 'Cannot create a deflation stream' if $status != Z_OK;
123
124    bless {
125        header => 0,
126        closed => 0,
127        encoding => $encoding,
128        encoder => $encoder,
129        crc => crc32(undef),
130        length => 0,
131    }, $class;
132}
133
134sub print : method {
135    my $self = shift;
136    return if $self->{closed};
137    my $chunk = shift;
138    if ( ! defined $chunk ) {
139        my ($buf,$status) = $self->{encoder}->flush();
140        die "deflate failed: $status" if ( $status != Z_OK );
141        if ( !$self->{header} && $self->{encoding} eq 'gzip' ) {
142            $buf = pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,$Compress::Raw::Zlib::gzip_os_code) . $buf
143        }
144        $buf .= pack("LL", $self->{crc},$self->{length}) if $self->{encoding} eq 'gzip';
145        $self->{closed} = 1;
146        return $buf;
147    }
148
149    my ($buf,$status) = $self->{encoder}->deflate($chunk);
150    die "deflate failed: $status" if ( $status != Z_OK );
151    $self->{length} += length $chunk;
152    $self->{crc} = crc32($chunk,$self->{crc});
153    if ( length $buf ) {
154        if ( !$self->{header} && $self->{encoding} eq 'gzip' ) {
155            $buf = pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,$Compress::Raw::Zlib::gzip_os_code) . $buf
156        }
157        $self->{header} = 1;
158        return $buf;
159    }
160    return '';
161}
162
163sub close : method {
164    $_[0]->print(undef);
165}
166
167sub closed {
168    $_[0]->{closed};
169}
170
1711;
172
173
174__END__
175
176=head1 NAME
177
178Plack::Middleware::Deflater - Compress response body with Gzip or Deflate
179
180=head1 SYNOPSIS
181
182  use Plack::Builder;
183
184  builder {
185    enable sub {
186        my $app = shift;
187        sub {
188            my $env = shift;
189            my $ua = $env->{HTTP_USER_AGENT} || '';
190            # Netscape has some problem
191            $env->{"psgix.compress-only-text/html"} = 1 if $ua =~ m!^Mozilla/4!;
192            # Netscape 4.06-4.08 have some more problems
193             $env->{"psgix.no-compress"} = 1 if $ua =~ m!^Mozilla/4\.0[678]!;
194            # MSIE (7|8) masquerades as Netscape, but it is fine
195            if ( $ua =~ m!\bMSIE (?:7|8)! ) {
196                $env->{"psgix.no-compress"} = 0;
197                $env->{"psgix.compress-only-text/html"} = 0;
198            }
199            $app->($env);
200        }
201    };
202    enable "Deflater",
203        content_type => ['text/css','text/html','text/javascript','application/javascript'],
204        vary_user_agent => 1;
205    sub { [200,['Content-Type','text/html'],["OK"]] }
206  };
207
208=head1 DESCRIPTION
209
210Plack::Middleware::Deflater is a middleware to encode your response
211body in gzip or deflate, based on C<Accept-Encoding> HTTP request
212header. It would save the bandwidth a little bit but should increase
213the Plack server load, so ideally you should handle this on the
214frontend reverse proxy servers.
215
216This middleware removes C<Content-Length> and streams encoded content,
217which means the server should support HTTP/1.1 chunked response or
218downgrade to HTTP/1.0 and closes the connection.
219
220=head1 CONFIGURATIONS
221
222=over 4
223
224=item content_type
225
226  content_type => 'text/html',
227  content_type => [ 'text/html', 'text/css', 'text/javascript', 'application/javascript', 'application/x-javascript' ]
228
229Content-Type header to apply deflater. if content-type is not defined, Deflater will try to deflate all contents.
230
231=item vary_user_agent
232
233  vary_user_agent => 1
234
235Add "User-Agent" to Vary header.
236
237=back
238
239=head1 ENVIRONMENT VALUE
240
241=over 4
242
243=item psgix.no-compress
244
245Do not apply deflater
246
247=item psgix.compress-only-text/html
248
249Apply deflater only if content_type is "text/html"
250
251=item plack.skip-deflater
252
253Skip all Deflater features
254
255=back
256
257=head2 Compare psgix.no-compress with plack.skip-deflater
258
259If no-compress is true, PM::Deflater skips gzip or deflate. But adds Vary: Accept-Encoding and Vary: User-Agent header. skip-deflater forces to skip all PM::Deflater feature, doesn't allow to add Vary header.
260
261=head1 LICENSE
262
263This software is licensed under the same terms as Perl itself.
264
265=head1 AUTHOR
266
267Tatsuhiko Miyagawa
268
269=head1 SEE ALSO
270
271L<Plack>, L<http://httpd.apache.org/docs/2.2/en/mod/mod_deflate.html>
272
273=cut
274