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

Diff Legend

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