ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Event/Handle.pm
(Generate patch)

Comparing Coro/Event/Handle.pm (file contents):
Revision 1.5 by root, Sun Sep 2 01:03:53 2001 UTC vs.
Revision 1.6 by root, Sun Sep 2 12:23:03 2001 UTC

… …
109 109
110=cut 110=cut
111 111
112sub timeout { 112sub timeout {
113 my $self = tied(${$_[0]}); 113 my $self = tied(${$_[0]});
114 if (@_) { 114 if (@_ > 1) {
115 $self->{timeout} = $_[0]; 115 $self->[2] = $_[1];
116 $self->{rw}->timeout($_[0]) if $self->{rw}; 116 $self->[5]->timeout($_[1]) if $self->[5];
117 $self->{ww}->timeout($_[0]) if $self->{ww}; 117 $self->[6]->timeout($_[1]) if $self->[6];
118 } 118 }
119 $self->{timeout}; 119 $self->[2];
120} 120}
121 121
122=item $fh->fh 122=item $fh->fh
123 123
124Returns the "real" (non-blocking) filehandle. Use this if you want to 124Returns the "real" (non-blocking) filehandle. Use this if you want to
… …
140use Coro::Event; 140use Coro::Event;
141use Event::Watcher qw(R W E); 141use Event::Watcher qw(R W E);
142 142
143use base 'Tie::Handle'; 143use base 'Tie::Handle';
144 144
145# formerly a hash, but we are speed-critical, so try
146# to be faster even if it hurts.
147#
148# 0 FH
149# 1 desc
150# 2 timeout
151# 3 rb
152# 4 wb
153# 5 rw
154# 6 ww
155
145sub TIEHANDLE { 156sub TIEHANDLE {
146 my $class = shift; 157 my $class = shift;
158 my %args = @_;
147 159
148 my $self = bless { 160 my $self = bless [], $class;
149 rb => "", 161 $self->[0] = $args{fh};
150 wb => "", 162 $self->[1] = $args{desc};
151 @_, 163 $self->[2] = $args{timeout};
152 }, $class; 164 $self->[3] = "";
165 $self->[4] = "";
153 166
154 fcntl $self->{fh}, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK 167 fcntl $self->[0], &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK
155 or croak "fcntl(O_NONBLOCK): $!"; 168 or croak "fcntl(O_NONBLOCK): $!";
156 169
157 $self; 170 $self;
158} 171}
159 172
173sub cleanup {
174 $_[0][3] = "";
175 ($_[0][5])->cancel if exists $_[0][5]; $_[0][5] = undef;
176
177 $_[0][4] = "";
178 ($_[0][6])->cancel if exists $_[0][6]; $_[0][6] = undef;
179}
180
160sub OPEN { 181sub OPEN {
182 &cleanup;
161 my $self = shift; 183 my $self = shift;
162 $self->CLOSE;
163 my $r = @_ == 2 ? open $self->{fh}, $_[0], $_[1] 184 my $r = @_ == 2 ? open $self->[0], $_[0], $_[1]
164 : open $self->{fh}, $_[0], $_[1], $_[2]; 185 : open $self->[0], $_[0], $_[1], $_[2];
165 if ($r) { 186 if ($r) {
166 fcntl $self->{fh}, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK 187 fcntl $self->[0], &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK
167 or croak "fcntl(O_NONBLOCK): $!"; 188 or croak "fcntl(O_NONBLOCK): $!";
168 } 189 }
169 $r; 190 $r;
170} 191}
171 192
172sub CLOSE { 193sub CLOSE {
173 my $self = shift; 194 &cleanup;
174 $self->{rb} = 195 close $_[0][0];
175 $self->{wb} = ""; 196}
176 (delete $self->{rw})->cancel if exists $self->{rw}; 197
177 (delete $self->{ww})->cancel if exists $self->{ww}; 198sub DESTROY {
178 close $self->{fh}; 199 &cleanup;
179} 200}
180 201
181sub FILENO { 202sub FILENO {
182 fileno $_[0]->{fh}; 203 fileno $_[0][0];
204}
205
206sub readable {
207 ($_[0][5] ||= Coro::Event->io(
208 fd => $_[0][0],
209 desc => "$_[0][1] R",
210 timeout => $_[0][2],
211 poll => R+E,
212 ))->next->{Coro::Event}[5] & R;
183} 213}
184 214
185sub writable { 215sub writable {
186 ($_[0]->{ww} ||= Coro::Event->io( 216 ($_[0][6] ||= Coro::Event->io(
187 fd => $_[0]->{fh}, 217 fd => $_[0][0],
188 desc => "$_[0]->{desc} WW", 218 desc => "$_[0][1] W",
189 timeout => $_[0]->{timeout}, 219 timeout => $_[0][2],
190 poll => W+E, 220 poll => W+E,
191 ))->next->{Coro::Event}[5] & W; 221 ))->next->{Coro::Event}[5] & W;
192} 222}
193 223
194sub readable {
195 ($_[0]->{rw} ||= Coro::Event->io(
196 fd => $_[0]->{fh},
197 desc => "$_[0]->{desc} RW",
198 timeout => $_[0]->{timeout},
199 poll => R+E,
200 ))->next->{Coro::Event}[5] & R;
201}
202
203sub WRITE { 224sub WRITE {
204 my $self = $_[0];
205 my $len = defined $_[2] ? $_[2] : length $_[1]; 225 my $len = defined $_[2] ? $_[2] : length $_[1];
206 my $ofs = $_[3]; 226 my $ofs = $_[3];
207 my $res = 0; 227 my $res = 0;
208 228
209 while() { 229 while() {
210 my $r = syswrite $self->{fh}, $_[1], $len, $ofs; 230 my $r = syswrite $_[0][0], $_[1], $len, $ofs;
211 if (defined $r) { 231 if (defined $r) {
212 $len -= $r; 232 $len -= $r;
213 $ofs += $r; 233 $ofs += $r;
214 $res += $r; 234 $res += $r;
215 last unless $len; 235 last unless $len;
216 } elsif ($! != Errno::EAGAIN) { 236 } elsif ($! != Errno::EAGAIN) {
217 last; 237 last;
218 } 238 }
219 last unless writable $self; 239 last unless &writable;
220 } 240 }
221 241
222 return $res; 242 return $res;
223} 243}
224 244
225sub READ { 245sub READ {
226 my $self = $_[0];
227 my $len = $_[2]; 246 my $len = $_[2];
228 my $ofs = $_[3]; 247 my $ofs = $_[3];
229 my $res = 0; 248 my $res = 0;
230 249
231 # first deplete the read buffer 250 # first deplete the read buffer
232 if (exists $self->{rb}) { 251 if (defined $_[0][3]) {
233 my $l = length $self->{rb}; 252 my $l = length $_[0][3];
234 if ($l <= $len) { 253 if ($l <= $len) {
235 substr($_[1], $ofs) = delete $self->{rb}; 254 substr($_[1], $ofs) = $_[0][3]; undef $_[0][3];
236 $len -= $l; 255 $len -= $l;
237 $res += $l; 256 $res += $l;
238 return $res unless $len; 257 return $res unless $len;
239 } else { 258 } else {
240 substr($_[1], $ofs) = substr($self->{rb}, 0, $len); 259 substr($_[1], $ofs) = substr($_[0][3], 0, $len);
241 substr($self->{rb}, 0, $len) = ""; 260 substr($_[0][3], 0, $len) = "";
242 return $len; 261 return $len;
243 } 262 }
244 } 263 }
245 264
246 while() { 265 while() {
247 my $r = sysread $self->{fh}, $_[1], $len, $ofs; 266 my $r = sysread $_[0][0], $_[1], $len, $ofs;
248 if (defined $r) { 267 if (defined $r) {
249 $len -= $r; 268 $len -= $r;
250 $ofs += $r; 269 $ofs += $r;
251 $res += $r; 270 $res += $r;
252 last unless $len && $r; 271 last unless $len && $r;
253 } elsif ($! != Errno::EAGAIN) { 272 } elsif ($! != Errno::EAGAIN) {
254 last; 273 last;
255 } 274 }
256 last unless readable $self; 275 last unless &readable;
257 } 276 }
258 277
259 return $res; 278 return $res;
260} 279}
261 280
262sub READLINE { 281sub READLINE {
263 my $self = shift;
264 my $irs = @_ ? shift : $/; 282 my $irs = @_ > 1 ? $_[1] : $/;
265 283
266 while() { 284 while() {
267 my $pos = index $self->{rb}, $irs; 285 my $pos = index $_[0][3], $irs;
268 if ($pos >= 0) { 286 if ($pos >= 0) {
269 $pos += length $irs; 287 $pos += length $irs;
270 my $res = substr $self->{rb}, 0, $pos; 288 my $res = substr $_[0][3], 0, $pos;
271 substr ($self->{rb}, 0, $pos) = ""; 289 substr ($_[0][3], 0, $pos) = "";
272 return $res; 290 return $res;
273 } 291 }
274 my $r = sysread $self->{fh}, $self->{rb}, 8192, length $self->{rb}; 292
293 my $r = sysread $_[0][0], $_[0][3], 8192, length $_[0][3];
275 if (defined $r) { 294 if (defined $r) {
276 return undef unless $r; 295 return undef unless $r;
277 } elsif ($! != Errno::EAGAIN || !readable $self) { 296 } elsif ($! != Errno::EAGAIN || !&readable) {
278 return undef; 297 return undef;
279 } 298 }
280 } 299 }
281}
282
283sub DESTROY {
284 &CLOSE;
285} 300}
286 301
2871; 3021;
288 303
289=head1 BUGS 304=head1 BUGS

Diff Legend

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