File Coverage

blib/lib/MooseX/WithCache.pm
Criterion Covered Total %
statement 14 17 82.3
branch 1 2 50.0
condition n/a
subroutine 5 6 83.3
pod 0 1 0.0
total 20 26 76.9


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