lib/Catalyst/Plugin/Cache.pm

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