Commit | Line | Data |
2e4bde89 |
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 { |
85a748b9 |
28 | my ( $self, @meta ) = @_; |
ab49d961 |
29 | $self->c->choose_cache_backend( @{ $self->meta }, @meta ) |
2e4bde89 |
30 | } |
31 | |
32 | sub set { |
85a748b9 |
33 | my ( $self, $key, $value, @meta ) = @_; |
390db05f |
34 | @meta = ( expires => $meta[0] ) if @meta == 1; |
85a748b9 |
35 | $self->c->cache_set( $key, $value, @{ $self->meta }, @meta ); |
2e4bde89 |
36 | } |
37 | |
38 | sub get { |
26dcff5b |
39 | my ( $self, $key ) = @_; |
2e4bde89 |
40 | $self->c->cache_get( $key, @{ $self->meta } ); |
41 | } |
42 | |
aed484da |
43 | sub remove { |
26dcff5b |
44 | my ( $self, $key ) = @_; |
aed484da |
45 | $self->c->cache_remove( $key, @{ $self->meta } ); |
2e4bde89 |
46 | } |
47 | |
26dcff5b |
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 | |
2e4bde89 |
54 | __PACKAGE__; |
55 | |
56 | __END__ |
57 | |
58 | =pod |
59 | |
60 | =head1 NAME |
61 | |
62 | Catalyst::Plugin::Cache::Curried - Curried versions of C<cache_set>, |
aed484da |
63 | C<cache_get> and C<cache_remove> that look more like a backend. |
2e4bde89 |
64 | |
65 | =head1 SYNOPSIS |
66 | |
85a748b9 |
67 | my $curried = $c->cache( %meta ); |
68 | |
69 | $curried->get( $key, $value ); # no need to specify %meta |
2e4bde89 |
70 | |
71 | =head1 DESCRIPTION |
72 | |
85a748b9 |
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 | |
26dcff5b |
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. |
85a748b9 |
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 | |
2e4bde89 |
110 | =cut |
111 | |
112 | |