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__ |