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   6975 use 5.008001;
  13         49  
3 13     13   113 use strictures 2;
  13         173  
  13         468  
4             our $VERSION = '0.12';
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   2754 use Types::Standard -types;
  13         33  
  13         91  
27 13     13   58643 use Types::Common::Numeric -types;
  13         30  
  13         99  
28 13     13   16993 use Types::Common::String -types;
  13         37  
  13         154  
29 13     13   18595 use Starch::Util qw( croak );
  13         39  
  13         722  
30              
31 13     13   84 use Moo::Role;
  13         23  
  13         121  
32 13     13   6413 use namespace::clean;
  13         39  
  13         123  
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 190 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 1709 my ($self) = @_;
124 74         200 my $class = $self->short_class_name();
125 74         201 $class =~ s{^Store::}{};
126 74         378 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 51489 my $self = shift;
140              
141 50         272 my $args = $self->sub_store_args( @_ );
142              
143 50         885 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 150 my $self = shift;
157              
158 50         1321 my $args = $self->BUILDARGS( @_ );
159              
160             return {
161 50         10966 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 360 my ($self, $expires) = @_;
177              
178 154         364 my $max_expires = $self->max_expires();
179 154 100       478 return $expires if !defined $max_expires;
180              
181 16 100       120 return $max_expires if $expires > $max_expires;
182              
183 8         91 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 16869 my ($self, $id, $namespace) = @_;
202 420         2305 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 184 my ($self) = @_;
224              
225 8         46 croak sprintf(
226             '%s does not support expired state reaping',
227             $self->short_class_name(),
228             );
229             }
230              
231             1;
232             __END__