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

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.1 by elmex, Sun Apr 27 16:56:17 2008 UTC vs.
Revision 1.17 by root, Sat May 24 04:17:45 2008 UTC

1package AnyEvent::Handle; 1package AnyEvent::Handle;
2 2
3use warnings; 3no warnings;
4use strict; 4use strict;
5 5
6use AnyEvent; 6use AnyEvent ();
7use IO::Handle; 7use AnyEvent::Util ();
8use Scalar::Util ();
9use Carp ();
10use Fcntl ();
8use Errno qw/EAGAIN EINTR/; 11use Errno qw/EAGAIN EINTR/;
9 12
10=head1 NAME 13=head1 NAME
11 14
12AnyEvent::Handle - non-blocking I/O on filehandles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on filehandles via AnyEvent
13 16
14=head1 VERSION 17This module is experimental.
15 18
16Version 0.01
17
18=cut 19=cut
19 20
20our $VERSION = '0.01'; 21our $VERSION = '0.04';
21 22
22=head1 SYNOPSIS 23=head1 SYNOPSIS
23 24
24 use AnyEvent; 25 use AnyEvent;
25 use AnyEvent::Handle; 26 use AnyEvent::Handle;
26 27
27 my $cv = AnyEvent->condvar; 28 my $cv = AnyEvent->condvar;
28 29
29 my $ae_fh = AnyEvent::Handle->new (fh => \*STDIN); 30 my $ae_fh = AnyEvent::Handle->new (fh => \*STDIN);
30 31
32 #TODO
33
34 # or use the constructor to pass the callback:
35
36 my $ae_fh2 =
37 AnyEvent::Handle->new (
38 fh => \*STDIN,
39 on_eof => sub {
40 $cv->broadcast;
41 },
42 #TODO
43 );
44
45 $cv->wait;
46
47=head1 DESCRIPTION
48
49This module is a helper module to make it easier to do event-based I/O on
50filehandles. For utility functions for doing non-blocking connects and accepts
51on sockets see L<AnyEvent::Util>.
52
53In the following, when the documentation refers to of "bytes" then this
54means characters. As sysread and syswrite are used for all I/O, their
55treatment of characters applies to this module as well.
56
57All callbacks will be invoked with the handle object as their first
58argument.
59
60=head1 METHODS
61
62=over 4
63
64=item B<new (%args)>
65
66The constructor supports these arguments (all as key => value pairs).
67
68=over 4
69
70=item fh => $filehandle [MANDATORY]
71
72The filehandle this L<AnyEvent::Handle> object will operate on.
73
74NOTE: The filehandle will be set to non-blocking (using
75AnyEvent::Util::fh_nonblocking).
76
77=item on_eof => $cb->($self)
78
79Set the callback to be called on EOF.
80
81While not mandatory, it is highly recommended to set an eof callback,
82otherwise you might end up with a closed socket while you are still
83waiting for data.
84
85=item on_error => $cb->($self)
86
87This is the fatal error callback, that is called when, well, a fatal error
88ocurs, such as not being able to resolve the hostname, failure to connect
89or a read error.
90
91The object will not be in a usable state when this callback has been
92called.
93
94On callback entrance, the value of C<$!> contains the operating system
95error (or C<ENOSPC> or C<EPIPE>).
96
97While not mandatory, it is I<highly> recommended to set this callback, as
98you will not be notified of errors otherwise. The default simply calls
99die.
100
101=item on_read => $cb->($self)
102
103This sets the default read callback, which is called when data arrives
104and no read request is in the queue.
105
106To access (and remove data from) the read buffer, use the C<< ->rbuf >>
107method or acces sthe C<$self->{rbuf}> member directly.
108
109When an EOF condition is detected then AnyEvent::Handle will first try to
110feed all the remaining data to the queued callbacks and C<on_read> before
111calling the C<on_eof> callback. If no progress can be made, then a fatal
112error will be raised (with C<$!> set to C<EPIPE>).
113
114=item on_drain => $cb->()
115
116This sets the callback that is called when the write buffer becomes empty
117(or when the callback is set and the buffer is empty already).
118
119To append to the write buffer, use the C<< ->push_write >> method.
120
121=item rbuf_max => <bytes>
122
123If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)
124when the read buffer ever (strictly) exceeds this size. This is useful to
125avoid denial-of-service attacks.
126
127For example, a server accepting connections from untrusted sources should
128be configured to accept only so-and-so much data that it cannot act on
129(for example, when expecting a line, an attacker could send an unlimited
130amount of data without a callback ever being called as long as the line
131isn't finished).
132
133=item read_size => <bytes>
134
135The default read block size (the amount of bytes this module will try to read
136on each [loop iteration). Default: C<4096>.
137
138=item low_water_mark => <bytes>
139
140Sets the amount of bytes (default: C<0>) that make up an "empty" write
141buffer: If the write reaches this size or gets even samller it is
142considered empty.
143
144=back
145
146=cut
147
148sub new {
149 my $class = shift;
150
151 my $self = bless { @_ }, $class;
152
153 $self->{fh} or Carp::croak "mandatory argument fh is missing";
154
155 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
156
157 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};
158 $self->on_error (delete $self->{on_error}) if $self->{on_error};
159 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
160 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
161
162 $self->start_read;
163
164 $self
165}
166
167sub _shutdown {
168 my ($self) = @_;
169
170 delete $self->{rw};
171 delete $self->{ww};
172 delete $self->{fh};
173}
174
175sub error {
176 my ($self) = @_;
177
178 {
179 local $!;
180 $self->_shutdown;
181 }
182
183 if ($self->{on_error}) {
184 $self->{on_error}($self);
185 } else {
186 die "AnyEvent::Handle uncaught fatal error: $!";
187 }
188}
189
190=item $fh = $handle->fh
191
192This method returns the filehandle of the L<AnyEvent::Handle> object.
193
194=cut
195
196sub fh { $_[0]->{fh} }
197
198=item $handle->on_error ($cb)
199
200Replace the current C<on_error> callback (see the C<on_error> constructor argument).
201
202=cut
203
204sub on_error {
205 $_[0]{on_error} = $_[1];
206}
207
208=item $handle->on_eof ($cb)
209
210Replace the current C<on_eof> callback (see the C<on_eof> constructor argument).
211
212=cut
213
214sub on_eof {
215 $_[0]{on_eof} = $_[1];
216}
217
218#############################################################################
219
220=back
221
222=head2 WRITE QUEUE
223
224AnyEvent::Handle manages two queues per handle, one for writing and one
225for reading.
226
227The write queue is very simple: you can add data to its end, and
228AnyEvent::Handle will automatically try to get rid of it for you.
229
230When data could be writtena nd the write buffer is shorter then the low
231water mark, the C<on_drain> callback will be invoked.
232
233=over 4
234
235=item $handle->on_drain ($cb)
236
237Sets the C<on_drain> callback or clears it (see the description of
238C<on_drain> in the constructor).
239
240=cut
241
242sub on_drain {
243 my ($self, $cb) = @_;
244
245 $self->{on_drain} = $cb;
246
247 $cb->($self)
248 if $cb && $self->{low_water_mark} >= length $self->{wbuf};
249}
250
251=item $handle->push_write ($data)
252
253Queues the given scalar to be written. You can push as much data as you
254want (only limited by the available memory), as C<AnyEvent::Handle>
255buffers it independently of the kernel.
256
257=cut
258
259sub _drain_wbuf {
260 my ($self) = @_;
261
262 unless ($self->{ww}) {
263 Scalar::Util::weaken $self;
264 my $cb = sub {
265 my $len = syswrite $self->{fh}, $self->{wbuf};
266
267 if ($len > 0) {
268 substr $self->{wbuf}, 0, $len, "";
269
270 $self->{on_drain}($self)
271 if $self->{low_water_mark} >= length $self->{wbuf}
272 && $self->{on_drain};
273
274 delete $self->{ww} unless length $self->{wbuf};
275 } elsif ($! != EAGAIN && $! != EINTR) {
276 $self->error;
277 }
278 };
279
280 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb);
281
282 $cb->($self);
283 };
284}
285
286sub push_write {
287 my $self = shift;
288
289 if ($self->{filter_w}) {
290 $self->{filter_w}->(\$_[0]);
291 } else {
292 $self->{wbuf} .= $_[0];
293 $self->_drain_wbuf;
294 }
295}
296
297#############################################################################
298
299=back
300
301=head2 READ QUEUE
302
303AnyEvent::Handle manages two queues per handle, one for writing and one
304for reading.
305
306The read queue is more complex than the write queue. It can be used in two
307ways, the "simple" way, using only C<on_read> and the "complex" way, using
308a queue.
309
310In the simple case, you just install an C<on_read> callback and whenever
311new data arrives, it will be called. You can then remove some data (if
312enough is there) from the read buffer (C<< $handle->rbuf >>) if you want
313or not.
314
315In the more complex case, you want to queue multiple callbacks. In this
316case, AnyEvent::Handle will call the first queued callback each time new
317data arrives and removes it when it has done its job (see C<push_read>,
318below).
319
320This way you can, for example, push three line-reads, followed by reading
321a chunk of data, and AnyEvent::Handle will execute them in order.
322
323Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by
324the specified number of bytes which give an XML datagram.
325
326 # in the default state, expect some header bytes
327 $handle->on_read (sub {
328 # some data is here, now queue the length-header-read (4 octets)
329 shift->unshift_read_chunk (4, sub {
330 # header arrived, decode
331 my $len = unpack "N", $_[1];
332
333 # now read the payload
334 shift->unshift_read_chunk ($len, sub {
335 my $xml = $_[1];
336 # handle xml
337 });
338 });
339 });
340
341Example 2: Implement a client for a protocol that replies either with
342"OK" and another line or "ERROR" for one request, and 64 bytes for the
343second request. Due tot he availability of a full queue, we can just
344pipeline sending both requests and manipulate the queue as necessary in
345the callbacks:
346
347 # request one
348 $handle->push_write ("request 1\015\012");
349
350 # we expect "ERROR" or "OK" as response, so push a line read
31 $ae_fh->readlines (sub { 351 $handle->push_read_line (sub {
32 my ($ae_fh, @lines) = @_; 352 # if we got an "OK", we have to _prepend_ another line,
33 for (@lines) { 353 # so it will be read before the second request reads its 64 bytes
34 chomp; 354 # which are already in the queue when this callback is called
35 print "Line: $_"; 355 # we don't do this in case we got an error
356 if ($_[1] eq "OK") {
357 $_[0]->unshift_read_line (sub {
358 my $response = $_[1];
359 ...
360 });
36 } 361 }
37 $cv->broadcast;
38 }); 362 });
39 363
40 $cv->wait; 364 # request two
365 $handle->push_write ("request 2\015\012");
41 366
42=head1 DESCRIPTION 367 # simply read 64 bytes, always
43 368 $handle->push_read_chunk (64, sub {
44This module is a helper module to make it easier to do non-blocking I/O 369 my $response = $_[1];
45on filehandles (and sockets, see L<AnyEvent::Socket>). 370 ...
46 371 });
47The event loop is provided by L<AnyEvent>.
48
49=head1 METHODS
50 372
51=over 4 373=over 4
52 374
53=item B<new (%args)>
54
55The constructor has these arguments:
56
57=over 4
58
59=item fh => $filehandle
60
61The filehandle this L<AnyEvent::Handle> object will operate on.
62
63NOTE: The filehandle will be set to non-blocking.
64
65=item read_block_size => $size
66
67The default read block size use for reads via the C<on_read>
68method.
69
70=back
71
72=cut 375=cut
73 376
74sub new { 377sub _drain_rbuf {
75 my $this = shift;
76 my $class = ref($this) || $this;
77 my $self = { 378 my ($self) = @_;
78 read_block_size => 4096, 379
79 rbuf => '', 380 if (
80 @_ 381 defined $self->{rbuf_max}
382 && $self->{rbuf_max} < length $self->{rbuf}
383 ) {
384 $! = &Errno::ENOSPC; return $self->error;
81 }; 385 }
82 bless $self, $class;
83 386
84 $self->{fh}->blocking (0) if $self->{fh}; 387 return if $self->{in_drain};
388 local $self->{in_drain} = 1;
85 389
86 if ($self->{on_read}) { 390 while (my $len = length $self->{rbuf}) {
87 $self->on_read ($self->{on_read}); 391 no strict 'refs';
392 if (my $cb = shift @{ $self->{queue} }) {
393 if (!$cb->($self)) {
394 if ($self->{eof}) {
395 # no progress can be made (not enough data and no data forthcoming)
396 $! = &Errno::EPIPE; return $self->error;
397 }
88 398
399 unshift @{ $self->{queue} }, $cb;
400 return;
401 }
89 } elsif ($self->{on_readline}) { 402 } elsif ($self->{on_read}) {
90 $self->readlines ($self->{on_readline}); 403 $self->{on_read}($self);
91 }
92 404
93 return $self 405 if (
94} 406 $self->{eof} # if no further data will arrive
407 && $len == length $self->{rbuf} # and no data has been consumed
408 && !@{ $self->{queue} } # and the queue is still empty
409 && $self->{on_read} # and we still want to read data
410 ) {
411 # then no progress can be made
412 $! = &Errno::EPIPE; return $self->error;
413 }
414 } else {
415 # read side becomes idle
416 delete $self->{rw};
417 return;
418 }
419 }
95 420
96=item B<fh> 421 if ($self->{eof}) {
422 $self->_shutdown;
423 $self->{on_eof}($self)
424 if $self->{on_eof};
425 }
426}
97 427
98This method returns the filehandle of the L<AnyEvent::Handle> object. 428=item $handle->on_read ($cb)
99 429
100=cut 430This replaces the currently set C<on_read> callback, or clears it (when
101 431the new callback is C<undef>). See the description of C<on_read> in the
102sub fh { $_[0]->{fh} } 432constructor.
103
104=item B<on_read ($callback)>
105
106This method installs a C<$callback> that will be called
107when new data arrived. You can access the read buffer via the C<rbuf>
108method (see below).
109
110The first argument of the C<$callback> will be the L<AnyEvent::Handle> object.
111 433
112=cut 434=cut
113 435
114sub on_read { 436sub on_read {
115 my ($self, $cb) = @_; 437 my ($self, $cb) = @_;
438
116 $self->{on_read} = $cb; 439 $self->{on_read} = $cb;
440}
117 441
118 unless (defined $self->{on_read}) { 442=item $handle->rbuf
443
444Returns the read buffer (as a modifiable lvalue).
445
446You can access the read buffer directly as the C<< ->{rbuf} >> member, if
447you want.
448
449NOTE: The read buffer should only be used or modified if the C<on_read>,
450C<push_read> or C<unshift_read> methods are used. The other read methods
451automatically manage the read buffer.
452
453=cut
454
455sub rbuf : lvalue {
456 $_[0]{rbuf}
457}
458
459=item $handle->push_read ($cb)
460
461=item $handle->unshift_read ($cb)
462
463Append the given callback to the end of the queue (C<push_read>) or
464prepend it (C<unshift_read>).
465
466The callback is called each time some additional read data arrives.
467
468It must check wether enough data is in the read buffer already.
469
470If not enough data is available, it must return the empty list or a false
471value, in which case it will be called repeatedly until enough data is
472available (or an error condition is detected).
473
474If enough data was available, then the callback must remove all data it is
475interested in (which can be none at all) and return a true value. After returning
476true, it will be removed from the queue.
477
478=cut
479
480sub push_read {
481 my ($self, $cb) = @_;
482
483 push @{ $self->{queue} }, $cb;
484 $self->_drain_rbuf;
485}
486
487sub unshift_read {
488 my ($self, $cb) = @_;
489
490 push @{ $self->{queue} }, $cb;
491 $self->_drain_rbuf;
492}
493
494=item $handle->push_read_chunk ($len, $cb->($self, $data))
495
496=item $handle->unshift_read_chunk ($len, $cb->($self, $data))
497
498Append the given callback to the end of the queue (C<push_read_chunk>) or
499prepend it (C<unshift_read_chunk>).
500
501The callback will be called only once C<$len> bytes have been read, and
502these C<$len> bytes will be passed to the callback.
503
504=cut
505
506sub _read_chunk($$) {
507 my ($self, $len, $cb) = @_;
508
509 sub {
510 $len <= length $_[0]{rbuf} or return;
511 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
512 1
513 }
514}
515
516sub push_read_chunk {
517 $_[0]->push_read (&_read_chunk);
518}
519
520
521sub unshift_read_chunk {
522 $_[0]->unshift_read (&_read_chunk);
523}
524
525=item $handle->push_read_line ([$eol, ]$cb->($self, $line, $eol))
526
527=item $handle->unshift_read_line ([$eol, ]$cb->($self, $line, $eol))
528
529Append the given callback to the end of the queue (C<push_read_line>) or
530prepend it (C<unshift_read_line>).
531
532The callback will be called only once a full line (including the end of
533line marker, C<$eol>) has been read. This line (excluding the end of line
534marker) will be passed to the callback as second argument (C<$line>), and
535the end of line marker as the third argument (C<$eol>).
536
537The end of line marker, C<$eol>, can be either a string, in which case it
538will be interpreted as a fixed record end marker, or it can be a regex
539object (e.g. created by C<qr>), in which case it is interpreted as a
540regular expression.
541
542The end of line marker argument C<$eol> is optional, if it is missing (NOT
543undef), then C<qr|\015?\012|> is used (which is good for most internet
544protocols).
545
546Partial lines at the end of the stream will never be returned, as they are
547not marked by the end of line marker.
548
549=cut
550
551sub _read_line($$) {
552 my $self = shift;
553 my $cb = pop;
554 my $eol = @_ ? shift : qr|(\015?\012)|;
555 my $pos;
556
557 $eol = quotemeta $eol unless ref $eol;
558 $eol = qr|^(.*?)($eol)|s;
559
560 sub {
561 $_[0]{rbuf} =~ s/$eol// or return;
562
563 $cb->($_[0], $1, $2);
564 1
565 }
566}
567
568sub push_read_line {
569 $_[0]->push_read (&_read_line);
570}
571
572sub unshift_read_line {
573 $_[0]->unshift_read (&_read_line);
574}
575
576=item $handle->stop_read
577
578=item $handle->start_read
579
580In rare cases you actually do not want to read anything form the
581socket. In this case you can call C<stop_read>. Neither C<on_read> no
582any queued callbacks will be executed then. To start readign again, call
583C<start_read>.
584
585=cut
586
587sub stop_read {
588 my ($self) = @_;
589
119 delete $self->{on_read_w}; 590 delete $self->{rw};
120 return; 591}
121 } 592
122 593sub start_read {
123 $self->{on_read_w} = 594 my ($self) = @_;
124 AnyEvent->io (poll => 'r', fh => $self->{fh}, cb => sub { 595
125 #d# warn "READ:[$self->{read_size}] $self->{read_block_size} : ".length ($self->{rbuf})."\n"; 596 unless ($self->{rw} || $self->{eof}) {
126 my $rbuf_len = length $self->{rbuf}; 597 Scalar::Util::weaken $self;
127 my $l; 598
128 if (defined $self->{read_size}) { 599 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
129 $l = sysread $self->{fh}, $self->{rbuf}, 600 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
130 ($self->{read_size} - $rbuf_len), $rbuf_len;
131 } else {
132 $l = sysread $self->{fh}, $self->{rbuf}, $self->{read_block_size}, $rbuf_len; 601 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
133 }
134 #d# warn "READL $l [$self->{rbuf}]\n";
135 602
603 if ($len > 0) {
604 $self->{filter_r}
605 ? $self->{filter_r}->($rbuf)
606 : $self->_drain_rbuf;
607
136 if (not defined $l) { 608 } elsif (defined $len) {
137 return if $! == EAGAIN || $! == EINTR;
138 $self->{on_error}->($self, $!) if $self->{on_error};
139 delete $self->{on_read_w}; 609 delete $self->{rw};
610 $self->{eof} = 1;
611 $self->_drain_rbuf;
140 612
141 } elsif ($l == 0) { 613 } elsif ($! != EAGAIN && $! != EINTR) {
142 $self->{on_eof}->($self) if $self->{on_eof}; 614 return $self->error;
143 delete $self->{on_read_w};
144
145 } else {
146 $self->{on_read}->($self);
147 } 615 }
148 }); 616 });
149}
150
151=item B<on_error ($callback)>
152
153Whenever a read or write operation resulted in an error the C<$callback>
154will be called.
155
156The first argument of C<$callback> will be the L<AnyEvent::Handle> object itself
157and the second argument will be the value of C<$!>.
158
159=cut
160
161sub on_error {
162 $_[0]->{on_error} = $_[1];
163}
164
165=item B<on_eof ($callback)>
166
167Installs the C<$callback> that will be called when the end of file is
168encountered in a read operation this C<$callback> will be called. The first
169argument will be the L<AnyEvent::Handle> object itself.
170
171=cut
172
173sub on_eof {
174 $_[0]->{on_eof} = $_[1];
175}
176
177=item B<rbuf>
178
179Returns a reference to the read buffer.
180
181NOTE: The read buffer should only be used or modified if the C<on_read>
182method is used directly. The C<read> and C<readlines> methods will provide
183the read data to their callbacks.
184
185=cut
186
187sub rbuf : lvalue { $_[0]->{rbuf} }
188
189=item B<read ($len, $callback)>
190
191Will read exactly C<$len> bytes from the filehandle and call the C<$callback>
192if done so. The first argument to the C<$callback> will be the L<AnyEvent::Handle>
193object itself and the second argument the read data.
194
195NOTE: This method will override any callbacks installed via the C<on_read> method.
196
197=cut
198
199sub read {
200 my ($self, $len, $cb) = @_;
201
202 $self->{read_cb} = $cb;
203 my $old_blk_size = $self->{read_block_size};
204 $self->{read_block_size} = $len;
205
206 $self->on_read (sub {
207 #d# warn "OFOFO $len || ".length($_[0]->{rbuf})."||\n";
208
209 if ($len == length $_[0]->{rbuf}) {
210 $_[0]->{read_block_size} = $old_blk_size;
211 $_[0]->on_read (undef);
212 $_[0]->{read_cb}->($_[0], (substr $self->{rbuf}, 0, $len, ''));
213 }
214 }); 617 }
215}
216
217=item B<readlines ($callback)>
218
219=item B<readlines ($sep, $callback)>
220
221This method will read lines from the filehandle, seperated by C<$sep> or C<"\n">
222if C<$sep> is not provided. C<$sep> will be used as part of a regex, so it can be
223a regex itself and won't be quoted!
224
225The C<$callback> will be called when at least one
226line could be read. The first argument to the C<$callback> will be the L<AnyEvent::Handle>
227object itself and the rest of the arguments will be the read lines.
228
229NOTE: This method will override any callbacks installed via the C<on_read> method.
230
231=cut
232
233sub readlines {
234 my ($self, $NL, $cb) = @_;
235
236 if (ref $NL) {
237 $cb = $NL;
238 $NL = "\n";
239 }
240
241 $self->{on_readline} = $cb;
242
243 $self->on_read (sub {
244 my @lines;
245 push @lines, $1 while $_[0]->{rbuf} =~ s/(.*)$NL//;
246 $self->{on_readline}->($_[0], @lines);
247 });
248}
249
250=item B<write ($data)>
251
252=item B<write ($callback)>
253
254=item B<write ($data, $callback)>
255
256This method will write C<$data> to the filehandle and call the C<$callback>
257afterwards. If only C<$callback> is provided it will be called when the
258write buffer becomes empty the next time (or immediately if it already is empty).
259
260=cut
261
262sub write {
263 my ($self, $data, $cb) = @_;
264 if (ref $data) { $cb = $data; undef $data }
265 push @{$self->{write_bufs}}, [$data, $cb];
266 $self->_check_writer;
267}
268
269sub _check_writer {
270 my ($self) = @_;
271
272 if ($self->{write_w}) {
273 unless ($self->{write_cb}) {
274 while (@{$self->{write_bufs}} && not defined $self->{write_bufs}->[0]->[1]) {
275 my $wba = shift @{$self->{write_bufs}};
276 $self->{wbuf} .= $wba->[0];
277 }
278 }
279 return;
280 }
281
282 my $wba = shift @{$self->{write_bufs}}
283 or return;
284
285 unless (defined $wba->[0]) {
286 $wba->[1]->($self) if $wba->[1];
287 $self->_check_writer;
288 return;
289 }
290
291 $self->{wbuf} = $wba->[0];
292 $self->{write_cb} = $wba->[1];
293
294 $self->{write_w} =
295 AnyEvent->io (poll => 'w', fh => $self->{fh}, cb => sub {
296 my $l = syswrite $self->{fh}, $self->{wbuf}, length $self->{wbuf};
297
298 if (not defined $l) {
299 return if $! == EAGAIN || $! == EINTR;
300 delete $self->{write_w};
301
302 $self->{on_error}->($self, $!) if $self->{on_error};
303
304 } else {
305 substr $self->{wbuf}, 0, $l, '';
306
307 if (length ($self->{wbuf}) == 0) {
308 $self->{write_cb}->($self) if $self->{write_cb};
309
310 delete $self->{write_w};
311 delete $self->{wbuf};
312 delete $self->{write_cb};
313
314 $self->_check_writer;
315 }
316 }
317 });
318} 618}
319 619
320=back 620=back
321 621
322=head1 AUTHOR 622=head1 AUTHOR
323 623
324Robin Redeker, C<< <elmex at ta-sa.org> >> 624Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
325
326=head1 BUGS
327
328Please report any bugs or feature requests to
329C<bug-io-anyevent at rt.cpan.org>, or through the web interface at
330L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IO-AnyEvent>.
331I will be notified, and then you'll automatically be notified of progress on
332your bug as I make changes.
333
334=head1 SUPPORT
335
336You can find documentation for this module with the perldoc command.
337
338 perldoc AnyEvent::Handle
339
340You can also look for information at:
341
342=over 4
343
344=item * AnnoCPAN: Annotated CPAN documentation
345
346L<http://annocpan.org/dist/IO-AnyEvent>
347
348=item * CPAN Ratings
349
350L<http://cpanratings.perl.org/d/IO-AnyEvent>
351
352=item * RT: CPAN's request tracker
353
354L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=IO-AnyEvent>
355
356=item * Search CPAN
357
358L<http://search.cpan.org/dist/IO-AnyEvent>
359
360=back
361
362=head1 ACKNOWLEDGEMENTS
363
364=head1 COPYRIGHT & LICENSE
365
366Copyright 2008 Robin Redeker, all rights reserved.
367
368This program is free software; you can redistribute it and/or modify it
369under the same terms as Perl itself.
370 625
371=cut 626=cut
372 627
3731; # End of AnyEvent::Handle 6281; # End of AnyEvent::Handle

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines