File Coverage

blib/lib/Starch/Store.pm
Criterion Covered Total %
statement 43 43 100.0
branch 4 4 100.0
condition n/a
subroutine 16 16 100.0
pod 7 8 87.5
total 70 71 98.5


line stmt bran cond sub pod time code
1             package Starch::Store;
2 13     13   6864 use 5.008001;
  13         49  
3 13     13   75 use strictures 2;
  13         90  
  13         463  
4             our $VERSION = '0.11';
5              
6             =head1 NAME
7              
8             Starch::Store - Base role for Starch stores.
9              
10             =head1 DESCRIPTION
11              
12             This role defines an interfaces for Starch store classes. Starch store
13             classes are meant to be thin wrappers around the store implementations
14             (such as DBI, CHI, etc).
15              
16             See L for instructions on using stores and a list of
17             available Starch stores.
18              
19             See L for instructions on writing your own stores.
20              
21             This role adds support for method proxies to consuming classes as
22             described in L.
23              
24             =cut
25              
26 13     13   2685 use Types::Standard -types;
  13         30  
  13         92  
27 13     13   58478 use Types::Common::Numeric -types;
  13         30  
  13         111  
28 13     13   16666 use Types::Common::String -types;
  13         28  
  13         153  
29 13     13   18442 use Starch::Util qw( croak );
  13         27  
  13         715  
30              
31 13     13   77 use Moo::Role;
  13         31  
  13         99  
32 13     13   6217 use namespace::clean;
  13         30  
  13         87  
33              
34             with qw(
35             Starch::Role::Log
36             MooX::MethodProxyArgs
37             );
38              
39             requires qw(
40             set
41             get
42             remove
43             );
44              
45             # Declare BUILD so roles can apply method modifiers to it.
46       144 0   sub BUILD { }
47              
48             around set => sub{
49             my ($orig, $self, $id, $keys, $data, $expires) = @_;
50              
51             # Short-circuit set operations if the data should not be stoed.
52             return if $data->{ $self->manager->no_store_state_key() };
53              
54             $expires = $self->calculate_expires( $expires );
55              
56             return $self->$orig( $id, $keys, $data, $expires );
57             };
58              
59             =head1 REQUIRED ARGUMENTS
60              
61             =head2 manager
62              
63             The L object which is used by stores to
64             access configuration and create sub-stores (such as the Layered
65             store's outer and inner stores). This is automatically set when
66             the stores are built by L.
67              
68             =cut
69              
70             has manager => (
71             is => 'ro',
72             isa => InstanceOf[ 'Starch::Manager' ],
73             required => 1,
74             weak_ref => 1,
75             handles => ['factory'],
76             );
77              
78             =head1 OPTIONAL ARGUMENTS
79              
80             =head2 max_expires
81              
82             Set the per-store maximum expires which will override the state's expires
83             if the state's expires is larger.
84              
85             =cut
86              
87             has max_expires => (
88             is => 'ro',
89             isa => (PositiveOrZeroInt) | Undef,
90             );
91              
92             =head2 key_separator
93              
94             Used by L to combine the state namespace
95             and ID. Defaults to C<:>.
96              
97             =cut
98              
99             has key_separator => (
100             is => 'ro',
101             isa => NonEmptySimpleStr,
102             default => ':',
103             );
104              
105             =head1 ATTRIBUTES
106              
107             =head2 can_reap_expired
108              
109             Return true if the stores supports the L method.
110              
111             =cut
112              
113 10     10 1 82 sub can_reap_expired { 0 }
114              
115             =head2 short_store_class_name
116              
117             Returns L with the
118             C prefix remove.
119              
120             =cut
121              
122             sub short_store_class_name {
123 74     74 1 1633 my ($self) = @_;
124 74         209 my $class = $self->short_class_name();
125 74         200 $class =~ s{^Store::}{};
126 74         298 return $class;
127             }
128              
129             =head1 METHODS
130              
131             =head2 new_sub_store
132              
133             Builds a new store object. Any arguments passed will be
134             combined with the L.
135              
136             =cut
137              
138             sub new_sub_store {
139 50     50 1 100 my $self = shift;
140              
141 50         402 my $args = $self->sub_store_args( @_ );
142              
143 50         941 return $self->factory->new_store( $args );
144             }
145              
146             =head2 sub_store_args
147              
148             Returns the arguments needed to create a sub-store. Any arguments
149             passed will be combined with the default arguments. The default
150             arguments will be L and L (if set). More
151             arguments may be present if any plugins extend this method.
152              
153             =cut
154              
155             sub sub_store_args {
156 50     50 1 148 my $self = shift;
157              
158 50         1221 my $args = $self->BUILDARGS( @_ );
159              
160             return {
161 50         10886 manager => $self->manager(),
162             max_expires => $self->max_expires(),
163             key_separator => $self->key_separator(),
164             %$args,
165             };
166             }
167              
168             =head2 calculate_expires
169              
170             Given an expires value this will calculate the expires that this store
171             should use considering what L is set to.
172              
173             =cut
174              
175             sub calculate_expires {
176 154     154 1 325 my ($self, $expires) = @_;
177              
178 154         372 my $max_expires = $self->max_expires();
179 154 100       482 return $expires if !defined $max_expires;
180              
181 16 100       66 return $max_expires if $expires > $max_expires;
182              
183 8         44 return $expires;
184             }
185              
186             =head2 stringify_key
187              
188             my $store_key = $starch->stringify_key(
189             $state_id,
190             \@namespace,
191             );
192              
193             This method is used by stores that store and lookup data by
194             a string (all of them at this time). It combines the state
195             ID with the L of the key data for the store
196             request.
197              
198             =cut
199              
200             sub stringify_key {
201 420     420 1 3949 my ($self, $id, $namespace) = @_;
202 420         2091 return join(
203             $self->key_separator(),
204             @$namespace,
205             $id,
206             );
207             }
208              
209             =head2 reap_expired
210              
211             This triggers the store to find and delete all expired states.
212             This is meant to be used in an offline process, such as a cronjob,
213             as finding and deleting the states could take hours depending
214             on the amount of data and the storage engine's speed.
215              
216             By default this method will throw an exception if the store does
217             not define its own reap method. You can check if a store supports
218             this method by calling L.
219              
220             =cut
221              
222             sub reap_expired {
223 8     8 1 23 my ($self) = @_;
224              
225 8         59 croak sprintf(
226             '%s does not support expired state reaping',
227             $self->short_class_name(),
228             );
229             }
230              
231             1;
232             __END__