3 package Catalyst::Plugin::Cache;
4 use base qw(Class::Accessor::Fast Class::Data::Inheritable);
12 use Catalyst::Utils ();
16 use Catalyst::Plugin::Cache::Curried;
18 __PACKAGE__->mk_classdata( "_cache_backends" );
19 __PACKAGE__->mk_accessors( "_default_curried_cache" );
24 # set it once per app, not once per plugin,
25 # and don't overwrite if some plugin was wicked
26 $app->_cache_backends({}) unless $app->_cache_backends;
28 my $ret = $app->maybe::next::method( @_ );
30 $app->setup_cache_backends;
36 sub _get_cache_plugin_config {
38 my $config = $app->config->{'Plugin::Cache'};
40 $config = $app->config->{cache};
41 my $appname = ref($app);
42 if (! $has_warned_for{$appname}++ ) {
43 $app->log->warn($config ?
44 'Catalyst::Plugin::Cache config found in deprecated $c->config->{cache}, please move to $c->config->{"Plugin::Cache"}.'
45 : 'Catalyst::Plugin::Cache config not found, using empty config!'
53 sub get_default_cache_backend_config {
54 my ( $app, $name ) = @_;
55 $app->_get_cache_plugin_config->{backend} || $app->get_cache_backend_config("default");
58 sub get_cache_backend_config {
59 my ( $app, $name ) = @_;
60 $app->_get_cache_plugin_config->{backends}{$name};
63 sub setup_cache_backends {
66 # give plugins a chance to find things for themselves
67 $app->maybe::next::method;
69 # FIXME - Don't know why the _get_cache_plugin_config method doesn't work here!
70 my $conf = $app->_get_cache_plugin_config->{backends};
71 foreach my $name ( keys %$conf ) {
72 next if $app->get_cache_backend( $name );
73 $app->setup_generic_cache_backend( $name, $app->get_cache_backend_config( $name ) || {} );
76 if ( !$app->get_cache_backend("default") ) {
77 ### XXX currently we dont have a fallback scenario
78 ### so die here with the error message. Once we have
79 ### an in memory fallback, we may consider silently
80 ### logging the error and falling back to that.
81 ### If we dont die here, the app will silently start
82 ### up and then explode at the first cache->get or
83 ### cache->set request with a FIXME error
86 $app->setup_generic_cache_backend( default => $app->get_default_cache_backend_config || {} );
92 sub default_cache_store {
94 $app->_get_cache_plugin_config->{default_store} || $app->guess_default_cache_store;
97 sub guess_default_cache_store {
100 my @stores = map { /Cache::Store::(.*)$/ ? $1 : () } $app->registered_plugins;
102 if ( @stores == 1 ) {
105 Carp::croak "You must configure a default store type unless you use exactly one store plugin.";
109 sub setup_generic_cache_backend {
110 my ( $app, $name, $config ) = @_;
111 my %config = %$config;
113 if ( my $class = delete $config{class} ) {
115 ### try as list and as hashref, collect the
116 ### error if things go wrong
117 ### if all goes well, exit the loop
119 for my $aref ( [%config], [\%config] ) {
120 eval { $app->setup_cache_backend_by_class(
121 $name, $class, @$aref
123 } ? do { @errors = (); last }
124 : push @errors, "\t$@";
127 ### and die with the errors if we have any
128 die "Couldn't construct $class with either list style or hash ref style param passing:\n @errors" if @errors;
130 } elsif ( my $store = delete $config->{store} || $app->default_cache_store ) {
131 my $method = lc("setup_${store}_cache_backend");
133 Carp::croak "You must load the $store cache store plugin (if it exists). ".
134 "Please consult the Catalyst::Plugin::Cache documentation on how to configure hetrogeneous stores."
135 unless $app->can($method);
137 $app->$method( $name, \%config );
139 $app->log->warn("Couldn't setup the cache backend named '$name'");
143 sub setup_cache_backend_by_class {
144 my ( $app, $name, $class, @args ) = @_;
145 Catalyst::Utils::ensure_class_loaded( $class );
146 $app->register_cache_backend( $name => $class->new( @args ) );
149 # end of spaghetti setup DWIM
152 my ( $c, @meta ) = @_;
156 return ( $c->get_preset_curried($name) || $c->get_cache_backend($name) );
158 # be nice and always return the same one for the simplest case
159 return ( $c->_default_curried_cache || $c->_default_curried_cache( $c->curry_cache( @meta ) ) );
161 return $c->curry_cache( @meta );
165 sub construct_curried_cache {
166 my ( $c, @meta ) = @_;
167 return $c->curried_cache_class( @meta )->new( @meta );
170 sub curried_cache_class {
171 my ( $c, @meta ) = @_;
172 $c->_get_cache_plugin_config->{curried_class} || "Catalyst::Plugin::Cache::Curried";
176 my ( $c, @meta ) = @_;
177 return $c->construct_curried_cache( $c, $c->_cache_caller_meta, @meta );
180 sub get_preset_curried {
181 my ( $c, $name ) = @_;
183 if ( ref( my $preset = $c->_get_cache_plugin_config->{profiles}{$name} ) ) {
184 return $preset if Scalar::Util::blessed($preset);
186 my @meta = ( ( ref $preset eq "HASH" ) ? %$preset : @$preset );
187 return $c->curry_cache( @meta );
193 sub get_cache_backend {
194 my ( $c, $name ) = @_;
195 $c->_cache_backends->{$name};
198 sub register_cache_backend {
199 my ( $c, $name, $backend ) = @_;
201 no warnings 'uninitialized';
202 Carp::croak("$backend does not look like a cache backend - "
203 . "it must be an object supporting get, set and remove")
204 unless eval { $backend->can("get") && $backend->can("set") && $backend->can("remove") };
206 $c->_cache_backends->{$name} = $backend;
209 sub unregister_cache_backend {
210 my ( $c, $name ) = @_;
211 delete $c->_cache_backends->{$name};
214 sub default_cache_backend {
216 $c->get_cache_backend( "default" ) || $c->temporary_cache_backend;
219 sub temporary_cache_backend {
221 die "FIXME - make up an in memory cache backend, that hopefully works well for the current engine";
224 sub _cache_caller_meta {
227 my ( $caller, $component, $controller );
229 for my $i ( 0 .. 15 ) { # don't look to far
230 my @info = caller(2 + $i) or last;
232 $caller ||= \@info unless $info[0] =~ /Plugin::Cache/;
233 $component ||= \@info if $info[0]->isa("Catalyst::Component");
234 $controller ||= \@info if $info[0]->isa("Catalyst::Controller");
236 last if $caller && $component && $controller;
239 my ( $caller_pkg, $component_pkg, $controller_pkg ) =
240 map { $_ ? $_->[0] : undef } $caller, $component, $controller;
243 'caller' => $caller_pkg,
244 component => $component_pkg,
245 controller => $controller_pkg,
246 caller_frame => $caller,
247 component_frame => $component,
248 controller_frame => $controller,
252 # this gets a shit name so that the plugins can override a good name
253 sub choose_cache_backend_wrapper {
254 my ( $c, @meta ) = @_;
256 Carp::croak("metadata must be an even sized list") unless @meta % 2 == 0;
260 unless ( exists $meta{'caller'} ) {
261 my %caller = $c->_cache_caller_meta;
262 @meta{keys %caller} = values %caller;
265 # allow the cache client to specify who it wants to cache with (but loeave room for a hook)
266 if ( exists $meta{backend} ) {
267 if ( Scalar::Util::blessed($meta{backend}) ) {
268 return $meta{backend};
270 return $c->get_cache_backend( $meta{backend} ) || $c->default_cache_backend;
274 if ( my $chosen = $c->choose_cache_backend( %meta ) ) {
275 $chosen = $c->get_cache_backend( $chosen ) unless Scalar::Util::blessed($chosen); # if it's a name find it
276 return $chosen if Scalar::Util::blessed($chosen); # only return if it was an object or name lookup worked
279 # die "no such backend"?
280 # currently, we fall back to default
283 return $c->default_cache_backend;
286 sub choose_cache_backend { shift->maybe::next::method( @_ ) } # a convenient fallback
289 my ( $c, $key, $value, %meta ) = @_;
290 $c->choose_cache_backend_wrapper( key => $key, value => $value, %meta )
291 ->set( $key, $value, exists $meta{expires} ? $meta{expires} : () );
295 my ( $c, $key, @meta ) = @_;
296 $c->choose_cache_backend_wrapper( key => $key, @meta )->get( $key );
300 my ( $c, $key, @meta ) = @_;
301 $c->choose_cache_backend_wrapper( key => $key, @meta )->remove( $key );
305 my ($c, $key, $code, %meta) = @_;
307 my $backend = $c->choose_cache_backend_wrapper( key => $key, %meta );
308 if ($backend->can('compute')) {
309 return $backend->compute( $key, $code, exists $meta{expires} ? $meta{expires} : () );
312 Carp::croak "must specify key and code" unless defined($key) && defined($code);
314 my $value = $c->cache_get( $key, %meta );
315 if ( !defined $value ) {
317 $c->cache_set( $key, $value, %meta );
330 Catalyst::Plugin::Cache - Flexible caching support for Catalyst.
338 # configure a backend or use a store plugin
339 __PACKAGE__->config->{'Plugin::Cache'}{backend} = {
340 class => "Cache::Bounded",
341 # ... params for Cache::Bounded...
344 # typical example for Cache::Memcached::libmemcached
345 __PACKAGE__->config->{'Plugin::Cache'}{backend} = {
346 class => "Cache::Memcached::libmemcached",
347 servers => ['127.0.0.1:11211'],
355 my ( $self, $c, $id ) = @_;
357 my $cache = $c->cache;
361 unless ( $result = $cache->get( $id ) ) {
362 # ... calculate result ...
363 $c->cache->set( $id, $result );
369 This plugin gives you access to a variety of systems for caching
370 data. It allows you to use a very simple configuration API, while
371 maintaining the possibility of flexibility when you need it later.
373 Among its features are support for multiple backends, segmentation based
374 on component or controller, keyspace partitioning, and so more, in
375 various subsidiary plugins.
381 =item cache $profile_name
385 Return a curried object with metadata from C<$profile_name> or as
386 explicitly specified.
388 If a profile by the name C<$profile_name> doesn't exist, but a backend
389 object by that name does exist, the backend will be returned instead,
390 since the interface for curried caches and backends is almost identical.
392 This method can also be called without arguments, in which case is
393 treated as though the C<%meta> hash was empty.
395 See L</METADATA> for details.
397 =item curry_cache %meta
399 Return a L<Catalyst::Plugin::Cache::Curried> object, curried with C<%meta>.
401 See L</METADATA> for details.
403 =item cache_set $key, $value, %meta
405 =item cache_get $key, %meta
407 =item cache_remove $key, %meta
409 =item cache_compute $key, $code, %meta
411 These cache operations will call L<choose_cache_backend> with %meta, and
412 then call C<set>, C<get>, C<remove>, or C<compute> on the resulting backend
415 If the backend object does not support C<compute> then we emulate it by
416 calling L<cache_get>, and if the returned value is undefined we call the passed
417 code reference, stores the returned value with L<cache_set>, and then returns
418 the value. Inspired by L<CHI>.
420 =item choose_cache_backend %meta
422 Select a backend object. This should return undef if no specific backend
423 was selected - its caller will handle getting C<default_cache_backend>
426 This method is typically used by plugins.
428 =item get_cache_backend $name
430 Get a backend object by name.
432 =item default_cache_backend
434 Return the default backend object.
436 =item temporary_cache_backend
438 When no default cache backend is configured this method might return a
439 backend known to work well with the current L<Catalyst::Engine>. This is
450 Whenever you set or retrieve a key you may specify additional metadata
451 that will be used to select a specific backend.
453 This metadata is very freeform, and the only key that has any meaning by
454 default is the C<backend> key which can be used to explicitly choose a backend
457 The C<choose_cache_backend> method can be overridden in order to
458 facilitate more intelligent backend selection. For example,
459 L<Catalyst::Plugin::Cache::Choose::KeyRegexes> overrides that method to
460 select a backend based on key regexes.
462 Another example is a L<Catalyst::Plugin::Cache::ControllerNamespacing>,
463 which wraps backends in objects that perform key mangling, in order to
464 keep caches namespaced per controller.
466 However, this is generally left as a hook for larger, more complex
467 applications. Most configurations should make due XXXX
469 The simplest way to dynamically select a backend is based on the
470 L</Cache Profiles> configuration.
472 =head2 Meta Data Keys
474 C<choose_cache_backend> is called with some default keys.
480 Supplied by C<cache_get>, C<cache_set>, and C<cache_remove>.
484 Supplied by C<cache_set>.
488 The package name of the innermost caller that doesn't match
489 C<qr/Plugin::Cache/>.
493 The entire C<caller($i)> frame of C<caller>.
497 The package name of the innermost caller who C<isa>
498 L<Catalyst::Component>.
500 =item component_frame
502 This entire C<caller($i)> frame of C<component>.
506 The package name of the innermost caller who C<isa>
507 L<Catalyst::Controller>.
509 =item controller_frame
511 This entire C<caller($i)> frame of C<controller>.
515 =head2 Metadata Currying
517 In order to avoid specifying C<%meta> over and over again you may call
518 C<cache> or C<curry_cache> with C<%meta> once, and get back a B<curried
519 cache object>. This object responds to the methods C<get>, C<set>, and
520 C<remove>, by appending its captured metadata and delegating them to
521 C<cache_get>, C<cache_set>, and C<cache_remove>.
523 This is simpler than it sounds.
525 Here is an example using currying:
527 my $cache = $c->cache( %meta ); # cache is curried
529 $cache->set( $key, $value );
533 And here is an example without using currying:
535 $c->cache_set( $key, $value, %meta );
537 $c->cache_get( $key, %meta );
539 See L<Catalyst::Plugin::Cache::Curried> for details.
543 $c->config->{'Plugin::Cache'} = {
547 All configuration parameters should be provided in a hash reference
548 under the C<Plugin::Cache> key in the C<config> hash.
550 =head2 Backend Configuration
552 Configuring backend objects is done by adding hash entries under the
553 C<backends> key in the main config.
555 A special case is that the hash key under the C<backend> (singular) key
556 of the main config is assumed to be the backend named C<default>.
562 Instantiate a backend from a L<Cache> compatible class. E.g.
564 $c->config->{'Plugin::Cache'}{backends}{small_things} = {
565 class => "Cache::Bounded",
570 $c->config->{'Plugin::Cache'}{backends}{large_things} = {
571 class => "Cache::Memcached",
572 data => '1.2.3.4:1234',
575 The options in the hash are passed to the class's C<new> method.
577 The class will be C<required> as necessary during setup time.
581 Instantiate a backend using a store plugin, e.g.
583 $c->config->{'Plugin::Cache'}{backend} = {
587 Store plugins typically require less configuration because they are
588 specialized for L<Catalyst> applications. For example
589 L<Catalyst::Plugin::Cache::Store::FastMmap> will specify a default
590 C<share_file>, and additionally use a subclass of L<Cache::FastMmap>
591 that can also store non reference data.
593 The store plugin must be loaded.
597 =head2 Cache Profiles
603 Supply your own predefined profiles for cache metadata, when using the
606 For example when you specify
608 $c->config->{'Plugin::Cache'}{profiles}{thumbnails} = {
609 backend => "large_things",
612 And then get a cache object like this:
614 $c->cache("thumbnails");
616 It is the same as if you had done:
618 $c->cache( backend => "large_things" );
622 =head2 Miscellaneous Configuration
628 When you do not specify a C<store> parameter in the backend
629 configuration this one will be used instead. This configuration
630 parameter is not necessary if only one store plugin is loaded.
640 An object that responds to the methods detailed in
641 L<Catalyst::Plugin::Cache::Backend> (or more).
645 A plugin that provides backends of a certain type. This is a bit like a
650 Stored key/value pairs of data for easy re-access.
654 "Extra" information about the item being stored, which can be used to
655 locate an appropriate backend.
659 my $cache = $c->cache(type => 'thumbnails');
660 $cache->set('pic01', $thumbnaildata);
662 A cache which has been pre-configured with a particular set of
663 namespacing data. In the example the cache returned could be one
664 specifically tuned for storing thumbnails.
666 An object that responds to C<get>, C<set>, and C<remove>, and will
667 automatically add metadata to calls to C<< $c->cache_get >>, etc.
673 L<Cache> - the generic cache API on CPAN.
675 L<Catalyst::Plugin::Cache::Store> - how to write a store plugin.
677 L<Catalyst::Plugin::Cache::Curried> - the interface for curried caches.
679 L<Catalyst::Plugin::Cache::Choose::KeyRegexes> - choose a backend based on
680 regex matching on the keys. Can be used to partition the keyspace.
682 L<Catalyst::Plugin::Cache::ControllerNamespacing> - wrap backend objects in a
683 name mangler so that every controller gets its own keyspace.
687 Yuval Kogman, C<nothingmuch@woobling.org>
689 Jos Boumans, C<kane@cpan.org>
691 =head1 COPYRIGHT & LICENSE
693 Copyright (c) Yuval Kogman, 2006. All rights reserved.
695 This library is free software, you can redistribute it and/or modify it under
696 the same terms as Perl itself, as well as under the terms of the MIT license.