File Coverage

blib/lib/Cache/Memcached/Fast.pm

Criterion	Covered	Total	%
statement	34	46	73.9
branch	7	8	87.5
condition	6	6	100.0
subroutine	8	11	72.7
pod	1	1	100.0
total	56	72	77.7

package Cache::Memcached::Fast 0.28;

use v5.12;
use warnings;

use Carp           ();
use Compress::Zlib ();
use Storable;
use XSLoader;

my %instance;
my %known_args = map { $_ => 1 } qw(
    check_args close_on_error compress_algo compress_methods compress_ratio
    compress_threshold connect_timeout failure_timeout hash_namespace
    io_timeout ketama_points max_failures max_size namespace nowait
    select_timeout serialize_methods servers utf8
);

sub new {
    my ( $class, $conf ) = @_;

    unless ( lc( $conf->{check_args} // '' ) eq 'skip' ) {
        Carp::carp 'compress_algo was removed in 0.08, use compress_methods'
            if exists $conf->{compress_algo};

        if ( my @unknown = grep !$known_args{$_}, sort keys %$conf ) {
            local $" = ', ';
            Carp::carp "Unknown arguments: @unknown";
        }
    }

    # Note that the functions below can't return false when operation succeed.
    # This is because "" and "0" compress to a longer values (because of
    # additional format data), and compress_ratio will force them to be stored
    # uncompressed, thus decompression will never return them.
    $conf->{compress_methods} //= [
        sub { ${ $_[1] } = Compress::Zlib::memGzip( ${ $_[0] } ) },
        sub { ${ $_[1] } = Compress::Zlib::memGunzip( ${ $_[0] } ) },
    ];

    $conf->{serialize_methods} //= [ \&Storable::nfreeze, \&Storable::thaw ];

    my $memd = $class->_new($conf);

    my $context = [ $memd, $conf ];
    _weaken( $context->[0] );
    $instance{$$memd} = $context;

    return $memd;
}

sub CLONE {
    my $class = shift;

    # Empty %instance and loop over the values.
    for my $context ( delete @instance{ keys %instance } ) {
        my ( $memd, $conf ) = @$context;

        my $memd2 = $class->_new($conf);

        $instance{ $$memd = $$memd2 } = $context;

        $$memd2 = 0;    # Prevent destruction in DESTROY.
    }
}

sub DESTROY {
    my $memd = shift;

    return unless $$memd;

    delete $instance{$$memd};

    _destroy($memd);
}

XSLoader::load;

__END__