File Coverage

blib/lib/MooseX/WithCache.pm
Criterion Covered Total %
statement 7 9 77.7
branch 1 2 50.0
condition n/a
subroutine 3 3 100.0
pod n/a
total 11 14 78.5


line stmt bran cond sub pod time code
1              
2             package MooseX::WithCache;
3 2     2   1481 use 5.008;
  2         6  
  2         90  
4 2 50   2   10 use constant DEBUG => $ENV{MOOSEX_WITHCACHE_DEBUG} ? 1 : 0;
  2         3  
  2         87  
5 2     2   931 use MooseX::Role::Parameterized;
  0            
  0            
6             our $VERSION = '0.01002';
7             our $AUTHORITY = 'cpan:DMAKI';
8             my %BACKENDS;
9              
10             # This is solely for backwards compatibility
11             use Moose::Exporter;
12             Moose::Exporter->setup_import_methods(
13             with_caller => [ 'with_cache' ],
14             );
15              
16             sub with_cache {
17             my ($caller, $name, %args) = @_;
18              
19             Carp::carp("use of with_cache for MooseX::WithCache is now deprecated. Use parameterized roles directly");
20              
21             Moose::Util::apply_all_roles(
22             $caller,
23             __PACKAGE__, {
24             %args,
25             name => $name,
26             }
27             );
28             }
29              
30             parameter backend => (
31             isa => 'Str',
32             required => 1,
33             default => 'Cache::Memcached',
34             );
35              
36             parameter name => (
37             isa => 'Str',
38             required => 1,
39             default => 'cache'
40             );
41              
42             role {
43             my $p = shift;
44              
45             my $name = $p->name;
46             my $backend_class = $p->backend;
47              
48             if ($backend_class !~ s/^\+//) {
49             $backend_class = "MooseX::WithCache::Backend::$backend_class";
50             }
51             Class::MOP::load_class($backend_class);
52             my $backend = $BACKENDS{ $backend_class };
53             if (! $backend ) {
54             $backend = $backend_class->new();
55             $BACKENDS{ $backend_class } = $backend;
56             }
57              
58             has $name => (
59             is => 'rw',
60             isa => $backend->cache_type(),
61             coerce => $backend->can_coerce(),
62             );
63              
64             has cache_disabled => (
65             is => 'rw',
66             isa => 'Bool',
67             default => 0
68             );
69              
70             # key generator generates the appropriate cache key from given key(s).
71             has cache_key_generator => (
72             is => 'rw',
73             does => 'MooseX::WithCache::KeyGenerator',
74             );
75              
76             method __get_cache => sub { $_[0]->$name };
77             method cache_debug => sub {
78             my $self = shift;
79             print STDERR "[CACHE]: @_\n";
80             };
81              
82             my $methods = $backend->methods();
83             while (my($method, $code) = each %$methods) {
84             method $method, $code;
85             }
86             };
87              
88             1;
89              
90             __END__
91              
92             =head1 NAME
93              
94             MooseX::WithCache - Easy Cache Access From Moose Objects
95              
96             =head1 SYNOPSIS
97              
98             package MyObject;
99             use Moose;
100             use MooseX::WithCache;
101              
102             with 'MooseX::WithCache' => {
103             backend => 'Cache::Memcached',
104             );
105              
106             no Moose;
107              
108             sub get_foo {
109             my $self = shift;
110             my $foo = $self->cache_get( 'foo' );
111             if ($foo) {
112             $foo = $self->get_froo_from_database();
113             $self->cache_set(foo => $foo);
114             }
115             return $foo;
116             }
117              
118             # main.pl
119             my $object = MyObject->new(
120             cache => Cache::Memcached->new({ ... })
121             );
122              
123             my $foo = $object->get_foo();
124              
125             # if you want to do something with the cache object,
126             # you can access it via the name you gave in with staemtent
127             #
128             # with 'MooseX::WithCache' => {
129             # name => 'cache', # default
130             # ....
131             # }
132              
133             my $cache = $object->cache;
134              
135             =head1 DESCRIPTION
136              
137             MooseX::WithCache gives your object instant access to cache objects.
138              
139             MooseX::WithCache s not a cache object, it just gives your convinient methods
140             to access the cache through your objects.
141              
142             By default, it gives you 3 methods:
143              
144             cache_get($key)
145             cache_set($key, $value, $expires)
146             cache_del($key)
147              
148             But if there's a backend provided for it, you may get extra methods tailored
149             for that cache. For example, for Cache::Memcached, the backend provides
150             these additional methods:
151              
152             cache_get_multi(@keys);
153             cache_incr($key);
154             cache_decr($key);
155              
156             =head2 STOP THAT CACHE
157              
158             Data extraction/injection to the cache can be disabled. Simply set
159             the cache_disabled() attribute that gets installed
160              
161             $object->cache_disabled(1);
162             $object->cache_get($key); # won't even try
163              
164             =head2 DEBUG OUTPUT
165              
166             You can inspect what's going on with respect to the cache, if you specify
167             MOOSEX_WITHCACHE_DEBUG=1 in the environment. This will caue MooseX::WithCache to
168             display messages to STDERR.
169              
170             =head2 KEY GENERATION
171              
172             Sometimes you want to give compound keys, or simply transform the cache keys
173             somehow to normalize them.
174              
175             MooseX::WithCache supports this through the cache_key_generator attribute.
176             The cache_key_generator simply needs to be a MooseX::WithCache::KeyGenerator
177             instance, which accepts whatever key provided, and returns a new key.
178              
179             For example, if you want to provide complex key that is a perl structure,
180             and use its MD5 as the key, you can use MooseX::WithCache::KeyGenerator::DumpChecksum
181             to generate the keys.
182              
183             Simply specify it in the constructor:
184              
185             MyObject->new(
186             cache => ...,
187             cache_key_generator => MooseX::WithCache::KeyGenerator::DumpChecksum->new()
188             );
189              
190             =head1 AUTHOR
191              
192             Daisuke Maki C<< <daisuke@endeworks.jp> >>
193              
194             =head1 LICENSE
195              
196             This program is free software; you can redistribute it and/or modify it
197             under the same terms as Perl itself.
198              
199             See http://www.perl.com/perl/misc/Artistic.html
200              
201             =cut