File Coverage

blib/lib/CHI/Cascade/Value.pm
Criterion Covered Total %
statement 34 45 75.5
branch 4 10 40.0
condition 3 5 60.0
subroutine 10 12 83.3
pod 4 6 66.6
total 55 78 70.5


line stmt bran cond sub pod time code
1             package CHI::Cascade::Value;
2              
3 15     15   511980 use strict;
  15         99  
  15         435  
4 15     15   75 use warnings;
  15         29  
  15         1185  
5              
6             my %states = (
7             # value = undef -> no in cache
8             CASCADE_NO_CACHE => 1 << 0,
9              
10             # value = undef | old_value -> other process is computing this target or its any dependencies
11             CASCADE_COMPUTING => 1 << 1,
12              
13             # value = undef | old_value -> recomputing is deferred
14             CASCADE_DEFERRED => 1 << 2,
15              
16             # value = old_value | actual_value -> the value from cache (not computed now)
17             CASCADE_FROM_CACHE => 1 << 3,
18              
19             # value = actual_value -> this value is actual
20             CASCADE_ACTUAL_VALUE => 1 << 4,
21              
22             # value = actual_value & recomuted now -> this value is recomputed right now
23             CASCADE_RECOMPUTED => 1 << 5,
24              
25             # value = undef | old_value | value passed by exception -> code of target or code of any dependencies has raised an exception
26             CASCADE_CODE_EXCEPTION => 1 << 6,
27              
28             # value = old_value | actual_value - value may be actual or not but actual term isn valid (only if 'run' is run with 'actual_term' option)
29             CASCADE_ACTUAL_TERM => 1 << 7,
30              
31             # Some dependencies are affected for recomputing, but no recomputing now - only TTL period and value from cache
32             CASCADE_TTL_INVOLVED => 1 << 8
33             );
34              
35             for ( keys %states ) {
36 15     15   123 no strict 'refs';
  15         71  
  15         484  
37 15     15   103 no warnings 'redefine';
  15         37  
  15         1443  
38              
39             my $bit = $states{$_};
40              
41             *{ $_ } = sub () { $bit }
42             }
43              
44              
45 15     15   3790 use parent 'Exporter';
  15         2383  
  15         110  
46              
47             {
48 15     15   993 no strict 'refs';
  15         28  
  15         6846  
49              
50             our %EXPORT_TAGS = (
51             state => [ map { "$_" } grep { /^CASCADE_/ && *{$_}{CODE} } keys %{ __PACKAGE__ . "::" } ]
52             );
53             Exporter::export_ok_tags( keys %EXPORT_TAGS );
54             }
55              
56             sub new {
57 20     20 0 54 my ($class, %opts) = @_;
58              
59 20   33     116 my $self = bless { %opts }, ref($class) || $class;
60              
61 20   100     77 $self->{state} ||= 0;
62              
63 20         122 $self;
64             }
65              
66             sub is_value {
67 36     36 1 139 shift->{is_value};
68             }
69              
70             sub state {
71 51     51 1 88 my $self = shift;
72              
73 51 100       119 if (@_) {
74 24         49 $self->{state} |= $_[0];
75 24         63 return $self;
76             }
77 27         124 $self->{state};
78             }
79              
80             sub state_as_str {
81 0     0 1 0 my $state = $_[1];
82              
83 0 0       0 return '' if ! $state;
84              
85 0         0 my @names;
86              
87 0         0 for ( keys %states ) {
88             push @names, $_
89 0 0       0 if ( $state & $states{$_} );
90             }
91              
92 0         0 join( " | ", sort @names );
93             }
94              
95             sub value {
96 27     27 1 39 my $self = shift;
97              
98 27 100       77 if (@_) {
99 8         14 $self->{is_value} = 1;
100 8         13 $self->{value} = $_[0];
101 8         33 return $self;
102             }
103 19         262 $self->{value};
104             }
105              
106             sub thrown_from_code {
107 0     0 0   my $self = shift;
108              
109 0 0         if (@_) {
110 0           $self->{thrown_from_code} = $_[0];
111 0           return $self;
112             }
113 0           $self->{thrown_from_code};
114             }
115              
116             1;
117              
118             __END__