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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines