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