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.7 by root, Tue Jan 13 22:37:18 2009 UTC vs.
Revision 1.35 by root, Fri Sep 2 04:35:03 2011 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 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(croak);
28use Errno ();
29use POSIX ();
27 30
28use AnyEvent (); 31use AnyEvent (); BEGIN { AnyEvent::common_sense }
29 32
30AnyEvent::post_detect { 33AnyEvent::_isa_hook 1 => "AnyEvent::Strict", 1;
31 # assume the first ISA member is the implementation 34
32 # # and link us in before it in the chain. 35BEGIN {
33 my $MODEL = shift @AnyEvent::ISA; 36 if (defined &Internals::SvREADONLY) {
34 unshift @ISA, $MODEL; 37 # readonly available (at least 5.8.9+, working better in 5.10.1+)
35 unshift @AnyEvent::ISA, AnyEvent::Strict:: 38 *wrap = sub {
39 my $cb = shift;
40
41 sub {
42 Internals::SvREADONLY $_, 1;
43 &$cb;
44 Internals::SvREADONLY $_, 0;
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) >= 0
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.\n";
36}; 89};
37 90
38sub io { 91sub io {
39 my $class = shift; 92 my $class = shift;
40 my %arg = @_; 93 my (%arg, $fh, $cb, $fd) = @_;
41 94
42 ref $arg{cb} 95 ref $arg{cb}
43 or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'"; 96 or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
44 delete $arg{cb}; 97 $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 98
50 $arg{poll} =~ /^[rw]$/ 99 $arg{poll} =~ /^[rw]$/
51 or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'"; 100 or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
101
102 $fh = delete $arg{fh};
103
104 if ($fh =~ /^\s*\d+\s*$/) {
105 $fd = $fh;
106 $fh = AnyEvent::_dupfh $arg{poll}, $fh;
107 } else {
108 defined eval { $fd = fileno $fh }
109 or croak "AnyEvent->io called with illegal fh argument '$fh'";
110 }
111
112 -f $fh
113 and croak "AnyEvent->io called with fh argument pointing to a file";
114
52 delete $arg{poll}; 115 delete $arg{poll};
53 116
54 croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg 117 croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
55 if keys %arg; 118 if keys %arg;
56 119
120 ++$FD_INUSE[$fd];
121
122 bless [
123 $fd,
57 $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]];
58} 130}
59 131
60sub timer { 132sub timer {
61 my $class = shift; 133 my $class = shift;
62 my %arg = @_; 134 my %arg = @_;
63 135
64 ref $arg{cb} 136 ref $arg{cb}
65 or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'"; 137 or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
66 delete $arg{cb}; 138 my $cb = wrap delete $arg{cb};
67 139
68 exists $arg{after} 140 exists $arg{after}
69 or croak "AnyEvent->timer called without mandatory 'after' parameter"; 141 or croak "AnyEvent->timer called without mandatory 'after' parameter";
70 delete $arg{after}; 142 delete $arg{after};
71 143
… …
74 delete $arg{interval}; 146 delete $arg{interval};
75 147
76 croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg 148 croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
77 if keys %arg; 149 if keys %arg;
78 150
79 $class->SUPER::timer (@_) 151 $class->SUPER::timer (@_, cb => $cb)
80} 152}
81 153
82sub signal { 154sub signal {
83 my $class = shift; 155 my $class = shift;
84 my %arg = @_; 156 my %arg = @_;
85 157
86 ref $arg{cb} 158 ref $arg{cb}
87 or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'"; 159 or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
88 delete $arg{cb}; 160 my $cb = wrap delete $arg{cb};
89 161
90 eval "require POSIX; 0 < &POSIX::SIG$arg{signal}" 162 defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0
91 or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'"; 163 or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
92 delete $arg{signal}; 164 delete $arg{signal};
93 165
94 croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg 166 croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
95 if keys %arg; 167 if keys %arg;
96 168
97 $class->SUPER::signal (@_) 169 $class->SUPER::signal (@_, cb => $cb)
98} 170}
99 171
100sub child { 172sub child {
101 my $class = shift; 173 my $class = shift;
102 my %arg = @_; 174 my %arg = @_;
103 175
104 ref $arg{cb} 176 ref $arg{cb}
105 or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'"; 177 or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
106 delete $arg{cb}; 178 my $cb = wrap delete $arg{cb};
107 179
108 $arg{pid} =~ /^-?\d+$/ 180 $arg{pid} =~ /^-?\d+$/
109 or croak "AnyEvent->signal called with illegal pid value '$arg{pid}'"; 181 or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
110 delete $arg{pid}; 182 delete $arg{pid};
111 183
184 croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
185 if keys %arg;
186
187 $class->SUPER::child (@_, cb => $cb)
188}
189
190sub idle {
191 my $class = shift;
192 my %arg = @_;
193
194 ref $arg{cb}
195 or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
196 my $cb = wrap delete $arg{cb};
197
112 croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg 198 croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
113 if keys %arg; 199 if keys %arg;
114 200
115 $class->SUPER::child (@_) 201 $class->SUPER::idle (@_, cb => $cb)
116} 202}
117 203
118sub condvar { 204sub condvar {
119 my $class = shift; 205 my $class = shift;
120 my %arg = @_; 206 my %arg = @_;
121 207
122 !exists $arg{cb} or ref $arg{cb} 208 !exists $arg{cb} or ref $arg{cb}
123 or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'"; 209 or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
124 delete $arg{cb}; 210 my @cb = exists $arg{cb} ? (cb => wrap delete $arg{cb}) : ();
125 211
126 croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg 212 croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
127 if keys %arg; 213 if keys %arg;
128 214
129 $class->SUPER::condvar (@_) 215 $class->SUPER::condvar (@cb);
130} 216}
131 217
132sub time { 218sub time {
133 my $class = shift; 219 my $class = shift;
134 220

Diff Legend

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