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