line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Amon2::Trigger; |
2
|
21
|
|
|
21
|
|
101648
|
use strict; |
|
21
|
|
|
|
|
53
|
|
|
21
|
|
|
|
|
600
|
|
3
|
21
|
|
|
21
|
|
102
|
use warnings; |
|
21
|
|
|
|
|
44
|
|
|
21
|
|
|
|
|
554
|
|
4
|
21
|
|
|
21
|
|
564
|
use parent qw/Exporter/; |
|
21
|
|
|
|
|
353
|
|
|
21
|
|
|
|
|
165
|
|
5
|
21
|
|
|
21
|
|
1132
|
use Scalar::Util (); |
|
21
|
|
|
|
|
41
|
|
|
21
|
|
|
|
|
391
|
|
6
|
21
|
|
|
21
|
|
97
|
use mro; |
|
21
|
|
|
|
|
45
|
|
|
21
|
|
|
|
|
188
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our @EXPORT = qw/add_trigger call_trigger get_trigger_code/; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub add_trigger { |
11
|
8
|
|
|
8
|
1
|
4835
|
my ($class, %args) = @_; |
12
|
|
|
|
|
|
|
|
13
|
8
|
100
|
|
|
|
27
|
if (ref $class) { |
14
|
2
|
|
|
|
|
9
|
while (my ($hook, $code) = each %args) { |
15
|
2
|
|
|
|
|
4
|
push @{$class->{_trigger}->{$hook}}, $code; |
|
2
|
|
|
|
|
10
|
|
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
} else { |
18
|
21
|
|
|
21
|
|
2371
|
no strict 'refs'; |
|
21
|
|
|
|
|
56
|
|
|
21
|
|
|
|
|
4685
|
|
19
|
6
|
|
|
|
|
33
|
while (my ($hook, $code) = each %args) { |
20
|
7
|
|
|
|
|
13
|
push @{${"${class}::_trigger"}->{$hook}}, $code; |
|
7
|
|
|
|
|
10
|
|
|
7
|
|
|
|
|
66
|
|
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub call_trigger { |
26
|
26
|
|
|
26
|
1
|
2523
|
my ($class, $hook, @args) = @_; |
27
|
26
|
|
|
|
|
66
|
my @code = $class->get_trigger_code($hook); |
28
|
26
|
|
|
|
|
74
|
for my $code (@code) { |
29
|
6
|
|
|
|
|
17
|
$code->($class, @args); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub get_trigger_code { |
34
|
48
|
|
|
48
|
1
|
103
|
my ($class, $hook) = @_; |
35
|
48
|
|
|
|
|
69
|
my @code; |
36
|
48
|
50
|
|
|
|
175
|
if (Scalar::Util::blessed($class)) { |
37
|
48
|
100
|
|
|
|
80
|
push @code, @{ $class->{_trigger}->{$hook} || [] }; |
|
48
|
|
|
|
|
284
|
|
38
|
48
|
|
|
|
|
122
|
$class = ref $class; |
39
|
|
|
|
|
|
|
} |
40
|
21
|
|
|
21
|
|
157
|
no strict 'refs'; |
|
21
|
|
|
|
|
61
|
|
|
21
|
|
|
|
|
2667
|
|
41
|
48
|
|
33
|
|
|
213
|
my $klass = ref $class || $class; |
42
|
48
|
|
|
|
|
78
|
for (@{mro::get_linear_isa($class)}) { |
|
48
|
|
|
|
|
188
|
|
43
|
173
|
100
|
|
|
|
311
|
push @code, @{${"${_}::_trigger"}->{$hook} || []}; |
|
173
|
|
|
|
|
196
|
|
|
173
|
|
|
|
|
726
|
|
44
|
|
|
|
|
|
|
} |
45
|
48
|
|
|
|
|
154
|
return @code; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
1; |
49
|
|
|
|
|
|
|
__END__ |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head1 NAME |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
Amon2::Trigger - Trigger system for Amon2 |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 SYNOPSIS |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
package MyClass; |
58
|
|
|
|
|
|
|
use parent qw/Amon2::Trigger/; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
__PACKAGE__->add_trigger('Foo'); |
61
|
|
|
|
|
|
|
__PACKAGE__->call_trigger('Foo'); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head1 DESCRIPTION |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
This is a trigger system for Amon2. You can use this class for your class using trigger system. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 METHODS |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=over 4 |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=item C<< __PACKAGE__->add_trigger($name:Str, \&code:CodeRef) >> |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=item C<< $obj->add_trigger($name:Str, \&code:CodeRef) >> |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
You can register the callback function for the class or object. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
When you register callback code on object, the callback is only registered to object, not for class. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
I<Return Value>: Not defined. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item C<< __PACKAGE__->call_trigger($name:Str); >> |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=item C<< $obj->call_trigger($name:Str); >> |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
This method calls all callback code for $name. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
I<Return Value>: Not defined. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item C<< __PACKAGE__->get_trigger_code($name:Str) >> |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item C<< $obj->get_trigger_code($name:Str) >> |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
You can get all of trigger code from the class and ancestors. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=back |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head1 FAQ |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=over 4 |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=item WHY DON'T YOU USE L<Class::Trigger>? |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
L<Class::Trigger> does not support get_trigger_code. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=back |