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__ |