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