lib/Catalyst/Plugin/Cache.pm

   1 #!/usr/bin/perl
   2
   3 package Catalyst::Plugin::Cache;
   4 use base qw(Class::Accessor::Fast Class::Data::Inheritable);
   5
   6 use strict;
   7 use warnings;
   8
   9 our $VERSION = "0.08";
  10
  11 use Scalar::Util ();
  12 use Catalyst::Utils ();
  13 use Carp ();
  14 use MRO::Compat;
  15
  16 use Catalyst::Plugin::Cache::Curried;
  17
  18 __PACKAGE__->mk_classdata( "_cache_backends" );
  19 __PACKAGE__->mk_accessors( "_default_curried_cache" );
  20
  21 sub setup {
  22     my $app = shift;
  23
  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;
  27
  28     my $ret = $app->maybe::next::method( @_ );
  29
  30     $app->setup_cache_backends;
  31
  32     $ret;
  33 }
  34 {
  35     my %has_warned_for;
  36     sub _get_cache_plugin_config {
  37         my ($app) = @_;
  38         my $config = $app->config->{'Plugin::Cache'};
  39         if (!$config) {
  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!'
  46                 );
  47             }
  48         }
  49         return $config || {};
  50     }
  51 }
  52
  53 sub get_default_cache_backend_config {
  54     my ( $app, $name ) = @_;
  55     $app->_get_cache_plugin_config->{backend} || $app->get_cache_backend_config("default");
  56 }
  57
  58 sub get_cache_backend_config {
  59     my ( $app, $name ) = @_;
  60     $app->_get_cache_plugin_config->{backends}{$name};
  61 }
  62
  63 sub setup_cache_backends {
  64     my $app = shift;
  65
  66     # give plugins a chance to find things for themselves
  67     $app->maybe::next::method;
  68
  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 ) || {} );
  74     }
  75
  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
  84         #local $@;
  85         #eval {
  86         $app->setup_generic_cache_backend( default => $app->get_default_cache_backend_config || {} );
  87         #};
  88
  89    }
  90 }
  91
  92 sub default_cache_store {
  93     my $app = shift;
  94     $app->_get_cache_plugin_config->{default_store} || $app->guess_default_cache_store;
  95 }
  96
  97 sub guess_default_cache_store {
  98     my $app = shift;
  99
 100     my @stores = map { /Cache::Store::(.*)$/ ? $1 : () } $app->registered_plugins;
 101
 102     if ( @stores == 1 ) {
 103         return $stores[0];
 104     } else {
 105         Carp::croak "You must configure a default store type unless you use exactly one store plugin.";
 106     }
 107 }
 108
 109 sub setup_generic_cache_backend {
 110     my ( $app, $name, $config ) = @_;
 111     my %config = %$config;
 112
 113     if ( my $class = delete $config{class} ) {
 114
 115         ### try as list and as hashref, collect the
 116         ### error if things go wrong
 117         ### if all goes well, exit the loop
 118         my @errors;
 119         for my $aref ( [%config], [\%config] ) {
 120             eval { $app->setup_cache_backend_by_class(
 121                         $name, $class, @$aref
 122                     );
 123             } ? do { @errors = (); last }
 124               : push @errors, "\t$@";
 125         }
 126
 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;
 129
 130     } elsif ( my $store = delete $config->{store} || $app->default_cache_store ) {
 131         my $method = lc("setup_${store}_cache_backend");
 132
 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);
 136
 137         $app->$method( $name, \%config );
 138     } else {
 139         $app->log->warn("Couldn't setup the cache backend named '$name'");
 140     }
 141 }
 142
 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 ) );
 147 }
 148
 149 # end of spaghetti setup DWIM
 150
 151 sub cache {
 152     my ( $c, @meta ) = @_;
 153
 154     if ( @meta == 1 ) {
 155         my $name = $meta[0];
 156         return ( $c->get_preset_curried($name) || $c->get_cache_backend($name) );
 157     } elsif ( !@meta ) {
 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 ) ) );
 160     } else {
 161         return $c->curry_cache( @meta );
 162     }
 163 }
 164
 165 sub construct_curried_cache {
 166     my ( $c, @meta ) = @_;
 167     return $c->curried_cache_class( @meta )->new( @meta );
 168 }
 169
 170 sub curried_cache_class {
 171     my ( $c, @meta ) = @_;
 172     $c->_get_cache_plugin_config->{curried_class} || "Catalyst::Plugin::Cache::Curried";
 173 }
 174
 175 sub curry_cache {
 176     my ( $c, @meta ) = @_;
 177     return $c->construct_curried_cache( $c, $c->_cache_caller_meta, @meta );
 178 }
 179
 180 sub get_preset_curried {
 181     my ( $c, $name ) = @_;
 182
 183     if ( ref( my $preset = $c->_get_cache_plugin_config->{profiles}{$name} ) ) {
 184         return $preset if Scalar::Util::blessed($preset);
 185
 186         my @meta = ( ( ref $preset eq "HASH" ) ? %$preset : @$preset );
 187         return $c->curry_cache( @meta );
 188     }
 189
 190     return;
 191 }
 192
 193 sub get_cache_backend {
 194     my ( $c, $name ) = @_;
 195     $c->_cache_backends->{$name};
 196 }
 197
 198 sub register_cache_backend {
 199     my ( $c, $name, $backend ) = @_;
 200
 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") };
 205
 206     $c->_cache_backends->{$name} = $backend;
 207 }
 208
 209 sub unregister_cache_backend {
 210     my ( $c, $name ) = @_;
 211     delete $c->_cache_backends->{$name};
 212 }
 213
 214 sub default_cache_backend {
 215     my $c = shift;
 216     $c->get_cache_backend( "default" ) || $c->temporary_cache_backend;
 217 }
 218
 219 sub temporary_cache_backend {
 220     my $c = shift;
 221     die "FIXME - make up an in memory cache backend, that hopefully works well for the current engine";
 222 }
 223
 224 sub _cache_caller_meta {
 225     my $c = shift;
 226
 227     my ( $caller, $component, $controller );
 228
 229     for my $i ( 0 .. 15 ) { # don't look to far
 230         my @info = caller(2 + $i) or last;
 231
 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");
 235
 236         last if $caller && $component && $controller;
 237     }
 238
 239     my ( $caller_pkg, $component_pkg, $controller_pkg ) =
 240         map { $_ ? $_->[0] : undef } $caller, $component, $controller;
 241
 242     return (
 243         'caller'   => $caller_pkg,
 244         component  => $component_pkg,
 245         controller => $controller_pkg,
 246         caller_frame     => $caller,
 247         component_frame  => $component,
 248         controller_frame => $controller,
 249     );
 250 }
 251
 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 ) = @_;
 255
 256     Carp::croak("metadata must be an even sized list") unless @meta % 2 == 0;
 257
 258     my %meta = @meta;
 259
 260     unless ( exists $meta{'caller'} ) {
 261         my %caller = $c->_cache_caller_meta;
 262         @meta{keys %caller} = values %caller;
 263     }
 264
 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};
 269         } else {
 270             return $c->get_cache_backend( $meta{backend} ) || $c->default_cache_backend;
 271         }
 272     };
 273
 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
 277
 278         # FIXME
 279         # die "no such backend"?
 280         # currently, we fall back to default
 281     }
 282
 283     return $c->default_cache_backend;
 284 }
 285
 286 sub choose_cache_backend { shift->maybe::next::method( @_ ) } # a convenient fallback
 287
 288 sub cache_set {
 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} : () );
 292 }
 293
 294 sub cache_get {
 295     my ( $c, $key, @meta ) = @_;
 296     $c->choose_cache_backend_wrapper( key => $key, @meta )->get( $key );
 297 }
 298
 299 sub cache_remove {
 300     my ( $c, $key, @meta ) = @_;
 301     $c->choose_cache_backend_wrapper( key => $key, @meta )->remove( $key );
 302 }
 303
 304 __PACKAGE__;
 305
 306 __END__
 307
 308 =pod
 309
 310 =head1 NAME
 311
 312 Catalyst::Plugin::Cache - Flexible caching support for Catalyst.
 313
 314 =head1 SYNOPSIS
 315
 316         use Catalyst qw/
 317         Cache
 318     /;
 319
 320     # configure a backend or use a store plugin
 321     __PACKAGE__->config->{'Plugin::Cache'}{backend} = {
 322         class => "Cache::Bounded",
 323         # ... params for Cache::Bounded...
 324     };
 325
 326     # typical example for Cache::Memcached::libmemcached
 327     __PACKAGE__->config->{'Plugin::Cache'}{backend} = {
 328         class   => "Cache::Memcached::libmemcached",
 329         servers => ['127.0.0.1:11211'],
 330         debug   => 2,
 331     };
 332
 333
 334     # In a controller:
 335
 336     sub foo : Local {
 337         my ( $self, $c, $id ) = @_;
 338
 339         my $cache = $c->cache;
 340
 341         my $result;
 342
 343         unless ( $result = $cache->get( $id ) ) {
 344             # ... calculate result ...
 345             $c->cache->set( $id, $result );
 346         }
 347     };
 348
 349 =head1 DESCRIPTION
 350
 351 This plugin gives you access to a variety of systems for caching
 352 data. It allows you to use a very simple configuration API, while
 353 maintaining the possibility of flexibility when you need it later.
 354
 355 Among its features are support for multiple backends, segmentation based
 356 on component or controller, keyspace partitioning, and so more, in
 357 various subsidiary plugins.
 358
 359 =head1 METHODS
 360
 361 =over 4
 362
 363 =item cache $profile_name
 364
 365 =item cache %meta
 366
 367 Return a curried object with metadata from C<$profile_name> or as
 368 explicitly specified.
 369
 370 If a profile by the name C<$profile_name> doesn't exist, but a backend
 371 object by that name does exist, the backend will be returned instead,
 372 since the interface for curried caches and backends is almost identical.
 373
 374 This method can also be called without arguments, in which case is
 375 treated as though the C<%meta> hash was empty.
 376
 377 See L</METADATA> for details.
 378
 379 =item curry_cache %meta
 380
 381 Return a L<Catalyst::Plugin::Cache::Curried> object, curried with C<%meta>.
 382
 383 See L</METADATA> for details.
 384
 385 =item cache_set $key, $value, %meta
 386
 387 =item cache_get $key, %meta
 388
 389 =item cache_remove $key, %meta
 390
 391 These cache operations will call L<choose_cache_backend> with %meta, and
 392 then call C<set>, C<get>, or C<remove> on the resulting backend object.
 393
 394 =item choose_cache_backend %meta
 395
 396 Select a backend object. This should return undef if no specific backend
 397 was selected - its caller will handle getting C<default_cache_backend>
 398 on its own.
 399
 400 This method is typically used by plugins.
 401
 402 =item get_cache_backend $name
 403
 404 Get a backend object by name.
 405
 406 =item default_cache_backend
 407
 408 Return the default backend object.
 409
 410 =item temporary_cache_backend
 411
 412 When no default cache backend is configured this method might return a
 413 backend known to work well with the current L<Catalyst::Engine>. This is
 414 a stub.
 415
 416 =item
 417
 418 =back
 419
 420 =head1 METADATA
 421
 422 =head2 Introduction
 423
 424 Whenever you set or retrieve a key you may specify additional metadata
 425 that will be used to select a specific backend.
 426
 427 This metadata is very freeform, and the only key that has any meaning by
 428 default is the C<backend> key which can be used to explicitly choose a backend
 429 by name.
 430
 431 The C<choose_cache_backend> method can be overridden in order to
 432 facilitate more intelligent backend selection. For example,
 433 L<Catalyst::Plugin::Cache::Choose::KeyRegexes> overrides that method to
 434 select a backend based on key regexes.
 435
 436 Another example is a L<Catalyst::Plugin::Cache::ControllerNamespacing>,
 437 which wraps backends in objects that perform key mangling, in order to
 438 keep caches namespaced per controller.
 439
 440 However, this is generally left as a hook for larger, more complex
 441 applications. Most configurations should make due XXXX
 442
 443 The simplest way to dynamically select a backend is based on the
 444 L</Cache Profiles> configuration.
 445
 446 =head2 Meta Data Keys
 447
 448 C<choose_cache_backend> is called with some default keys.
 449
 450 =over 4
 451
 452 =item key
 453
 454 Supplied by C<cache_get>, C<cache_set>, and C<cache_remove>.
 455
 456 =item value
 457
 458 Supplied by C<cache_set>.
 459
 460 =item caller
 461
 462 The package name of the innermost caller that doesn't match
 463 C<qr/Plugin::Cache/>.
 464
 465 =item caller_frame
 466
 467 The entire C<caller($i)> frame of C<caller>.
 468
 469 =item component
 470
 471 The package name of the innermost caller who C<isa>
 472 L<Catalyst::Component>.
 473
 474 =item component_frame
 475
 476 This entire C<caller($i)> frame of C<component>.
 477
 478 =item controller
 479
 480 The package name of the innermost caller who C<isa>
 481 L<Catalyst::Controller>.
 482
 483 =item controller_frame
 484
 485 This entire C<caller($i)> frame of C<controller>.
 486
 487 =back
 488
 489 =head2 Metadata Currying
 490
 491 In order to avoid specifying C<%meta> over and over again you may call
 492 C<cache> or C<curry_cache> with C<%meta> once, and get back a B<curried
 493 cache object>. This object responds to the methods C<get>, C<set>, and
 494 C<remove>, by appending its captured metadata and delegating them to
 495 C<cache_get>, C<cache_set>, and C<cache_remove>.
 496
 497 This is simpler than it sounds.
 498
 499 Here is an example using currying:
 500
 501     my $cache = $c->cache( %meta ); # cache is curried
 502
 503     $cache->set( $key, $value );
 504
 505     $cache->get( $key );
 506
 507 And here is an example without using currying:
 508
 509     $c->cache_set( $key, $value, %meta );
 510
 511     $c->cache_get( $key, %meta );
 512
 513 See L<Catalyst::Plugin::Cache::Curried> for details.
 514
 515 =head1 CONFIGURATION
 516
 517     $c->config->{'Plugin::Cache'} = {
 518         ...
 519     };
 520
 521 All configuration parameters should be provided in a hash reference
 522 under the C<Plugin::Cache> key in the C<config> hash.
 523
 524 =head2 Backend Configuration
 525
 526 Configuring backend objects is done by adding hash entries under the
 527 C<backends> key in the main config.
 528
 529 A special case is that the hash key under the C<backend> (singular) key
 530 of the main config is assumed to be the backend named C<default>.
 531
 532 =over 4
 533
 534 =item class
 535
 536 Instantiate a backend from a L<Cache> compatible class. E.g.
 537
 538     $c->config->{'Plugin::Cache'}{backends}{small_things} = {
 539         class    => "Cache::Bounded",
 540         interval => 1000,
 541         size     => 10000,
 542     };
 543
 544     $c->config->{'Plugin::Cache'}{backends}{large_things} = {
 545         class => "Cache::Memcached",
 546         data  => '1.2.3.4:1234',
 547     };
 548
 549 The options in the hash are passed to the class's C<new> method.
 550
 551 The class will be C<required> as necessary during setup time.
 552
 553 =item store
 554
 555 Instantiate a backend using a store plugin, e.g.
 556
 557     $c->config->{'Plugin::Cache'}{backend} = {
 558         store => "FastMmap",
 559     };
 560
 561 Store plugins typically require less configuration because they are
 562 specialized for L<Catalyst> applications. For example
 563 L<Catalyst::Plugin::Cache::Store::FastMmap> will specify a default
 564 C<share_file>, and additionally use a subclass of L<Cache::FastMmap>
 565 that can also store non reference data.
 566
 567 The store plugin must be loaded.
 568
 569 =back
 570
 571 =head2 Cache Profiles
 572
 573 =over 4
 574
 575 =item profiles
 576
 577 Supply your own predefined profiles for cache metadata, when using the
 578 C<cache> method.
 579
 580 For example when you specify
 581
 582     $c->config->{'Plugin::Cache'}{profiles}{thumbnails} = {
 583         backend => "large_things",
 584     };
 585
 586 And then get a cache object like this:
 587
 588     $c->cache("thumbnails");
 589
 590 It is the same as if you had done:
 591
 592     $c->cache( backend => "large_things" );
 593
 594 =back
 595
 596 =head2 Miscellaneous Configuration
 597
 598 =over 4
 599
 600 =item default_store
 601
 602 When you do not specify a C<store> parameter in the backend
 603 configuration this one will be used instead. This configuration
 604 parameter is not necessary if only one store plugin is loaded.
 605
 606 =back
 607
 608 =head1 TERMINOLOGY
 609
 610 =over 4
 611
 612 =item backend
 613
 614 An object that responds to the methods detailed in
 615 L<Catalyst::Plugin::Cache::Backend> (or more).
 616
 617 =item store
 618
 619 A plugin that provides backends of a certain type. This is a bit like a
 620 factory.
 621
 622 =item cache
 623
 624 Stored key/value pairs of data for easy re-access.
 625
 626 =item metadata
 627
 628 "Extra" information about the item being stored, which can be used to
 629 locate an appropriate backend.
 630
 631 =item curried cache
 632
 633   my $cache = $c->cache(type => 'thumbnails');
 634   $cache->set('pic01', $thumbnaildata);
 635
 636 A cache which has been pre-configured with a particular set of
 637 namespacing data. In the example the cache returned could be one
 638 specifically tuned for storing thumbnails.
 639
 640 An object that responds to C<get>, C<set>, and C<remove>, and will
 641 automatically add metadata to calls to C<< $c->cache_get >>, etc.
 642
 643 =back
 644
 645 =head1 SEE ALSO
 646
 647 L<Cache> - the generic cache API on CPAN.
 648
 649 L<Catalyst::Plugin::Cache::Store> - how to write a store plugin.
 650
 651 L<Catalyst::Plugin::Cache::Curried> - the interface for curried caches.
 652
 653 L<Catalyst::Plugin::Cache::Choose::KeyRegexes> - choose a backend based on
 654 regex matching on the keys. Can be used to partition the keyspace.
 655
 656 L<Catalyst::Plugin::Cache::ControllerNamespacing> - wrap backend objects in a
 657 name mangler so that every controller gets its own keyspace.
 658
 659 =head1 AUTHOR
 660
 661 Yuval Kogman, C<nothingmuch@woobling.org>
 662
 663 Jos Boumans, C<kane@cpan.org>
 664
 665 =head1 COPYRIGHT & LICENSE
 666
 667 Copyright (c) Yuval Kogman, 2006. All rights reserved.
 668
 669 This library is free software, you can redistribute it and/or modify it under
 670 the same terms as Perl itself, as well as under the terms of the MIT license.
 671
 672 =cut
 673