view release on metacpan or  search on metacpan

lib/Cache/Memcached/Fast.pm  view on Meta::CPAN

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__

=encoding UTF-8

=head1 NAME

Cache::Memcached::Fast - Perl client for B<memcached>, in C language

=head1 SYNOPSIS

    use Cache::Memcached::Fast;

  my $memd = Cache::Memcached::Fast->new({
      servers => [ { address => 'localhost:11211', weight => 2.5 },
                   '192.168.254.2:11211',
                   { address => '/path/to/unix.sock', noreply => 1 } ],
      namespace => 'my:',
      connect_timeout => 0.2,
      io_timeout => 0.5,
      close_on_error => 1,
      compress_threshold => 100_000,
      compress_ratio => 0.9,
      compress_methods => [ \&IO::Compress::Gzip::gzip,
                            \&IO::Uncompress::Gunzip::gunzip ],
      max_failures => 3,
      failure_timeout => 2,
      ketama_points => 150,
      nowait => 1,