line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
25
|
|
|
25
|
|
171
|
use strict; |
|
25
|
|
|
|
|
54
|
|
|
25
|
|
|
|
|
968
|
|
2
|
|
|
|
|
|
|
package Event::Watcher; |
3
|
25
|
|
|
25
|
|
133
|
use base 'Exporter'; |
|
25
|
|
|
|
|
47
|
|
|
25
|
|
|
|
|
3360
|
|
4
|
25
|
|
|
25
|
|
183
|
use Carp; |
|
25
|
|
|
|
|
67
|
|
|
25
|
|
|
|
|
1719
|
|
5
|
25
|
|
|
25
|
|
156
|
use vars qw(@EXPORT_OK @ATTRIBUTE); |
|
25
|
|
|
|
|
51
|
|
|
25
|
|
|
|
|
2376
|
|
6
|
|
|
|
|
|
|
@EXPORT_OK = qw(ACTIVE SUSPEND R W E T); |
7
|
|
|
|
|
|
|
@ATTRIBUTE = qw(cb cbtime desc debug prio reentrant repeat max_cb_tm); |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub register { |
10
|
25
|
|
|
25
|
|
182
|
no strict 'refs'; |
|
25
|
|
|
|
|
50
|
|
|
25
|
|
|
|
|
10645
|
|
11
|
127
|
|
|
127
|
0
|
325
|
my $package = caller; |
12
|
|
|
|
|
|
|
|
13
|
127
|
|
|
|
|
216
|
my $name = $package; |
14
|
127
|
|
|
|
|
878
|
$name =~ s/^.*:://; |
15
|
|
|
|
|
|
|
|
16
|
127
|
|
|
|
|
254
|
my $sub = \&{"$package\::new"}; |
|
127
|
|
|
|
|
471
|
|
17
|
127
|
50
|
|
|
|
435
|
die "can't find $package\::new" |
18
|
|
|
|
|
|
|
if !$sub; |
19
|
127
|
|
|
|
|
906
|
*{"Event::".$name} = sub { |
20
|
3819
|
|
|
3819
|
|
1897253
|
shift; |
21
|
3819
|
|
|
|
|
10447
|
$sub->("Event::".$name, @_); |
22
|
127
|
|
|
|
|
560
|
}; |
23
|
|
|
|
|
|
|
|
24
|
127
|
50
|
|
|
|
564
|
&Event::add_hooks if @_; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $warn_noise = 10; |
28
|
|
|
|
|
|
|
sub init { |
29
|
3818
|
50
|
|
3818
|
0
|
8241
|
croak "Event::Watcher::init wants 2 args" if @_ != 2; |
30
|
3818
|
|
|
|
|
6713
|
my ($o, $arg) = @_; |
31
|
|
|
|
|
|
|
|
32
|
3818
|
|
|
|
|
9859
|
for my $k (keys %$arg) { |
33
|
18794
|
50
|
|
|
|
34260
|
if ($k =~ s/^e_//) { |
34
|
0
|
0
|
|
|
|
0
|
Carp::cluck "'e_$k' is renamed to '$k'" |
35
|
|
|
|
|
|
|
if --$warn_noise >= 0; |
36
|
0
|
|
|
|
|
0
|
$arg->{$k} = delete $arg->{"e_$k"}; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
3818
|
100
|
|
|
|
9247
|
if (!exists $arg->{desc}) { |
41
|
|
|
|
|
|
|
# try to find caller but cope with optimized-away frames & etc |
42
|
3796
|
|
|
|
|
6383
|
for my $up (1..4) { |
43
|
7592
|
|
|
|
|
36973
|
my @fr = caller $up; |
44
|
7592
|
100
|
66
|
|
|
36628
|
next if !@fr || $fr[0] =~ m/^Event\b/; |
45
|
3796
|
|
|
|
|
8233
|
my ($file,$line) = @fr[1,2]; |
46
|
3796
|
|
|
|
|
10834
|
$file =~ s,^.*/,,; |
47
|
3796
|
|
|
|
|
16925
|
$o->desc("?? $file:$line"); |
48
|
3796
|
|
|
|
|
8385
|
last; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# set up prio |
53
|
|
|
|
|
|
|
{ |
54
|
25
|
|
|
25
|
|
233
|
no strict 'refs'; |
|
25
|
|
|
|
|
90
|
|
|
25
|
|
|
|
|
6834
|
|
|
3818
|
|
|
|
|
4652
|
|
55
|
3818
|
|
100
|
|
|
4656
|
$o->prio($ { ref($o)."::DefaultPriority" } || Event::PRIO_NORMAL()); |
56
|
3818
|
100
|
|
|
|
8368
|
if (exists $arg->{nice}) { |
57
|
3
|
|
|
|
|
13
|
$o->prio($o->prio + delete $arg->{nice}); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
$o->prio(-1) |
61
|
3818
|
100
|
|
|
|
6835
|
if delete $arg->{async}; |
62
|
|
|
|
|
|
|
$o->prio(delete $arg->{prio}) |
63
|
3818
|
100
|
|
|
|
11964
|
if exists $arg->{prio}; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# is parked? |
66
|
3818
|
|
|
|
|
5614
|
my $parked = delete $arg->{parked}; |
67
|
|
|
|
|
|
|
|
68
|
3818
|
|
|
|
|
8574
|
for my $k (keys %$arg) { |
69
|
15047
|
|
|
|
|
18719
|
my $m = $k; |
70
|
15047
|
100
|
|
|
|
34417
|
if ($o->can($m)) { |
71
|
11320
|
|
|
|
|
32492
|
$o->$m($arg->{$k}); |
72
|
11319
|
|
|
|
|
19241
|
next; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
3817
|
50
|
|
|
|
7560
|
Carp::cluck "creating ".ref($o)." desc='".$o->desc."'\n" |
77
|
|
|
|
|
|
|
if $Event::DebugLevel >= 3; |
78
|
|
|
|
|
|
|
|
79
|
3817
|
100
|
|
|
|
166507
|
$o->start unless $parked; |
80
|
3809
|
|
|
|
|
8942
|
$o; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub attributes { |
84
|
25
|
|
|
25
|
|
216
|
no strict 'refs'; |
|
25
|
|
|
|
|
72
|
|
|
25
|
|
|
|
|
8569
|
|
85
|
3
|
|
|
3
|
0
|
7
|
my ($o) = @_; |
86
|
3
|
100
|
|
|
|
20
|
my $pk = ref $o? ref $o : $o; |
87
|
3
|
|
|
|
|
6
|
@{"$ {pk}::ATTRIBUTE"}, map { attributes($_) } @{"$ {pk}::ISA"}; |
|
3
|
|
|
|
|
17
|
|
|
2
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
25
|
|
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub configure { |
91
|
0
|
|
|
0
|
0
|
0
|
my $o = shift; |
92
|
0
|
0
|
|
|
|
0
|
if (! @_) { |
93
|
0
|
|
|
|
|
0
|
map { $_, $o->$_() } $o->attributes; |
|
0
|
|
|
|
|
0
|
|
94
|
|
|
|
|
|
|
} else { |
95
|
0
|
|
|
|
|
0
|
while (my ($k,$v)= splice @_, -2) { $o->$k($v)} |
|
0
|
|
|
|
|
0
|
|
96
|
|
|
|
|
|
|
1 # whatever |
97
|
0
|
|
|
|
|
0
|
} |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub private { # assumes $self is a HASH ref |
101
|
6
|
|
|
6
|
0
|
18
|
my $self = shift; |
102
|
6
|
|
|
|
|
13
|
my $pkg = caller; |
103
|
6
|
100
|
|
|
|
14
|
if (@_) { |
104
|
2
|
|
|
|
|
7
|
$self->{$pkg} = shift |
105
|
|
|
|
|
|
|
} else { |
106
|
4
|
|
|
|
|
14
|
$self->{$pkg}; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub data { # assumes $self is a HASH ref |
111
|
3
|
|
|
3
|
0
|
8
|
my $self = shift; |
112
|
3
|
100
|
|
|
|
8
|
if (@_) { |
113
|
|
|
|
|
|
|
$self->{_user_data_} = shift |
114
|
1
|
|
|
|
|
5
|
} else { |
115
|
2
|
|
|
|
|
9
|
$self->{_user_data_}; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub clump { |
120
|
0
|
|
|
0
|
0
|
|
require Carp; |
121
|
0
|
|
|
|
|
|
Carp::cluck "clump is deprecated"; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
package Event::Watcher::Tied; |
125
|
25
|
|
|
25
|
|
191
|
use vars qw(@ISA @ATTRIBUTE); |
|
25
|
|
|
|
|
77
|
|
|
25
|
|
|
|
|
2312
|
|
126
|
|
|
|
|
|
|
@ISA = 'Event::Watcher'; |
127
|
|
|
|
|
|
|
@ATTRIBUTE = qw(hard at flags); |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
1; |