lib/Catalyst/Plugin/Cache.pm

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