File Coverage

blib/lib/Starch/State.pm
Criterion Covered Total %
statement 104 112 92.8
branch 24 28 85.7
condition 2 2 100.0
subroutine 26 27 96.3
pod 12 13 92.3
total 168 182 92.3


line stmt bran cond sub pod time code
1             package Starch::State;
2 13     13   301 use 5.008001;
  13         52  
3 13     13   74 use strictures 2;
  13         91  
  13         432  
4             our $VERSION = '0.12';
5              
6             =head1 NAME
7              
8             Starch::State - The Starch state object.
9              
10             =head1 SYNOPSIS
11              
12             my $state = $starch->state();
13             $state->data->{foo} = 'bar';
14             $state->save();
15             $state = $starch->state( $state->id() );
16             print $state->data->{foo}; # bar
17              
18             =head1 DESCRIPTION
19              
20             This is the state class used by L.
21              
22             =cut
23              
24 13     13   2501 use Types::Standard -types;
  13         46  
  13         157  
25 13     13   59861 use Types::Common::String -types;
  13         29  
  13         93  
26 13     13   18384 use Starch::Util qw( croak );
  13         41  
  13         587  
27              
28 13     13   6718 use Moo;
  13         35271  
  13         79  
29 13     13   5768 use namespace::clean;
  13         40  
  13         110  
