File Coverage

blib/lib/Starch/Manager.pm
Criterion Covered Total %
statement 58 58 100.0
branch 5 6 83.3
condition 2 3 66.6
subroutine 19 19 100.0
pod 6 7 85.7
total 90 93 96.7


line stmt bran cond sub pod time code
1             package Starch::Manager;
2             our $VERSION = '0.14';
3              
4             =encoding utf8
5              
6             =head1 NAME
7              
8             Starch::Manager - Entry point for accessing Starch state objects.
9              
10             =head1 SYNOPSIS
11              
12             See L.
13              
14             =head1 DESCRIPTION
15              
16             This module provides a generic interface to managing the storage of
17             state data.
18              
19             Typically you will be using the L module to create this
20             object.
21              
22             This class supports method proxies as described in
23             L.
24              
25             =cut
26              
27 13     13   6129 use Digest::SHA qw( sha1_hex );
  13         37012  
  13         1043  
28 13     13   101 use Scalar::Util qw( refaddr );
  13         29  
  13         576  
29 13     13   5655 use Starch::State;
  13         46  
  13         559  
30 13     13   110 use Starch::Util qw( croak );
  13         25  
  13         733  
31 13     13   8409 use Storable qw( freeze dclone );
  13         40114  
  13         936  
32 13     13   5635 use Types::Common::Numeric -types;
  13         154689  
  13         104  
33 13     13   16939 use Types::Common::String -types;
  13         29  
  13         110  
34 13     13   16930 use Types::Standard -types;
  13         37  
  13         79  
35              
36 13     13   54446 use Moo;
  13         29  
  13         107  
37 13     13   5936 use strictures 2;
  13         120  
  13         562  
38 13     13   2808 use namespace::clean;
  13         28  
  13         101  
