File Coverage

blib/lib/CHI/Cascade/Rule.pm
Criterion Covered Total %
statement 46 59 77.9
branch 17 34 50.0
condition 5 16 31.2
subroutine 12 15 80.0
pod 7 11 63.6
total 87 135 64.4


line stmt bran cond sub pod time code
1             package CHI::Cascade::Rule;
2              
3 15     15   103 use strict;
  15         30  
  15         424  
4 15     15   75 use warnings;
  15         38  
  15         325  
5 15     15   190 use v5.10;
  15         48  
6              
7 15     15   94 use Scalar::Util 'weaken';
  15         35  
  15         12178  
8              
9             sub new {
10 26     26 0 88 my ($class, %opts) = @_;
11              
12 26 100       86 my $from = ref($class) ? $class : \%opts;
13              
14             $opts{depends} = [ defined( $opts{depends} ) ? ( $opts{depends} ) : () ]
15 26 100       101 unless ref( $opts{depends} );
    50          
16              
17             # To do clone or new object
18             my $self = bless {
19 130         426 map( { $_ => $from->{$_} }
20 26   66     69 grep { exists $from->{$_} }
  286         503  
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       5816 if ( $opts{run_instance} ) {
27 23         62 $self->{run_instance} = $opts{run_instance};
28 23         82 weaken $self->{run_instance}; # It is against memory leaks
29             }
30              
31 26         93 weaken $self->{cascade}; # It is against memory leaks
32 26         46 $self->{resolved_depends} = undef;
33              
34 26         112 $self;
35             }
36              
37             sub qr_params {
38 40     40 1 63 my $self = shift;
39              
40 40 100       78 if (@_) {
41 11         42 $self->{qr_params} = [ @_ ];
42             }
43             else {
44 29         43 return @{ $self->{qr_params} };
  29         93  
45             }
46             }
47              
48             sub depends {
49 20     20 1 35 my $self = shift;
50              
51             return $self->{resolved_depends}
52 20 50       47 if $self->{resolved_depends};
53              
54 20 50       51 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         28 $self->{resolved_depends} = [ @{ $self->{depends} } ];
  20         54  
61             }
62              
63 20         34 for ( @{ $self->{resolved_depends} } ) {
  20         101  
64 11 50       36 $_ = $_->( $self, $self->qr_params )
65             if ( ref eq 'CODE' );
66             }
67              
68 20         56 $self->{resolved_depends};
69             }
70              
71             sub value_expires {
72 10     10 1 21 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     62 ( ref $self->{value_expires} eq 'CODE' ? $self->{value_expires}->( $self ) : $self->{value_expires} ) // 'never';
79             }
80              
81             sub target_expires {
82 18     18 0 38 my ( $self, $trg_obj ) = @_;
83              
84             $trg_obj->locked
85             ?
86 18 100 50     53 $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 37 my $self = shift;
93              
94             return undef
95 20 50       97 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 507 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 69 sub dep_values { shift->{dep_values} }
113 0 0 0 0 1   sub stash { $_[0]->{run_instance} && $_[0]->{run_instance}{stash} || die "The run_instance is not defined!" }
114              
115             1;
116             __END__