File Coverage

blib/lib/Memcached/Client/Compressor/Gzip.pm

Criterion	Covered	Total	%
statement	45	45	100.0
branch	9	10	90.0
condition	6	7	85.7
subroutine	9	9	100.0
pod	2	2	100.0
total	71	73	97.2

package Memcached::Client::Compressor::Gzip;
BEGIN {
  $Memcached::Client::Compressor::Gzip::VERSION = '2.01';
}
#ABSTRACT: Implements Memcached Compression using Gzip

use bytes;
use strict;
use warnings;
use Memcached::Client::Log qw{DEBUG};
use base qw{Memcached::Client::Compressor};

use constant +{
    HAVE_ZLIB => eval { require Compress::Zlib; 1 },
    F_COMPRESS => 2,
    COMPRESS_SAVINGS => 0.20
};

sub decompress {
    my ($self, $data, $flags) = @_;

    return unless defined $data;

    $flags ||= 0;

    if ($flags & F_COMPRESS && HAVE_ZLIB) {
        $self->log ("Uncompressing data") if DEBUG;
        $data = Compress::Zlib::memGunzip ($data);
    }

    return ($data, $flags);
}

sub compress {
    my ($self, $data, $flags) = @_;

    $self->log ("Entering compress") if DEBUG;
    return unless defined $data;

    $self->log ("Have data") if DEBUG;
    my $len = bytes::length ($data);

    $self->log ("Checking for Zlib") if DEBUG;

    if (HAVE_ZLIB) {

        my $compressable = $self->{compress_threshold} && $len >= $self->{compress_threshold};

        if ($compressable) {
            $self->log ("Compressing data") if DEBUG;
            my $c_val = Compress::Zlib::memGzip ($data);
            my $c_len = bytes::length ($c_val);

            if ($c_len < $len * (1 - COMPRESS_SAVINGS)) {
                $self->log ("Compressing is a win") if DEBUG;
                $data = $c_val;
                $flags |= F_COMPRESS;
            }
        }
    }

    return ($data, $flags);
}

1;

__END__