39              
40             with 'Starch::Role::Log';
41             with 'MooX::MethodProxyArgs';
42              
43             # Declare BUILD so roles can apply method modifiers to it.
44             sub BUILD {
45 84     84 0 6726 my ($self) = @_;
46              
47             # Get this built as early as possible.
48 84         1426 $self->store();
49              
50 84         6220 return;
51             }
52              
53             =head1 REQUIRED ARGUMENTS
54              
55             =head2 store
56              
57             The L storage backend to use for persisting the state
58             data. A hashref must be passed and it is expected to contain at least a
59             C key and will be converted into a store object automatically.
60              
61             The C can be fully qualified, or relative to the C
62             namespace. A leading C<::> signifies that the store's package name is relative.
63              
64             More information about stores can be found at L.
65              
66             =cut
67              
68             has _store_arg => (
69             is => 'ro',
70             isa => HashRef,
71             required => 1,
72             init_arg => 'store',
73             );
74              
75             has store => (
76             is => 'lazy',
77             isa => ConsumerOf[ 'Starch::Store' ],
78             init_arg => undef,
79             );
80             sub _build_store {
81 70     70   748 my ($self) = @_;
82              
83 70         247 my $store = $self->_store_arg();
84              
85 70         424 return $self->factory->new_store(
86             %$store,
87             manager => $self,
88             );
89             }
90              
91             =head1 OPTIONAL ARGUMENTS
92              
93             =head2 expires
94              
95             How long, in seconds, a state should live after the last time it was
96             modified. Defaults to C<60 * 60 * 2> (2 hours).
97              
98             See L for more information.
99              
100             =cut
101              
102             has expires => (
103             is => 'ro',
104             isa => PositiveOrZeroInt,
105             default => 60 * 60 * 2, # 2 hours
106             );
107              
108             =head2 plugins
109              
110             Which plugins to apply to the Starch objects, specified as an array
111             ref of plugin names. The plugin names can be fully qualified, or
112             relative to the C namespace. A leading C<::> signifies
113             that the plugin's package name is relative.
114              
115             Plugins can modify nearly any functionality in Starch. More information
116             about plugins, as well as which plugins are available, can be found at
117             L.
118              
119             =cut
120              
121             # This is a "virtual" argument of sorts handled in Starch->new.
122             # The plugins end up being stored in the factory object, not here.
123              
124             =head2 namespace
125              
126             The root array ref namespace to put starch data in. In most cases this is
127             just prepended to the state ID and used as the key for storing the state
128             data. Defaults to C<['starch-state']>.
129              
130             If you are using the same store for independent application states you
131             may want to namespace them so that you can easly identify which application
132             a particular state belongs to when looking in the store.
133              
134             =cut
135              
136             has namespace => (
137             is => 'ro',
138             isa => ArrayRef[ NonEmptySimpleStr ],
139             default => sub{ ['starch-state'] },
140             );
141              
142             =head2 expires_state_key
143              
144             The state key to store the L
145             value in. Defaults to C<__STARCH_EXPIRES__>.
146              
147             =cut
148              
149             has expires_state_key => (
150             is => 'ro',
151             isa => NonEmptySimpleStr,
152             default => '__STARCH_EXPIRES__',
153             );
154              
155             =head2 modified_state_key
156              
157             The state key to store the L
158             value in. Defaults to C<__STARCH_MODIFIED__>.
159              
160             =cut
161              
162             has modified_state_key => (
163             is => 'ro',
164             isa => NonEmptySimpleStr,
165             default => '__STARCH_MODIFIED__',
166             );
167              
168             =head2 created_state_key
169              
170             The state key to store the L
171             value in. Defaults to C<__STARCH_CREATED__>.
172              
173             =cut
174              
175             has created_state_key => (
176             is => 'ro',
177             isa => NonEmptySimpleStr,
178             default => '__STARCH_CREATED__',
179             );
180              
181             =head2 no_store_state_key
182              
183             This key is used by stores to mark state data as not to be
184             stored. Defaults to C<__STARCH_NO_STORE__>.
185              
186             This is used by the L and
187             L plugins to avoid losing state
188             data in the store when errors or throttling is encountered.
189              
190             =cut
191              
192             has no_store_state_key => (
193             is => 'ro',
194             isa => NonEmptySimpleStr,
195             default => '__STARCH_NO_STORE__',
196             );
197              
198             =head2 dirty_state_key
199              
200             This key is used to artificially mark as state as dirty by incrementing
201             the value of this key. Used by L.
202              
203             =cut
204              
205             has dirty_state_key => (
206             is => 'ro',
207             isa => NonEmptySimpleStr,
208             default => '__STARCH_DIRTY__',
209             );
210              
211             =head1 ATTRIBUTES
212              
213             =head2 factory
214              
215             The L object which applies plugins and handles the
216             construction of the manager, state, and store objects.
217              
218             =cut
219              
220             # This argument is always set by Starch->new(). So, to the end-user,
221             # this is an attribute not a required argument.
222             has factory => (
223             is => 'ro',
224             isa => InstanceOf[ 'Starch::Factory' ],
225             required => 1,
226             );
227              
228             =head2 state_id_type
229              
230             The L object to validate the state ID when L
231             is called. Defaults to L.
232              
233             =cut
234              
235 148     148 1 536 sub state_id_type { NonEmptySimpleStr }
236              
237             =head1 METHODS
238              
239             =head2 state
240              
241             my $new_state = $starch->state();
242             my $existing_state = $starch->state( $id );
243              
244             Returns a new L (or whatever L
245             returns) object for the specified state ID.
246              
247             If no ID is specified, or is undef, then an ID will be automatically generated.
248              
249             Additional arguments can be passed after the ID argument. These extra
250             arguments will be passed to the state object constructor.
251              
252             =cut
253              
254             sub state {
255 305     305 1 4010271 my $self = shift;
256 305         524 my $id = shift;
257              
258 305 50 66     1111 croak 'Invalid Starch State ID: ' . $self->state_id_type->get_message( $id )
259             if defined($id) and !$self->state_id_type->check( $id );
260              
261 305         10240 my $class = $self->factory->state_class();
262              
263 305         16618 my $extra_args = $class->BUILDARGS( @_ );
264              
265 305 100       35071 return $class->new(
266             %$extra_args,
267             manager => $self,
268             defined($id) ? (id => $id) : (),
269             );
270             }
271              
272             =head2 state_id_seed
273              
274             Returns a fairly unique string used for seeding L.
275              
276             =cut
277              
278             my $counter = 0;
279             sub state_id_seed {
280 163     163 1 282 my ($self) = @_;
281 163         4438 return join( '', ++$counter, time, rand, $$, {}, refaddr($self) )
282             }
283              
284             =head2 generate_state_id
285              
286             Generates and returns a new state ID which is a SHA-1 hex
287             digest of calling L.
288              
289             =cut
290              
291             sub generate_state_id {
292 149     149 1 614 my ($self) = @_;
293 149         335 return sha1_hex( $self->state_id_seed() );
294             }
295              
296             =head2 clone_data
297              
298             Clones complex perl data structures. Used internally to build
299             L from L.
300              
301             =cut
302              
303             sub clone_data {
304 359     359 1 5474 my ($self, $data) = @_;
305 359         14203 return dclone( $data );
306             }
307              
308             =head2 is_data_diff
309              
310             Given two bits of data (scalar, array ref, or hash ref) this returns
311             true if the data is different. Used internally by L.
312              
313             =cut
314              
315             sub is_data_diff {
316 227     227 1 5854 my ($self, $old, $new) = @_;
317              
318 227         479 local $Storable::canonical = 1;
319              
320 227         764 $old = freeze( $old );
321 227         8649 $new = freeze( $new );
322              
323 227 100       6466 return 0 if $new eq $old;
324 170         814 return 1;
325             }
326              
327             1;
328             __END__