lib/Catalyst/Plugin/Cache/Curried.pm

   1 #!/usr/bin/perl
   2
   3 package Catalyst::Plugin::Cache::Curried;
   4
   5 use strict;
   6 use warnings;
   7
   8 use base qw/Class::Accessor::Fast/;
   9
  10 use Scalar::Util ();
  11
  12 __PACKAGE__->mk_accessors(qw/c meta/);
  13
  14 sub new {
  15     my ( $class, $c, @meta ) = @_;
  16
  17     my $self = $class->SUPER::new({
  18         c    => $c,
  19         meta => \@meta,
  20     });
  21
  22     Scalar::Util::weaken( $self->{c} );
  23
  24     return $self;
  25 }
  26
  27 sub backend {
  28     my ( $self, @meta ) = @_;
  29     $self->c->choose_cache_backend( @{ $self->meta }, @meta )
  30 }
  31
  32 sub set {
  33     my ( $self, $key, $value, @meta ) = @_;
  34     @meta = ( expires => $meta[0] ) if @meta == 1;
  35     $self->c->cache_set( $key, $value, @{ $self->meta }, @meta );
  36 }
  37
  38 sub get {
  39     my ( $self, $key ) = @_;
  40     $self->c->cache_get( $key, @{ $self->meta } );
  41 }
  42
  43 sub remove {
  44     my ( $self, $key ) = @_;
  45     $self->c->cache_remove( $key, @{ $self->meta } );
  46 }
  47
  48 sub compute {
  49     my ($self, $key, $code, @meta) = @_;
  50     @meta = ( expires => $meta[0] ) if @meta == 1;
  51     $self->c->cache_compute( $key, $code, @{ $self->meta }, @meta );
  52 }
  53
  54 __PACKAGE__;
  55
  56 __END__
  57
  58 =pod
  59
  60 =head1 NAME
  61
  62 Catalyst::Plugin::Cache::Curried - Curried versions of C<cache_set>,
  63 C<cache_get> and C<cache_remove> that look more like a backend.
  64
  65 =head1 SYNOPSIS
  66
  67     my $curried = $c->cache( %meta );
  68
  69     $curried->get( $key, $value ); # no need to specify %meta
  70
  71 =head1 DESCRIPTION
  72
  73 See L<Catalyst::Plugin::Cache/META DATA> for details.
  74
  75 =head1 METHODS
  76
  77 =over 4
  78
  79 =item new %meta
  80
  81 Create a new curried cache, that captures C<%meta>.
  82
  83 =item backend %additional_meta
  84
  85 This calls C<choose_cache_backend> on the $c object with the captured meta and
  86 the additional meta.
  87
  88 =item set $key, $value, %additional_meta
  89
  90 =item get $key, %additional_meta
  91
  92 =item remove $key, %additional_meta
  93
  94 =item compute $key, $code, %additional_meta
  95
  96 Dellegate to the C<c> object's C<cache_set>, C<cache_get>, C<cache_remove>
  97 or C<cache_compute> with the arguments, then the captured meta from C<meta>,
  98 and then the additional meta.
  99
 100 =item meta
 101
 102 Returns the array ref that captured %meta from C<new>.
 103
 104 =item c
 105
 106 The captured $c object to delegate to.
 107
 108 =back
 109
 110 =cut
 111
 112