1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
# $Id$
package Data::ObjectDriver::Driver::Cache::Memcached;
use strict;
use warnings;
use base qw( Data::ObjectDriver::Driver::BaseCache );
sub deflate {
my $driver = shift;
my($obj) = @_;
$obj->deflate;
}
sub inflate {
my $driver = shift;
my($class, $data) = @_;
$class->inflate($data);
}
my %memc_method_for = (
add_to_cache => 'add',
update_cache => 'set',
remove_from_cache => 'delete',
get_from_cache => 'get',
get_multi_from_cache => 'get_multi',
);
for my $driver_method (keys %memc_method_for) {
my $memc_method = $memc_method_for{$driver_method};
my $sub = sub {
my $driver = shift;
$driver->start_query('MEMCACHED_' . uc($memc_method) . ' ?', \@_);
my $ret = $driver->cache->$memc_method(@_);
$driver->end_query(undef);
if ($Data::ObjectDriver::RESTRICT_IO) {
die "Attempted MemCached I/O while in restricted mode: $memc_method";
}
return if !defined $ret;
return $ret;
};
no strict 'refs';
*{join q{::}, __PACKAGE__, $driver_method} = $sub;
}
1;
__END__
=head1 NAME
Data::ObjectDriver::Driver::Cache::Memcached - object driver for caching objects with memcached
=head1 SYNOPSIS
package MyObject;
use base qw( Data::ObjectDriver::BaseObject );
__PACKAGE__->install_properties({
...
driver => Data::ObjectDriver::Driver::Cache::Memcached->new(
cache => Cache::Memcached->new({ servers => \@MEMCACHED_SERVERS }),
fallback => Data::ObjectDriver::Driver::DBI->new( @$DBI_INFO ),
),
...
});
1;
=head1 DESCRIPTION
I<Data::ObjectDriver::Driver::Cache::Memcached> provides automatic caching of
retrieved objects in your memcached servers, when used in conjunction with your
actual object driver.
=head1 USAGE
=over 4
=item * Data::ObjectDriver::Driver::Cache::Memcached->new( %params )
Required members of C<%params> are:
=over 4
=item * C<cache>
The C<Cache::Memcached> instance representing your pool of memcached servers.
See L<Cache::Memcached>.
=item * C<fallback>
The C<Data::ObjectDriver> object driver from which to request objects that are
not found in your memcached servers.
=back
=back
=head1 DIAGNOSTICS
The memcached driver provides integration with the C<Data::ObjectDriver> debug
and profiling systems. As these systems are designed around SQL queries,
synthetic queries are logged to represent memcached operations. The operations
generated by this driver are:
=over 4
=item * C<MEMCACHED_ADD ?>
Put an item in the cache that was not there. The arguments are the cache key
for the object and the flattened representation of the object to cache.
=item * C<MEMCACHED_SET ?>
Put an item in the cache with new member data. The arguments are the cache key
for the object and the flattened representation of the object to cache.
=item * C<MEMCACHED_DELETE ?>
Remove an object from the cache. The argument is the cache key for the object
to invalidate.
=item * C<MEMCACHED_GET ?>
Retrieve an object. The argument is the cache key for the requested object.
=item * C<MEMCACHED_GET_MULTI ?>
Retrieve a set of objects. The arguments are the cache keys for the requested
objects.
=back
=head1 SEE ALSO
C<Cache::Memcached>, http://www.danga.com/memcached/
=head1 LICENSE
I<Data::ObjectDriver> is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR & COPYRIGHT
Except where otherwise noted, I<Data::ObjectDriver> is Copyright 2005-2006
Six Apart, cpan@sixapart.com. All rights reserved.
=cut
|