30              
31             with qw(
32             Starch::Role::Log
33             );
34              
35             # Declare BUILD so roles can apply method modifiers to it.
36       395 0   sub BUILD { }
37              
38             =head1 REQUIRED ARGUMENTS
39              
40             =head2 manager
41              
42             The L object that glues everything together. The state
43             object needs this to get at configuration information and the stores.
44             This argument is automatically set by L.
45              
46             =cut
47              
48             has manager => (
49             is => 'ro',
50             isa => InstanceOf[ 'Starch::Manager' ],
51             required => 1,
52             );
53              
54             =head1 OPTIONAL ARGUMENTS
55              
56             =head2 id
57              
58             The state ID. If one is not specified then one will be built and
59             the state will be considered new.
60              
61             =cut
62              
63             has _existing_id => (
64             is => 'ro',
65             init_arg => 'id',
66             predicate => 1,
67             clearer => '_clear_existing_id',
68             );
69              
70             has id => (
71             is => 'lazy',
72             init_arg => undef,
73             clearer => '_clear_id',
74             );
75             sub _build_id {
76 256     256   11031 my ($self) = @_;
77 256 100       2304 return $self->_existing_id() if $self->_has_existing_id();
78 121         871 return $self->manager->generate_state_id();
79             }
80              
81             =head1 ATTRIBUTES
82              
83             =head2 original_data
84              
85             The state data at the point it was when the state object was first instantiated.
86              
87             =cut
88              
89             has original_data => (
90             is => 'lazy',
91             isa => HashRef,
92             init_arg => undef,
93             writer => '_set_original_data',
94             clearer => '_clear_original_data',
95             predicate => 'is_loaded',
96             );
97             sub _build_original_data {
98 246     246   2252 my ($self) = @_;
99              
100 246 100       3897 return {} if !$self->in_store();
101              
102 120         408 my $manager = $self->manager();
103 120         2027 my $data = $manager->store->get( $self->id(), $manager->namespace() );
104              
105 120 100       1841 return $data if $data;
106              
107 36         128 $self->_set_in_store( 0 );
108 36         666 return {};
109             }
110              
111             =head2 data
112              
113             The state data which is meant to be modified.
114              
115             =cut
116              
117             has data => (
118             is => 'lazy',
119             init_arg => undef,
120             writer => '_set_data',
121             clearer => '_clear_data',
122             );
123             sub _build_data {
124 209     209   7019 my ($self) = @_;
125 209         3524 return $self->manager->clone_data( $self->original_data() );
126             }
127              
128             =head2 expires
129              
130             This defaults to L and is stored in the L
131             under the L key.
132              
133             =cut
134              
135             has expires => (
136             is => 'lazy',
137             init_arg => undef,
138             clearer => '_clear_expires',
139             writer => '_set_expires',
140             );
141             sub _build_expires {
142 128     128   1932 my ($self) = @_;
143              
144 128         337 my $manager = $self->manager();
145 128         2033 my $expires = $self->original_data->{ $manager->expires_state_key() };
146              
147 128 100       2145 $expires = $manager->expires() if !defined $expires;
148              
149 128         678 return $expires;
150             }
151              
152             =head2 modified
153              
154             Whenever the state is Ld this will be updated and stored in
155             L under the L.
156              
157             =cut
158              
159             has modified => (
160             is => 'lazy',
161             init_arg => undef,
162             clearer => '_clear_modified',
163             );
164             sub _build_modified {
165 19     19   657 my ($self) = @_;
166              
167             my $modified = $self->original_data->{
168 19         414 $self->manager->modified_state_key()
169             };
170              
171 19 100       706 $modified = $self->created() if !defined $modified;
172              
173 19         301 return $modified;
174             }
175              
176             =head2 created
177              
178             When the state is created this is set and stored in L
179             under the L.
180              
181             =cut
182              
183             has created => (
184             is => 'lazy',
185             init_arg => undef,
186             clearer => '_clear_created',
187             );
188             sub _build_created {
189 121     121   1311 my ($self) = @_;
190              
191             my $created = $self->original_data->{
192 121         1890 $self->manager->created_state_key()
193             };
194              
195 121 100       1527 $created = time() if !defined $created;
196              
197 121         545 return $created;
198             }
199              
200             =head2 in_store
201              
202             Returns true if the state is expected to exist in the store
203             (AKA, if the L argument was specified or L was called).
204              
205             Note that the value of this attribute may change after L
206             is called which will set this to false if the store did not have
207             the data for the state.
208              
209             =cut
210              
211             has in_store => (
212             is => 'lazy',
213             writer => '_set_in_store',
214             init_arg => undef,
215             );
216             sub _build_in_store {
217 266     266   2369 my ($self) = @_;
218 266 100       3043 return( $self->_has_existing_id() ? 1 : 0 );
219             }
220              
221             =head2 is_loaded
222              
223             This returns true if the L has been loaded up from
224             the store. Note that L will be automatically
225             loaded if L, L, or any methods that call them,
226             are called.
227              
228             =cut
229              
230             # This is provided by the original_data attribute via its predicate.
231              
232             =head2 is_saved
233              
234             Returns true if the state is L and is not L.
235              
236             =cut
237              
238             sub is_saved {
239 28     28 1 191 my ($self) = @_;
240 28 100       564 return 0 if !$self->in_store();
241 14 50       162 return 0 if $self->is_dirty();
242 14         75 return 1;
243             }
244              
245             =head2 is_deleted
246              
247             Returns true if L has been called on this state.
248              
249             =cut
250              
251             has is_deleted => (
252             is => 'ro',
253             writer => '_set_is_deleted',
254             init_arg => undef,
255             default => 0,
256             );
257              
258             =head2 is_dirty
259              
260             Returns true if the state data has changed (if L
261             and L are different).
262              
263             =cut
264              
265             sub is_dirty {
266 228     228 1 587 my ($self) = @_;
267              
268             # If we haven't even loaded the data from the store then
269             # there is no way we're dirty.
270 228 100       864 return 0 if !$self->is_loaded();
271              
272 213         4364 return $self->manager->is_data_diff( $self->original_data(), $self->data() );
273             }
274              
275             =head1 METHODS
276              
277             =head2 save
278              
279             Saves this state in the L if it L and
280             not L.
281              
282             =cut
283              
284             sub save {
285 123     123 1 795 my ($self) = @_;
286              
287 123 100       309 return if !$self->is_dirty();
288 114 50       464 return if $self->is_deleted();
289              
290 114         293 my $manager = $self->manager();
291 114         2262 my $data = $self->data();
292              
293 114         2477 $data->{ $manager->created_state_key() } = $self->created();
294 114         642 $data->{ $manager->modified_state_key() } = time();
295 114         1947 $data->{ $manager->expires_state_key() } = $self->expires();
296              
297 114         2120 $self->_clear_modified();
298              
299 114         2232 $manager->store->set(
300             $self->id(),
301             $manager->namespace(),
302             $data,
303             $self->expires(),
304             );
305              
306             # This will cause is_saved to return true.
307 113         640 $self->_set_in_store( 1 );
308 113         614 $self->mark_clean();
309              
310 113         316 return;
311             }
312              
313             =head2 delete
314              
315             Deletes the state from the L and sets
316             L.
317              
318             =cut
319              
320             sub delete {
321 32     32 1 191 my ($self) = @_;
322              
323 32 50       626 if ($self->in_store()) {
324 32         243 my $manager = $self->manager();
325 32         529 $manager->store->remove( $self->id(), $manager->namespace() );
326             }
327              
328 32         205 $self->_set_is_deleted( 1 );
329 32         82 $self->_set_in_store( 0 );
330              
331 32         70 return;
332             }
333              
334             =head2 reload
335              
336             Clears L and L so that the next call to these
337             will reload the state data from the store. This method is potentially
338             destructive as you will loose any changes to the data that have not
339             been saved.
340              
341             =cut
342              
343             sub reload {
344 15     15 1 245 my ($self) = @_;
345              
346 15         328 $self->_clear_original_data();
347 15         340 $self->_clear_data();
348              
349 15         96 return;
350             }
351              
352             =head2 rollback
353              
354             Sets L to L.
355              
356             =cut
357              
358             sub rollback {
359 15     15 1 256 my ($self) = @_;
360              
361 15         310 $self->_set_data(
362             $self->manager->clone_data( $self->original_data() ),
363             );
364              
365 15         44 return;
366             }
367              
368             =head2 clear
369              
370             Empties L and L, and calls L.
371              
372             =cut
373              
374             sub clear {
375 0     0 1 0 my ($self) = @_;
376              
377             # Make sure we retain these values.
378 0         0 $self->expires();
379 0         0 $self->modified();
380 0         0 $self->created();
381              
382 0         0 $self->_set_original_data( {} );
383 0         0 $self->_set_data( {} );
384 0         0 $self->mark_dirty();
385              
386 0         0 return;
387             }
388              
389             =head2 mark_clean
390              
391             Marks the state as not L by setting L to
392             L. This is a potentially destructive method as L will
393             silentfly not save if the state is not L.
394              
395             =cut
396              
397             sub mark_clean {
398 128     128 1 2768 my ($self) = @_;
399              
400 128         2358 $self->_set_original_data(
401             $self->manager->clone_data( $self->data() ),
402             );
403              
404 128         3775 return;
405             }
406              
407             =head2 mark_dirty
408              
409             Increments the L value in L,
410             which causes the state to be considered dirty.
411              
412             =cut
413              
414             sub mark_dirty {
415 48     48 1 24015920 my ($self) = @_;
416              
417 48         410 my $key = $self->manager->dirty_state_key();
418              
419 48         1668 my $counter = $self->data->{ $key };
420 48   100     451 $counter = ($counter || 0) + 1;
421 48         1107 $self->data->{ $key } = $counter;
422              
423 48         472 return;
424             }
425              
426             =head2 set_expires
427              
428             # Extend this state's expires duration by two hours.
429             $state->set_expires( $state->expires() + (2 * 60 * 60) );
430              
431             Use this to set the state's expires to a duration different than the
432             global expires set by L. This is useful for,
433             for example, to support a "Remember Me" checkbox that many login
434             forms provide where the difference between the user checking it or not
435             is just a matter of what the state's expires duration is set to.
436              
437             Remember that the "expires" duration is a measurement, in seconds, of
438             how long the state will live in the store since the last modification,
439             and how long the cookie (if you are using cookies) will live since the
440             last request.
441              
442             The expires duration can be more than or less than the global expires,
443             there is no artificial constraint.
444              
445             =cut
446              
447             sub set_expires {
448 21     21 1 97 my ($self, $expires) = @_;
449              
450 21         79 $self->_set_expires( $expires );
451 21         461 $self->data->{ $self->manager->expires_state_key() } = $expires;
452              
453 21         87 return;
454             }
455              
456             =head2 reset_expires
457              
458             Sets this state's expires to L, overriding
459             and custom expires set on this state.
460              
461             =cut
462              
463             sub reset_expires {
464 7     7 1 39 my ($self) = @_;
465              
466 7         65 $self->set_expires( $self->manager->expires() );
467              
468 7         19 return;
469             }
470              
471             =head2 reset_id
472              
473             This re-generates a new L and marks the L as dirty.
474             Often this is used to avoid
475             L
476             as part of authentication and de-authentication (login/logout).
477              
478             =cut
479              
480             sub reset_id {
481 7     7 1 124 my ($self) = @_;
482              
483             # Remove the data for the current state ID.
484 7 50       183 $self->manager->state( $self->id() )->delete()
485             if $self->in_store();
486              
487             # Ensure that future calls to id generate a new one.
488 7         195 $self->_clear_existing_id();
489 7         169 $self->_clear_id();
490              
491 7         152 $self->_set_original_data( {} );
492 7         203 $self->_set_in_store( 0 );
493              
494 7         22 return;
495             }
496              
497             1;
498             __END__