ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Strict.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Strict.pm (file contents):
Revision 1.20 by root, Sun Feb 21 09:28:19 2010 UTC vs.
Revision 1.42 by root, Thu Aug 28 10:43:02 2014 UTC

… …
11 11
12This module implements AnyEvent's strict mode. 12This module implements AnyEvent's strict mode.
13 13
14Loading it makes AnyEvent check all arguments to AnyEvent-methods, at the 14Loading it makes AnyEvent check all arguments to AnyEvent-methods, at the
15expense of being slower (often the argument checking takes longer than the 15expense of being slower (often the argument checking takes longer than the
16actual function). 16actual function). It also wraps all callbacks to check for modifications
17of C<$_>, which indicates a programming bug inside the watcher callback.
17 18
18Normally, you don't load this module yourself but instead use it 19Normally, you don't load this module yourself but instead use it
19indirectly via the C<PERL_ANYEVENT_STRICT> environment variable (see 20indirectly via the C<PERL_ANYEVENT_STRICT> environment variable (see
20L<AnyEvent>). However, this module can be loaded at any time. 21L<AnyEvent>). However, this module can be loaded manually at any time.
21 22
22=cut 23=cut
23 24
24package AnyEvent::Strict; 25package AnyEvent::Strict;
25 26
26use Carp qw(croak); 27use Carp qw(confess);
28use Errno ();
29use POSIX ();
27 30
28use AnyEvent (); BEGIN { AnyEvent::common_sense } 31use AnyEvent (); BEGIN { AnyEvent::common_sense }
29 32
30our @ISA; 33AnyEvent::_isa_hook 1 => "AnyEvent::Strict", 1;
31 34
32AnyEvent::post_detect { 35BEGIN {
33 # assume the first ISA member is the implementation 36 if (defined &Internals::SvREADONLY) {
34 # # and link us in before it in the chain. 37 # readonly available (at least 5.8.9+, working better in 5.10.1+)
35 my $MODEL = shift @AnyEvent::ISA; 38 *wrap = sub {
36 unshift @ISA, $MODEL; 39 my $cb = shift;
37 unshift @AnyEvent::ISA, AnyEvent::Strict:: 40
41 sub {
42 local $_;
43 Internals::SvREADONLY $_, 1;
44 &$cb;
45 }
46 };
47 } else {
48 # or not :/
49 my $magic = []; # a unique magic value
50
51 *wrap = sub {
52 my $cb = shift;
53
54 sub {
55 local $_ = $magic;
56
57 &$cb;
58
59 if (!ref $_ || $_ != $magic) {
60 require AnyEvent::Debug;
61 die "callback $cb (" . AnyEvent::Debug::cb2str ($cb) . ") modified \$_ without restoring it.\n";
62 }
63 }
64 };
65 }
66}
67
68our (@FD_INUSE, $FD_I);
69our $FD_CHECK_W = AE::timer 4, 4, sub {
70 my $cnt = (@FD_INUSE < 100 * 10 ? int @FD_INUSE * 0.1 : 100) || 10;
71
72 if ($FD_I <= 0) {
73 #pop @FD_INUSE while @FD_INUSE && !$FD_INUSE[-1];
74 $FD_I = @FD_INUSE
75 or return; # empty
76 }
77
78 $cnt = $FD_I if $cnt > $FD_I;
79
80 eval {
81 do {
82 !$FD_INUSE[--$FD_I]
83 or (POSIX::lseek $FD_I, 0, 1) != -1
84 or $! != Errno::EBADF
85 or die;
86 } while --$cnt;
87 1
88 } or AE::log crit => "File descriptor $FD_I registered with AnyEvent but prematurely closed, event loop might malfunction.";
38}; 89};
39 90
40sub io { 91sub io {
41 my $class = shift; 92 my $class = shift;
42 my %arg = @_; 93 my (%arg, $fh, $cb, $fd) = @_;
43 94
44 ref $arg{cb} 95 ref $arg{cb}
45 or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'"; 96 or confess "AnyEvent->io called with illegal cb argument '$arg{cb}'";
46 delete $arg{cb}; 97 $cb = wrap delete $arg{cb};
47 98
48 $arg{poll} =~ /^[rw]$/ 99 $arg{poll} =~ /^[rw]$/
49 or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'"; 100 or confess "AnyEvent->io called with illegal poll argument '$arg{poll}'";
50 101
51 if (defined fileno $arg{fh} or ref $arg{fh} or $arg{fh} !~ /^\s*\d+\s*$/) { 102 $fh = delete $arg{fh};
52 defined fileno $arg{fh} 103
53 or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'"; 104 if ($fh =~ /^\s*\d+\s*$/) {
105 $fd = $fh;
106 $fh = AnyEvent::_dupfh $arg{poll}, $fh;
54 } else { 107 } else {
55 $arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh}; 108 defined eval { $fd = fileno $fh }
109 or confess "AnyEvent->io called with illegal fh argument '$fh'";
56 } 110 }
57 111
58 -f $arg{fh} 112 -f $fh
59 and croak "AnyEvent->io called with fh argument pointing to a file"; 113 and confess "AnyEvent->io called with fh argument pointing to a file";
60 114
61 delete $arg{poll}; 115 delete $arg{poll};
62 delete $arg{fh};
63 116
64 croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg 117 confess "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
65 if keys %arg; 118 if keys %arg;
66 119
120 ++$FD_INUSE[$fd];
121
122 bless [
123 $fd,
67 $class->SUPER::io (@_) 124 $class->SUPER::io (@_, cb => $cb)
125 ], "AnyEvent::Strict::io";
126}
127
128sub AnyEvent::Strict::io::DESTROY {
129 --$FD_INUSE[$_[0][0]];
68} 130}
69 131
70sub timer { 132sub timer {
71 my $class = shift; 133 my $class = shift;
72 my %arg = @_; 134 my %arg = @_;
73 135
74 ref $arg{cb} 136 ref $arg{cb}
75 or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'"; 137 or confess "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
76 delete $arg{cb}; 138 my $cb = wrap delete $arg{cb};
77 139
78 exists $arg{after} 140 exists $arg{after}
79 or croak "AnyEvent->timer called without mandatory 'after' parameter"; 141 or confess "AnyEvent->timer called without mandatory 'after' parameter";
80 delete $arg{after}; 142 delete $arg{after};
81 143
82 !$arg{interval} or $arg{interval} > 0 144 !$arg{interval} or $arg{interval} > 0
83 or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'"; 145 or confess "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
84 delete $arg{interval}; 146 delete $arg{interval};
85 147
86 croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg 148 confess "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
87 if keys %arg; 149 if keys %arg;
88 150
89 $class->SUPER::timer (@_) 151 $class->SUPER::timer (@_, cb => $cb)
90} 152}
91 153
92sub signal { 154sub signal {
93 my $class = shift; 155 my $class = shift;
94 my %arg = @_; 156 my %arg = @_;
95 157
96 ref $arg{cb} 158 ref $arg{cb}
97 or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'"; 159 or confess "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
98 delete $arg{cb}; 160 my $cb = wrap delete $arg{cb};
99 161
100 defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0 162 defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0
101 or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'"; 163 or confess "AnyEvent->signal called with illegal signal name '$arg{signal}'";
102 delete $arg{signal}; 164 delete $arg{signal};
103 165
104 croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg 166 confess "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
105 if keys %arg; 167 if keys %arg;
106 168
107 $class->SUPER::signal (@_) 169 $class->SUPER::signal (@_, cb => $cb)
108} 170}
109 171
110sub child { 172sub child {
111 my $class = shift; 173 my $class = shift;
112 my %arg = @_; 174 my %arg = @_;
113 175
114 ref $arg{cb} 176 ref $arg{cb}
115 or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'"; 177 or confess "AnyEvent->child called with illegal cb argument '$arg{cb}'";
116 delete $arg{cb}; 178 my $cb = wrap delete $arg{cb};
117 179
118 $arg{pid} =~ /^-?\d+$/ 180 $arg{pid} =~ /^-?\d+$/
119 or croak "AnyEvent->child called with malformed pid value '$arg{pid}'"; 181 or confess "AnyEvent->child called with malformed pid value '$arg{pid}'";
120 delete $arg{pid}; 182 delete $arg{pid};
121 183
122 croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg 184 confess "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
123 if keys %arg; 185 if keys %arg;
124 186
125 $class->SUPER::child (@_) 187 $class->SUPER::child (@_, cb => $cb)
126} 188}
127 189
128sub idle { 190sub idle {
129 my $class = shift; 191 my $class = shift;
130 my %arg = @_; 192 my %arg = @_;
131 193
132 ref $arg{cb} 194 ref $arg{cb}
133 or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'"; 195 or confess "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
134 delete $arg{cb}; 196 my $cb = wrap delete $arg{cb};
135 197
136 croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg 198 confess "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
137 if keys %arg; 199 if keys %arg;
138 200
139 $class->SUPER::idle (@_) 201 $class->SUPER::idle (@_, cb => $cb)
140} 202}
141 203
142sub condvar { 204sub condvar {
143 my $class = shift; 205 my $class = shift;
144 my %arg = @_; 206 my %arg = @_;
145 207
146 !exists $arg{cb} or ref $arg{cb} 208 !exists $arg{cb} or ref $arg{cb}
147 or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'"; 209 or confess "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
148 delete $arg{cb}; 210 my @cb = exists $arg{cb} ? (cb => wrap delete $arg{cb}) : ();
149 211
150 croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg 212 confess "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
151 if keys %arg; 213 if keys %arg;
152 214
153 $class->SUPER::condvar (@_) 215 $class->SUPER::condvar (@cb);
154} 216}
155 217
156sub time { 218sub time {
157 my $class = shift; 219 my $class = shift;
158 220
159 @_ 221 @_
160 and croak "AnyEvent->time wrongly called with paramaters"; 222 and confess "AnyEvent->time wrongly called with paramaters";
161 223
162 $class->SUPER::time (@_) 224 $class->SUPER::time (@_)
163} 225}
164 226
165sub now { 227sub now {
166 my $class = shift; 228 my $class = shift;
167 229
168 @_ 230 @_
169 and croak "AnyEvent->now wrongly called with paramaters"; 231 and confess "AnyEvent->now wrongly called with paramaters";
170 232
171 $class->SUPER::now (@_) 233 $class->SUPER::now (@_)
172} 234}
173 235
1741;
175
176=head1 AUTHOR 236=head1 AUTHOR
177 237
178 Marc Lehmann <schmorp@schmorp.de> 238 Marc Lehmann <schmorp@schmorp.de>
179 http://home.schmorp.de/ 239 http://anyevent.schmorp.de
180 240
181=cut 241=cut
182 242
2431
244

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines