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.17 by root, Fri Jul 17 23:12:20 2009 UTC vs.
Revision 1.30 by root, Thu Aug 18 19:35:15 2011 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(croak);
27use Fcntl ();
28 28
29use AnyEvent (); BEGIN { AnyEvent::common_sense } 29use AnyEvent (); BEGIN { AnyEvent::common_sense }
30use AnyEvent::Util ();
31 30
32our @ISA; 31AnyEvent::_isa_hook 0 => "AnyEvent::Strict", 1;
33 32
34AnyEvent::post_detect { 33BEGIN {
35 # assume the first ISA member is the implementation 34 if (defined &Internals::SvREADONLY) {
36 # # and link us in before it in the chain. 35 # readonly available (at least 5.8.9+, working better in 5.10.1+)
37 my $MODEL = shift @AnyEvent::ISA; 36 *wrap = sub {
38 unshift @ISA, $MODEL; 37 my $cb = shift;
39 unshift @AnyEvent::ISA, AnyEvent::Strict:: 38
40}; 39 sub {
40 Internals::SvREADONLY $_, 1;
41 &$cb;
42 Internals::SvREADONLY $_, 0;
43 }
44 };
45 } else {
46 # or not :/
47 my $magic = []; # a unique magic value
48
49 *wrap = sub {
50 my $cb = shift;
51
52 sub {
53 local $_ = $magic;
54
55 &$cb;
56
57 if (!ref $_ || $_ != $magic) {
58 require AnyEvent::Debug;
59 die "callback $cb (" . AnyEvent::Debug::cb2str ($cb) . ") modified \$_ without restoring it.\n";
60 }
61 }
62 };
63 }
64}
41 65
42sub io { 66sub io {
43 my $class = shift; 67 my $class = shift;
44 my %arg = @_; 68 my %arg = @_;
45 69
46 ref $arg{cb} 70 ref $arg{cb}
47 or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'"; 71 or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
48 delete $arg{cb}; 72 my $cb = wrap delete $arg{cb};
49 73
50 $arg{poll} =~ /^[rw]$/ 74 $arg{poll} =~ /^[rw]$/
51 or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'"; 75 or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
52 76
53 if (defined fileno $arg{fh} or ref $arg{fh} or $arg{fh} !~ /^\s*\d+\s*$/) { 77 if ($arg{fh} =~ /^\s*\d+\s*$/) {
78 $arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
79 } else {
54 defined fileno $arg{fh} 80 defined eval { fileno $arg{fh} }
55 or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'"; 81 or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
56 } else {
57 $arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
58 } 82 }
59 83
60 -f $arg{fh} 84 -f $arg{fh}
61 and croak "AnyEvent->io called with fh argument pointing to a file"; 85 and croak "AnyEvent->io called with fh argument pointing to a file";
62 86
… …
64 delete $arg{fh}; 88 delete $arg{fh};
65 89
66 croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg 90 croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
67 if keys %arg; 91 if keys %arg;
68 92
69 $class->SUPER::io (@_) 93 $class->SUPER::io (@_, cb => $cb)
70} 94}
71 95
72sub timer { 96sub timer {
73 my $class = shift; 97 my $class = shift;
74 my %arg = @_; 98 my %arg = @_;
75 99
76 ref $arg{cb} 100 ref $arg{cb}
77 or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'"; 101 or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
78 delete $arg{cb}; 102 my $cb = wrap delete $arg{cb};
79 103
80 exists $arg{after} 104 exists $arg{after}
81 or croak "AnyEvent->timer called without mandatory 'after' parameter"; 105 or croak "AnyEvent->timer called without mandatory 'after' parameter";
82 delete $arg{after}; 106 delete $arg{after};
83 107
… …
86 delete $arg{interval}; 110 delete $arg{interval};
87 111
88 croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg 112 croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
89 if keys %arg; 113 if keys %arg;
90 114
91 $class->SUPER::timer (@_) 115 $class->SUPER::timer (@_, cb => $cb)
92} 116}
93 117
94sub signal { 118sub signal {
95 my $class = shift; 119 my $class = shift;
96 my %arg = @_; 120 my %arg = @_;
97 121
98 ref $arg{cb} 122 ref $arg{cb}
99 or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'"; 123 or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
100 delete $arg{cb}; 124 my $cb = wrap delete $arg{cb};
101 125
102 defined AnyEvent::Util::sig2num $arg{signal} 126 defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0
103 or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'"; 127 or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
104 delete $arg{signal}; 128 delete $arg{signal};
105 129
106 croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg 130 croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
107 if keys %arg; 131 if keys %arg;
108 132
109 $class->SUPER::signal (@_) 133 $class->SUPER::signal (@_, cb => $cb)
110} 134}
111 135
112sub child { 136sub child {
113 my $class = shift; 137 my $class = shift;
114 my %arg = @_; 138 my %arg = @_;
115 139
116 ref $arg{cb} 140 ref $arg{cb}
117 or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'"; 141 or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
118 delete $arg{cb}; 142 my $cb = wrap delete $arg{cb};
119 143
120 $arg{pid} =~ /^-?\d+$/ 144 $arg{pid} =~ /^-?\d+$/
121 or croak "AnyEvent->child called with malformed pid value '$arg{pid}'"; 145 or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
122 delete $arg{pid}; 146 delete $arg{pid};
123 147
124 croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg 148 croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
125 if keys %arg; 149 if keys %arg;
126 150
127 $class->SUPER::child (@_) 151 $class->SUPER::child (@_, cb => $cb)
128} 152}
129 153
130sub idle { 154sub idle {
131 my $class = shift; 155 my $class = shift;
132 my %arg = @_; 156 my %arg = @_;
133 157
134 ref $arg{cb} 158 ref $arg{cb}
135 or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'"; 159 or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
136 delete $arg{cb}; 160 my $cb = wrap delete $arg{cb};
137 161
138 croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg 162 croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
139 if keys %arg; 163 if keys %arg;
140 164
141 $class->SUPER::idle (@_) 165 $class->SUPER::idle (@_, cb => $cb)
142} 166}
143 167
144sub condvar { 168sub condvar {
145 my $class = shift; 169 my $class = shift;
146 my %arg = @_; 170 my %arg = @_;
147 171
148 !exists $arg{cb} or ref $arg{cb} 172 !exists $arg{cb} or ref $arg{cb}
149 or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'"; 173 or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
150 delete $arg{cb}; 174 my @cb = exists $arg{cb} ? (cb => wrap delete $arg{cb}) : ();
151 175
152 croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg 176 croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
153 if keys %arg; 177 if keys %arg;
154 178
155 $class->SUPER::condvar (@_) 179 $class->SUPER::condvar (@cb);
156} 180}
157 181
158sub time { 182sub time {
159 my $class = shift; 183 my $class = shift;
160 184

Diff Legend

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