File Coverage

blib/lib/Plack/Middleware/Deflater.pm

Criterion	Covered	Total	%
statement	98	107	91.5
branch	29	58	50.0
condition	9	28	32.1
subroutine	15	16	93.7
pod	2	2	100.0
total	153	211	72.5

package Plack::Middleware::Deflater;
use strict;
use 5.008001;
our $VERSION = '0.14';
use parent qw(Plack::Middleware);
use Plack::Util::Accessor qw( content_type vary_user_agent);
use Plack::Util;

sub prepare_app {
    my $self = shift;
    if (my $match_cts = $self->content_type) {
        $match_cts = [$match_cts] if !ref $match_cts;
        $self->content_type($match_cts);
    }
}

sub call {
    my($self, $env) = @_;

    my $res = $self->app->($env);

    $self->response_cb(
        $res,
        sub {
            my $res = shift;

            # can't operate on Content-Ranges
            return if $env->{HTTP_CONTENT_RANGE};

            return if $env->{"plack.skip-deflater"};

            my $h            = Plack::Util::headers($res->[1]);
            my $content_type = $h->get('Content-Type') || '';
            $content_type =~ s/(;.*)$//;
            if (my $match_cts = $self->content_type) {
                my $match = 0;
                for my $match_ct (@{$match_cts}) {
                    if ($content_type eq $match_ct) {
                        $match++;
                        last;
                    }
                }
                return unless $match;
            }

            if (Plack::Util::status_with_no_entity_body($res->[0])
                or $h->exists('Cache-Control') && $h->get('Cache-Control') =~ /\bno-transform\b/)
            {
                return;
            }

            my @vary = split /\s*,\s*/, ($h->get('Vary') || '');
            push @vary, 'Accept-Encoding';
            push @vary, 'User-Agent' if $self->vary_user_agent;
            $h->set('Vary' => join(",", @vary));

            # Do not clobber already existing encoding
            return if $h->exists('Content-Encoding') && $h->get('Content-Encoding') ne 'identity';

            # some browsers might have problems, so set no-compress
            return if $env->{"psgix.no-compress"};

            # Some browsers might have problems with content types
            # other than text/html, so set compress-only-text/html
            if ($env->{"psgix.compress-only-text/html"}) {
                return if $content_type ne 'text/html';
            }

            # TODO check quality
            my $encoding = 'identity';
            if (defined $env->{HTTP_ACCEPT_ENCODING}) {
                for my $enc (qw(gzip deflate identity)) {
                    if ($env->{HTTP_ACCEPT_ENCODING} =~ /\b$enc\b/) {
                        $encoding = $enc;
                        last;
                    }
                }
            }

            my $encoder;
            if ($encoding eq 'gzip' || $encoding eq 'deflate') {
                $encoder = Plack::Middleware::Deflater::Encoder->new($encoding);
            }

            if ($encoder) {
                $h->set('Content-Encoding' => $encoding);
                $h->remove('Content-Length');

                # normal response
                if ($res->[2] && ref($res->[2]) && ref($res->[2]) eq 'ARRAY') {
                    my $buf = '';
                    foreach (@{ $res->[2] }) {
                        $buf .= $encoder->print($_) if defined $_;
                    }
                    $buf .= $encoder->close();
                    $res->[2] = [$buf];
                    return;
                }

                # delayed or stream
                return sub {
                    $encoder->print(shift);
                };
            }
        }
    );
}

1;

package Plack::Middleware::Deflater::Encoder;

use strict;
use warnings;
use Compress::Zlib;

use constant GZIP_MAGIC => 0x1f8b;

sub new {
    my $class    = shift;
    my $encoding = shift;
    my($encoder, $status) =
      $encoding eq 'gzip'
      ? deflateInit(-WindowBits => -MAX_WBITS())
      : deflateInit(-WindowBits => MAX_WBITS());
    die 'Cannot create a deflation stream' if $status != Z_OK;

    bless {
        header   => 0,
        closed   => 0,
        encoding => $encoding,
        encoder  => $encoder,
        crc      => crc32(undef),
        length   => 0,
    }, $class;
}

sub print : method {
    my $self = shift;
    return if $self->{closed};
    my $chunk = shift;
    if (!defined $chunk) {
        my($buf, $status) = $self->{encoder}->flush();
        die "deflate failed: $status" if ($status != Z_OK);
        if (!$self->{header} && $self->{encoding} eq 'gzip') {
            $buf = pack("nccVcc", GZIP_MAGIC, Z_DEFLATED, 0, time(), 0, $Compress::Raw::Zlib::gzip_os_code) . $buf;
        }
        $buf .= pack("LL", $self->{crc}, $self->{length})
          if $self->{encoding} eq 'gzip';
        $self->{closed} = 1;
        return $buf;
    }

    my($buf, $status) = $self->{encoder}->deflate($chunk);
    die "deflate failed: $status" if ($status != Z_OK);
    $self->{length} += length $chunk;
    $self->{crc} = crc32($chunk, $self->{crc});
    if (length $buf) {
        if (!$self->{header} && $self->{encoding} eq 'gzip') {
            $buf = pack("nccVcc", GZIP_MAGIC, Z_DEFLATED, 0, time(), 0, $Compress::Raw::Zlib::gzip_os_code) . $buf;
        }
        $self->{header} = 1;
        return $buf;
    }
    return '';
}

sub close : method {
    $_[0]->print(undef);
}

sub closed {
    $_[0]->{closed};
}

1;

__END__