File Coverage

blib/lib/CHI/Cascade/Rule.pm
Criterion Covered Total %
statement 46 59 77.9
branch 17 32 53.1
condition 5 13 38.4
subroutine 12 15 80.0
pod 7 11 63.6
total 87 130 66.9


line stmt bran cond sub pod time code
1             package CHI::Cascade::Rule;
2              
3 15     15   106 use strict;
  15         34  
  15         457  
4 15     15   78 use warnings;
  15         32  
  15         339  
5 15     15   193 use v5.10;
  15         52  
6              
7 15     15   96 use Scalar::Util 'weaken';
  15         29  
  15         12814  
8              
9             sub new {
10 26     26 0 84 my ($class, %opts) = @_;
11              
12 26 100       75 my $from = ref($class) ? $class : \%opts;
13              
14             $opts{depends} = [ defined( $opts{depends} ) ? ( $opts{depends} ) : () ]
15 26 100       153 unless ref( $opts{depends} );
    50          
16              
17             # To do clone or new object
18             my $self = bless {
19 130         421 map( { $_ => $from->{$_} }
20 26   66     68 grep { exists $from->{$_} }
  286         508  
21             qw( target depends depends_catch code params busy_lock cascade recomputed actual_term ttl value_expires ) ),
22             qr_params => [],
23             matched_target => undef
24             }, ref($class) || $class;
25              
26 26 100       80 if ( $opts{run_instance} ) {
27 23         62 $self->{run_instance} = $opts{run_instance};
28 23         98 weaken $self->{run_instance}; # It is against memory leaks
29             }
30              
31 26         5968 weaken $self->{cascade}; # It is against memory leaks
32 26         50 $self->{resolved_depends} = undef;
33              
34 26         103 $self;
35             }
36              
37             sub qr_params {
38 40     40 1 70 my $self = shift;
39              
40 40 100       136 if (@_) {
41 11         35 $self->{qr_params} = [ @_ ];
42             }
43             else {
44 29         39 return @{ $self->{qr_params} };
  29         93  
45             }
46             }
47              
48             sub depends {
49 20     20 1 31 my $self = shift;
50              
51             return $self->{resolved_depends}
52 20 50       44 if $self->{resolved_depends};
53              
54 20 50       54 if ( ref( $self->{depends} ) eq 'CODE' ) {
55 0         0 my $res = $self->{depends}->( $self, $self->qr_params );
56              
57 0 0       0 $self->{resolved_depends} = ref($res) eq 'ARRAY' ? [ @$res ] : [ $res ];
58             }
59             else {
60 20         36 $self->{resolved_depends} = [ @{ $self->{depends} } ];
  20         48  
61             }
62              
63 20         38 for ( @{ $self->{resolved_depends} } ) {
  20         55  
64 11 50       32 $_ = $_->( $self, $self->qr_params )
65             if ( ref eq 'CODE' );
66             }
67              
68 20         50 $self->{resolved_depends};
69             }
70              
71             sub value_expires {
72 10     10 1 19 my $self = shift;
73              
74 10 50       23 if (@_) {
75 0         0 $self->{value_expires} = $_[0];
76 0         0 return $self;
77             }
78 10 50 50     65 ( ref $self->{value_expires} eq 'CODE' ? $self->{value_expires}->( $self ) : $self->{value_expires} ) // 'never';
79             }
80              
81             sub target_expires {
82 18     18 0 39 my ( $self, $trg_obj ) = @_;
83              
84             $trg_obj->locked
85             ?
86 18 100 50     45 $self->{busy_lock} || $self->{cascade}{busy_lock} || 'never'
      33        
87             :
88             $trg_obj->expires // $trg_obj->expires( $self->value_expires );
89             }
90              
91             sub ttl {
92 20     20 0 34 my $self = shift;
93              
94             return undef
95 20 50       99 unless exists $self->{ttl};
96              
97 0 0       0 $self->{ttl_time} && return $self->{ttl_time};
98              
99 0 0 0     0 if ( ref $self->{ttl} eq 'ARRAY' && @{ $self->{ttl} } == 2 ) {
  0 0       0  
100 0         0 return $self->{ttl_time} = rand( $self->{ttl}[1] - $self->{ttl}[0] ) + $self->{ttl}[0];
101             }
102             elsif ( ref $self->{ttl} eq 'CODE' ) {
103 0         0 return $self->{ttl_time} = $self->{ttl}->( $self, $self->qr_params );
104             }
105              
106 0         0 return undef;
107             }
108              
109 115     115 1 512 sub target { shift->{matched_target} }
110 0     0 1 0 sub params { shift->{params} }
111 0     0 1 0 sub cascade { shift->{cascade} }
112 5     5 0 63 sub dep_values { shift->{dep_values} }
113 0     0 1   sub stash { shift->{run_instance}{stash} }
114              
115             1;
116             __END__