root/lang/perl/Cache-Memcached-LibMemcached/trunk/lib/Cache/Memcached/LibMemcached.pm @ 4435

Revision 4435, 5.9 kB (checked in by daisuke, 6 years ago)

lang/perl/Cache-Memcached-LibMemcached?; import

  • Property svn:keywords set to Id
Line 
1# $Id$
2#
3# Copyright (c) 2008 Daisuke Maki <daisuke@endeworks.jp>
4# All rights reserved.
5
6package Cache::Memcached::LibMemcached;
7use strict;
8use warnings;
9use base qw(Class::Accessor::Fast);
10use Carp 'croak';
11use Storable;
12use constant HAVE_ZLIB => eval "use Compress::Zlib (); 1;";
13use constant COMPRESS_SAVINGS => 0.20;
14
15our ($VERSION, @ISA, %EXPORT_TAGS, @EXPORT_OK);
16BEGIN
17{
18    $VERSION = '0.00001';
19    if ($] > 5.006) {
20        require XSLoader;
21        XSLoader::load(__PACKAGE__, $VERSION);
22    } else {
23        require DynaLoader;
24        @ISA = qw(DynaLoader);
25        __PACKAGE__->bootstrap;
26    }
27}
28
29__PACKAGE__->mk_accessors($_) for qw(
30    compress_threshold compress_enable backend
31);
32
33sub new
34{
35    my $class   = shift;
36    my $args    = shift || {};
37    my $servers = delete $args->{servers};
38    my $backend = delete $args->{backend} || 'Cache::Memcached::LibMemcached::Backend';
39
40    my $self    = $class->SUPER::new({
41        compress_enable => 1,
42        %$args,
43        backend => $backend->create()
44    });
45
46    $self->set_servers($servers);
47    return $self;
48}
49
50sub set_servers
51{
52    my $self = shift;
53    my $servers = shift;
54    my $backend = $self->backend;
55
56    foreach my $server (@{ $servers || [] }) {
57        if (ref $server) {
58            croak "Cache::Memcached::LibMemcached does not support server with weights";
59        }
60        my ($hostname, $port) = split(/:/, $server);
61        if ($port) {
62            $backend->server_add( $hostname, $port );
63        } else {
64            $backend->server_add_unix( $server );
65        }
66    }
67
68    return $self;
69}
70
71sub set
72{
73    my $self    = shift;
74    my $key     = shift;
75    my $val     = shift;
76
77    my $expires = 0;
78    my $flags   = 0;
79
80    if ( ref $val ) {
81        $val = Storable::freeze($val);
82        $flags |= F_STORABLE;
83    }
84
85    use bytes;
86    my $len     = length $val;
87
88    if ( HAVE_ZLIB ) {
89        my $threshold = $self->compress_threshold;
90        if ($threshold && $self->compress_enable && $len >= $threshold) {
91            my $c_val = Compress::Zlib::memGzip($val);
92            my $c_len = length($c_val);
93
94            # do we want to keep it?
95            if ($c_len < $len*(1 - COMPRESS_SAVINGS)) {
96                $val = $c_val;
97                $len = $c_len;
98                $flags |= F_COMPRESS;
99            }
100        }
101    }
102
103    $self->backend->set_raw($key, $val, $expires, $flags);
104}
105
106sub get
107{
108    my $self   = shift;
109    my $key    = shift;
110
111    my ($val, $flags) = $self->backend->get_raw($key);
112
113    if (defined $val) {
114        if ($flags & F_STORABLE) {
115            $val = Storable::thaw($val);
116        }
117
118        if ($flags & F_COMPRESS) {
119            if (! HAVE_ZLIB) {
120                croak "tried to fetch compress value, but we don't have Compress::Zlib";
121            }
122            $val = Compress::Zlib::memGunzip($val);
123        }
124    }
125
126    return $val;
127}
128
1291;
130
131__END__
132
133=head1 NAME
134
135Cache::Memcached::LibMemcached - Perl Interface to libmemcached
136
137=head1 SYNOPSIS
138
139  use Cache::Memcached::LibMemcached;
140  my $memd = Cache::Memcached::LibMemcached->new({
141    serves => [ "10.0.0.15:11211", "10.0.0.15:11212", "/var/sock/memcached" ],
142    compress_threshold => 10_000
143  });
144
145  $memd->set("my_key", "Some value");
146  $memd->set("object_key", { 'complex' => [ "object", 2, 4 ]});
147
148  $val = $memd->get("my_key");
149  $val = $memd->get("object_key");
150  if ($val) { print $val->{complex}->[2] }
151
152=head1 DESCRIPTION
153
154This is the Perl Interface to libmemcached, a C library to interface with
155memcached.
156
157There's also a Memcached::libmemcached available on googlecode, but the
158intent of Cache::Memcached::LibMemcached is to provide users with consistent
159API as Cache::Memcached.
160
161=head1 METHODS
162
163=head2 new
164
165Takes on parameter, a hashref of options.
166
167=head2 set_servers
168
169Sets the server list. Note that currently you should not expect this to
170I<replace> the server list that Cache::Memcached::LibMemcached works --
171instead it ADDS to the list. Normally you shouldn't call this method directly,
172because it's called by new().
173
174This behavior *may* change in later releases.
175
176=head2 get
177
178  my $val = $memd->get($key);
179
180Retrieves a key from the memcached. Returns the value (automatically thawed
181with Storable, if necessary) or undef.
182
183Currently the arrayref form of $key is NOT supported. Perhaps in the future.
184
185=head2 set
186
187  $memd->set($key, $value[, $expires]);
188
189Unconditionally sets a key to a given value in the memcache. Returns true if
190it was stored successfully.
191
192Currently the arrayref form of $key is NOT supported. Perhaps in the future.
193
194=head1 CONSTANTS
195
196=head2  MEMCACHED_CLIENT_ERROR
197
198=head2  MEMCACHED_CONNECTION_BIND_FAILURE
199
200=head2  MEMCACHED_CONNECTION_SOCKET_CREATE_FAILURE
201
202=head2  MEMCACHED_DATA_DOES_NOT_EXIST
203
204=head2  MEMCACHED_DATA_EXISTS
205
206=head2  MEMCACHED_DELETED
207
208=head2  MEMCACHED_END
209
210=head2  MEMCACHED_ERRNO
211
212=head2  MEMCACHED_FAILURE
213
214=head2  MEMCACHED_FAIL_UNIX_SOCKET
215
216=head2  MEMCACHED_FETCH_NOTFINISHED
217
218=head2  MEMCACHED_HOST_LOOKUP_FAILURE
219
220=head2  MEMCACHED_MAXIMUM_RETURN
221
222=head2  MEMCACHED_MEMORY_ALLOCATION_FAILURE
223
224=head2  MEMCACHED_NOTFOUND
225
226=head2  MEMCACHED_NOTSTORED
227
228=head2  MEMCACHED_NOT_SUPPORTED
229
230=head2  MEMCACHED_NO_KEY_PROVIDED
231
232=head2  MEMCACHED_NO_SERVERS
233
234=head2  MEMCACHED_PARTIAL_READ
235
236=head2  MEMCACHED_PROTOCOL_ERROR
237
238=head2  MEMCACHED_READ_FAILURE
239
240=head2  MEMCACHED_SERVER_ERROR
241
242=head2  MEMCACHED_SOME_ERRORS
243
244=head2  MEMCACHED_STAT
245
246=head2  MEMCACHED_STORED
247
248=head2  MEMCACHED_SUCCESS
249
250=head2  MEMCACHED_TIMEOUT
251
252=head2  MEMCACHED_UNKNOWN_READ_FAILURE
253
254=head2  MEMCACHED_VALUE
255
256=head2  MEMCACHED_WRITE_FAILURE
257
258=head2 F_STORABLE
259
260For internal use. Indicates the value was serialized via Storable.
261
262=head2 F_COMPRESS
263
264For internal use. Indicates the value was compressed via Compress::Zlib.
265
266=head1 AUTHOR
267
268Copyright (c) 2008 Daisuke Maki E<lt>daisuke@endeworks.jpE<gt>
269
270=head1 LICENSE
271
272This program is free software; you can redistribute it and/or modify it
273under the same terms as Perl itself.
274
275See http://www.perl.com/perl/misc/Artistic.html
276
277=cut
Note: See TracBrowser for help on using the browser.