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.35 by root, Fri Sep 2 04:35:03 2011 UTC vs.
Revision 1.43 by root, Fri Sep 5 22:17:26 2014 UTC

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

Diff Legend

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