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

Diff Legend

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