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 | |
15b3f49f |
22 | Scalar::Util::weaken( $self->{c} ) |
23 | if ref( $self->{c} ); |
2e4bde89 |
24 | |
25 | return $self; |
26 | } |
27 | |
28 | sub backend { |
85a748b9 |
29 | my ( $self, @meta ) = @_; |
ab49d961 |
30 | $self->c->choose_cache_backend( @{ $self->meta }, @meta ) |
2e4bde89 |
31 | } |
32 | |
33 | sub 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 | |
39 | sub get { |
26dcff5b |
40 | my ( $self, $key ) = @_; |
2e4bde89 |
41 | $self->c->cache_get( $key, @{ $self->meta } ); |
42 | } |
43 | |
aed484da |
44 | sub remove { |
26dcff5b |
45 | my ( $self, $key ) = @_; |
aed484da |
46 | $self->c->cache_remove( $key, @{ $self->meta } ); |
2e4bde89 |
47 | } |
48 | |
26dcff5b |
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 | |
2e4bde89 |
55 | __PACKAGE__; |
56 | |
57 | __END__ |
58 | |
59 | =pod |
60 | |
61 | =head1 NAME |
62 | |
63 | Catalyst::Plugin::Cache::Curried - Curried versions of C<cache_set>, |
aed484da |
64 | C<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 |
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 | |
26dcff5b |
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. |
85a748b9 |
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 | |
2e4bde89 |
111 | =cut |
112 | |
113 | |