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.6 by root, Fri Nov 21 01:35:59 2008 UTC vs.
Revision 1.43 by root, Fri Sep 5 22:17:26 2014 UTC

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

Diff Legend

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