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