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.42 by root, Tue May 27 06:23:15 2008 UTC vs.
Revision 1.54 by root, Tue Jun 3 09:02:46 2008 UTC

… …
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util qw(WSAEWOULDBLOCK); 7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 8use Scalar::Util ();
9use Carp (); 9use Carp ();
10use Fcntl (); 10use Fcntl ();
11use Errno qw/EAGAIN EINTR/; 11use Errno qw(EAGAIN EINTR);
12 12
13=head1 NAME 13=head1 NAME
14 14
15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 16
17=cut 17=cut
18 18
19our $VERSION = '0.04'; 19our $VERSION = 4.12;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
… …
75NOTE: The filehandle will be set to non-blocking (using 75NOTE: The filehandle will be set to non-blocking (using
76AnyEvent::Util::fh_nonblocking). 76AnyEvent::Util::fh_nonblocking).
77 77
78=item on_eof => $cb->($handle) 78=item on_eof => $cb->($handle)
79 79
80Set the callback to be called on EOF. 80Set the callback to be called when an end-of-file condition is detcted,
81i.e. in the case of a socket, when the other side has closed the
82connection cleanly.
81 83
82While not mandatory, it is highly recommended to set an eof callback, 84While not mandatory, it is highly recommended to set an eof callback,
83otherwise you might end up with a closed socket while you are still 85otherwise you might end up with a closed socket while you are still
84waiting for data. 86waiting for data.
85 87
86=item on_error => $cb->($handle) 88=item on_error => $cb->($handle, $fatal)
87 89
88This is the fatal error callback, that is called when, well, a fatal error 90This is the error callback, which is called when, well, some error
89occurs, such as not being able to resolve the hostname, failure to connect 91occured, such as not being able to resolve the hostname, failure to
90or a read error. 92connect or a read error.
91 93
92The object will not be in a usable state when this callback has been 94Some errors are fatal (which is indicated by C<$fatal> being true). On
93called. 95fatal errors the handle object will be shut down and will not be
96usable. Non-fatal errors can be retried by simply returning, but it is
97recommended to simply ignore this parameter and instead abondon the handle
98object when this callback is invoked.
94 99
95On callback entrance, the value of C<$!> contains the operating system 100On callback entrance, the value of C<$!> contains the operating system
96error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>). 101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
97
98The callback should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you.
100 102
101While not mandatory, it is I<highly> recommended to set this callback, as 103While not mandatory, it is I<highly> recommended to set this callback, as
102you will not be notified of errors otherwise. The default simply calls 104you will not be notified of errors otherwise. The default simply calls
103die. 105C<croak>.
104 106
105=item on_read => $cb->($handle) 107=item on_read => $cb->($handle)
106 108
107This sets the default read callback, which is called when data arrives 109This sets the default read callback, which is called when data arrives
108and no read request is in the queue. 110and no read request is in the queue.
… …
119 121
120This sets the callback that is called when the write buffer becomes empty 122This sets the callback that is called when the write buffer becomes empty
121(or when the callback is set and the buffer is empty already). 123(or when the callback is set and the buffer is empty already).
122 124
123To append to the write buffer, use the C<< ->push_write >> method. 125To append to the write buffer, use the C<< ->push_write >> method.
126
127=item timeout => $fractional_seconds
128
129If non-zero, then this enables an "inactivity" timeout: whenever this many
130seconds pass without a successful read or write on the underlying file
131handle, the C<on_timeout> callback will be invoked (and if that one is
132missing, an C<ETIMEDOUT> error will be raised).
133
134Note that timeout processing is also active when you currently do not have
135any outstanding read or write requests: If you plan to keep the connection
136idle then you should disable the timout temporarily or ignore the timeout
137in the C<on_timeout> callback.
138
139Zero (the default) disables this timeout.
140
141=item on_timeout => $cb->($handle)
142
143Called whenever the inactivity timeout passes. If you return from this
144callback, then the timeout will be reset as if some activity had happened,
145so this condition is not fatal in any way.
124 146
125=item rbuf_max => <bytes> 147=item rbuf_max => <bytes>
126 148
127If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>) 149If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)
128when the read buffer ever (strictly) exceeds this size. This is useful to 150when the read buffer ever (strictly) exceeds this size. This is useful to
… …
135isn't finished). 157isn't finished).
136 158
137=item read_size => <bytes> 159=item read_size => <bytes>
138 160
139The default read block size (the amount of bytes this module will try to read 161The default read block size (the amount of bytes this module will try to read
140on each [loop iteration). Default: C<4096>. 162during each (loop iteration). Default: C<8192>.
141 163
142=item low_water_mark => <bytes> 164=item low_water_mark => <bytes>
143 165
144Sets the amount of bytes (default: C<0>) that make up an "empty" write 166Sets the amount of bytes (default: C<0>) that make up an "empty" write
145buffer: If the write reaches this size or gets even samller it is 167buffer: If the write reaches this size or gets even samller it is
… …
202 if ($self->{tls}) { 224 if ($self->{tls}) {
203 require Net::SSLeay; 225 require Net::SSLeay;
204 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}); 226 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
205 } 227 }
206 228
207 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; 229# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop
208 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 230# $self->on_error (delete $self->{on_error}) if $self->{on_error}; # nop
231# $self->on_read (delete $self->{on_read} ) if $self->{on_read}; # nop
209 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 232 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
210 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 233
234 $self->{_activity} = AnyEvent->now;
235 $self->_timeout;
211 236
212 $self->start_read; 237 $self->start_read;
213 238
214 $self 239 $self
215} 240}
216 241
217sub _shutdown { 242sub _shutdown {
218 my ($self) = @_; 243 my ($self) = @_;
219 244
245 delete $self->{_tw};
220 delete $self->{_rw}; 246 delete $self->{_rw};
221 delete $self->{_ww}; 247 delete $self->{_ww};
222 delete $self->{fh}; 248 delete $self->{fh};
223}
224 249
250 $self->stoptls;
251}
252
225sub error { 253sub _error {
226 my ($self) = @_; 254 my ($self, $errno, $fatal) = @_;
227 255
228 {
229 local $!;
230 $self->_shutdown; 256 $self->_shutdown
231 } 257 if $fatal;
232 258
233 $self->{on_error}($self) 259 $! = $errno;
260
234 if $self->{on_error}; 261 if ($self->{on_error}) {
235 262 $self->{on_error}($self, $fatal);
263 } else {
236 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 264 Carp::croak "AnyEvent::Handle uncaught error: $!";
265 }
237} 266}
238 267
239=item $fh = $handle->fh 268=item $fh = $handle->fh
240 269
241This method returns the file handle of the L<AnyEvent::Handle> object. 270This method returns the file handle of the L<AnyEvent::Handle> object.
… …
260 289
261=cut 290=cut
262 291
263sub on_eof { 292sub on_eof {
264 $_[0]{on_eof} = $_[1]; 293 $_[0]{on_eof} = $_[1];
294}
295
296=item $handle->on_timeout ($cb)
297
298Replace the current C<on_timeout> callback, or disables the callback
299(but not the timeout) if C<$cb> = C<undef>. See C<timeout> constructor
300argument.
301
302=cut
303
304sub on_timeout {
305 $_[0]{on_timeout} = $_[1];
306}
307
308#############################################################################
309
310=item $handle->timeout ($seconds)
311
312Configures (or disables) the inactivity timeout.
313
314=cut
315
316sub timeout {
317 my ($self, $timeout) = @_;
318
319 $self->{timeout} = $timeout;
320 $self->_timeout;
321}
322
323# reset the timeout watcher, as neccessary
324# also check for time-outs
325sub _timeout {
326 my ($self) = @_;
327
328 if ($self->{timeout}) {
329 my $NOW = AnyEvent->now;
330
331 # when would the timeout trigger?
332 my $after = $self->{_activity} + $self->{timeout} - $NOW;
333
334 # now or in the past already?
335 if ($after <= 0) {
336 $self->{_activity} = $NOW;
337
338 if ($self->{on_timeout}) {
339 $self->{on_timeout}($self);
340 } else {
341 $self->_error (&Errno::ETIMEDOUT);
342 }
343
344 # callbakx could have changed timeout value, optimise
345 return unless $self->{timeout};
346
347 # calculate new after
348 $after = $self->{timeout};
349 }
350
351 Scalar::Util::weaken $self;
352
353 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
354 delete $self->{_tw};
355 $self->_timeout;
356 });
357 } else {
358 delete $self->{_tw};
359 }
265} 360}
266 361
267############################################################################# 362#############################################################################
268 363
269=back 364=back
… …
316 my $len = syswrite $self->{fh}, $self->{wbuf}; 411 my $len = syswrite $self->{fh}, $self->{wbuf};
317 412
318 if ($len >= 0) { 413 if ($len >= 0) {
319 substr $self->{wbuf}, 0, $len, ""; 414 substr $self->{wbuf}, 0, $len, "";
320 415
416 $self->{_activity} = AnyEvent->now;
417
321 $self->{on_drain}($self) 418 $self->{on_drain}($self)
322 if $self->{low_water_mark} >= length $self->{wbuf} 419 if $self->{low_water_mark} >= length $self->{wbuf}
323 && $self->{on_drain}; 420 && $self->{on_drain};
324 421
325 delete $self->{_ww} unless length $self->{wbuf}; 422 delete $self->{_ww} unless length $self->{wbuf};
326 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 423 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
327 $self->error; 424 $self->_error ($!, 1);
328 } 425 }
329 }; 426 };
330 427
331 # try to write data immediately 428 # try to write data immediately
332 $cb->(); 429 $cb->();
… …
352 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write") 449 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
353 ->($self, @_); 450 ->($self, @_);
354 } 451 }
355 452
356 if ($self->{filter_w}) { 453 if ($self->{filter_w}) {
357 $self->{filter_w}->($self, \$_[0]); 454 $self->{filter_w}($self, \$_[0]);
358 } else { 455 } else {
359 $self->{wbuf} .= $_[0]; 456 $self->{wbuf} .= $_[0];
360 $self->_drain_wbuf; 457 $self->_drain_wbuf;
361 } 458 }
362} 459}
363 460
364=item $handle->push_write (type => @args) 461=item $handle->push_write (type => @args)
365 462
366=item $handle->unshift_write (type => @args)
367
368Instead of formatting your data yourself, you can also let this module do 463Instead of formatting your data yourself, you can also let this module do
369the job by specifying a type and type-specific arguments. 464the job by specifying a type and type-specific arguments.
370 465
371Predefined types are (if you have ideas for additional types, feel free to 466Predefined types are (if you have ideas for additional types, feel free to
372drop by and tell us): 467drop by and tell us):
… …
375 470
376=item netstring => $string 471=item netstring => $string
377 472
378Formats the given value as netstring 473Formats the given value as netstring
379(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them). 474(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
380
381=back
382 475
383=cut 476=cut
384 477
385register_write_type netstring => sub { 478register_write_type netstring => sub {
386 my ($self, $string) = @_; 479 my ($self, $string) = @_;
… …
427 520
428 $self->{json} ? $self->{json}->encode ($ref) 521 $self->{json} ? $self->{json}->encode ($ref)
429 : JSON::encode_json ($ref) 522 : JSON::encode_json ($ref)
430}; 523};
431 524
525=back
526
432=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 527=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
433 528
434This function (not method) lets you add your own types to C<push_write>. 529This function (not method) lets you add your own types to C<push_write>.
435Whenever the given C<type> is used, C<push_write> will invoke the code 530Whenever the given C<type> is used, C<push_write> will invoke the code
436reference with the handle object and the remaining arguments. 531reference with the handle object and the remaining arguments.
… …
473the specified number of bytes which give an XML datagram. 568the specified number of bytes which give an XML datagram.
474 569
475 # in the default state, expect some header bytes 570 # in the default state, expect some header bytes
476 $handle->on_read (sub { 571 $handle->on_read (sub {
477 # some data is here, now queue the length-header-read (4 octets) 572 # some data is here, now queue the length-header-read (4 octets)
478 shift->unshift_read_chunk (4, sub { 573 shift->unshift_read (chunk => 4, sub {
479 # header arrived, decode 574 # header arrived, decode
480 my $len = unpack "N", $_[1]; 575 my $len = unpack "N", $_[1];
481 576
482 # now read the payload 577 # now read the payload
483 shift->unshift_read_chunk ($len, sub { 578 shift->unshift_read (chunk => $len, sub {
484 my $xml = $_[1]; 579 my $xml = $_[1];
485 # handle xml 580 # handle xml
486 }); 581 });
487 }); 582 });
488 }); 583 });
… …
495 590
496 # request one 591 # request one
497 $handle->push_write ("request 1\015\012"); 592 $handle->push_write ("request 1\015\012");
498 593
499 # we expect "ERROR" or "OK" as response, so push a line read 594 # we expect "ERROR" or "OK" as response, so push a line read
500 $handle->push_read_line (sub { 595 $handle->push_read (line => sub {
501 # if we got an "OK", we have to _prepend_ another line, 596 # if we got an "OK", we have to _prepend_ another line,
502 # so it will be read before the second request reads its 64 bytes 597 # so it will be read before the second request reads its 64 bytes
503 # which are already in the queue when this callback is called 598 # which are already in the queue when this callback is called
504 # we don't do this in case we got an error 599 # we don't do this in case we got an error
505 if ($_[1] eq "OK") { 600 if ($_[1] eq "OK") {
506 $_[0]->unshift_read_line (sub { 601 $_[0]->unshift_read (line => sub {
507 my $response = $_[1]; 602 my $response = $_[1];
508 ... 603 ...
509 }); 604 });
510 } 605 }
511 }); 606 });
512 607
513 # request two 608 # request two
514 $handle->push_write ("request 2\015\012"); 609 $handle->push_write ("request 2\015\012");
515 610
516 # simply read 64 bytes, always 611 # simply read 64 bytes, always
517 $handle->push_read_chunk (64, sub { 612 $handle->push_read (chunk => 64, sub {
518 my $response = $_[1]; 613 my $response = $_[1];
519 ... 614 ...
520 }); 615 });
521 616
522=over 4 617=over 4
… …
528 623
529 if ( 624 if (
530 defined $self->{rbuf_max} 625 defined $self->{rbuf_max}
531 && $self->{rbuf_max} < length $self->{rbuf} 626 && $self->{rbuf_max} < length $self->{rbuf}
532 ) { 627 ) {
533 $! = &Errno::ENOSPC; 628 return $self->_error (&Errno::ENOSPC, 1);
534 $self->error;
535 } 629 }
536 630
537 return if $self->{in_drain}; 631 return if $self->{in_drain};
538 local $self->{in_drain} = 1; 632 local $self->{in_drain} = 1;
539 633
… …
541 no strict 'refs'; 635 no strict 'refs';
542 if (my $cb = shift @{ $self->{_queue} }) { 636 if (my $cb = shift @{ $self->{_queue} }) {
543 unless ($cb->($self)) { 637 unless ($cb->($self)) {
544 if ($self->{_eof}) { 638 if ($self->{_eof}) {
545 # no progress can be made (not enough data and no data forthcoming) 639 # no progress can be made (not enough data and no data forthcoming)
546 $! = &Errno::EPIPE; 640 return $self->_error (&Errno::EPIPE, 1);
547 $self->error;
548 } 641 }
549 642
550 unshift @{ $self->{_queue} }, $cb; 643 unshift @{ $self->{_queue} }, $cb;
551 return; 644 return;
552 } 645 }
… …
558 && $len == length $self->{rbuf} # and no data has been consumed 651 && $len == length $self->{rbuf} # and no data has been consumed
559 && !@{ $self->{_queue} } # and the queue is still empty 652 && !@{ $self->{_queue} } # and the queue is still empty
560 && $self->{on_read} # and we still want to read data 653 && $self->{on_read} # and we still want to read data
561 ) { 654 ) {
562 # then no progress can be made 655 # then no progress can be made
563 $! = &Errno::EPIPE; 656 return $self->_error (&Errno::EPIPE, 1);
564 $self->error;
565 } 657 }
566 } else { 658 } else {
567 # read side becomes idle 659 # read side becomes idle
568 delete $self->{_rw}; 660 delete $self->{_rw};
569 return; 661 return;
570 } 662 }
571 } 663 }
572 664
573 if ($self->{_eof}) {
574 $self->_shutdown;
575 $self->{on_eof}($self) 665 $self->{on_eof}($self)
576 if $self->{on_eof}; 666 if $self->{_eof} && $self->{on_eof};
577 }
578} 667}
579 668
580=item $handle->on_read ($cb) 669=item $handle->on_read ($cb)
581 670
582This replaces the currently set C<on_read> callback, or clears it (when 671This replaces the currently set C<on_read> callback, or clears it (when
… …
771 my ($self, $cb) = @_; 860 my ($self, $cb) = @_;
772 861
773 sub { 862 sub {
774 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 863 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
775 if ($_[0]{rbuf} =~ /[^0-9]/) { 864 if ($_[0]{rbuf} =~ /[^0-9]/) {
776 $! = &Errno::EBADMSG; 865 $self->_error (&Errno::EBADMSG);
777 $self->error;
778 } 866 }
779 return; 867 return;
780 } 868 }
781 869
782 my $len = $1; 870 my $len = $1;
… …
785 my $string = $_[1]; 873 my $string = $_[1];
786 $_[0]->unshift_read (chunk => 1, sub { 874 $_[0]->unshift_read (chunk => 1, sub {
787 if ($_[1] eq ",") { 875 if ($_[1] eq ",") {
788 $cb->($_[0], $string); 876 $cb->($_[0], $string);
789 } else { 877 } else {
790 $! = &Errno::EBADMSG; 878 $self->_error (&Errno::EBADMSG);
791 $self->error;
792 } 879 }
793 }); 880 });
794 }); 881 });
795 882
796 1 883 1
… …
853 return 1; 940 return 1;
854 } 941 }
855 942
856 # reject 943 # reject
857 if ($reject && $$rbuf =~ $reject) { 944 if ($reject && $$rbuf =~ $reject) {
858 $! = &Errno::EBADMSG; 945 $self->_error (&Errno::EBADMSG);
859 $self->error;
860 } 946 }
861 947
862 # skip 948 # skip
863 if ($skip && $$rbuf =~ $skip) { 949 if ($skip && $$rbuf =~ $skip) {
864 $data .= substr $$rbuf, 0, $+[0], ""; 950 $data .= substr $$rbuf, 0, $+[0], "";
… …
960 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1046 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
961 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 1047 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
962 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1048 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
963 1049
964 if ($len > 0) { 1050 if ($len > 0) {
1051 $self->{_activity} = AnyEvent->now;
1052
965 $self->{filter_r} 1053 $self->{filter_r}
966 ? $self->{filter_r}->($self, $rbuf) 1054 ? $self->{filter_r}($self, $rbuf)
967 : $self->_drain_rbuf; 1055 : $self->_drain_rbuf;
968 1056
969 } elsif (defined $len) { 1057 } elsif (defined $len) {
970 delete $self->{_rw}; 1058 delete $self->{_rw};
971 $self->{_eof} = 1; 1059 $self->{_eof} = 1;
972 $self->_drain_rbuf; 1060 $self->_drain_rbuf;
973 1061
974 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1062 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
975 return $self->error; 1063 return $self->_error ($!, 1);
976 } 1064 }
977 }); 1065 });
978 } 1066 }
979} 1067}
980 1068
… …
999 1087
1000 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1088 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1001 1089
1002 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1090 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
1003 if ($err == Net::SSLeay::ERROR_SYSCALL ()) { 1091 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
1004 $self->error; 1092 return $self->_error ($!, 1);
1005 } elsif ($err == Net::SSLeay::ERROR_SSL ()) { 1093 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
1006 $! = &Errno::EIO; 1094 return $self->_error (&Errno::EIO, 1);
1007 $self->error;
1008 } 1095 }
1009 1096
1010 # all others are fine for our purposes 1097 # all others are fine for our purposes
1011 } 1098 }
1012} 1099}
… …
1027call and can be used or changed to your liking. Note that the handshake 1114call and can be used or changed to your liking. Note that the handshake
1028might have already started when this function returns. 1115might have already started when this function returns.
1029 1116
1030=cut 1117=cut
1031 1118
1032# TODO: maybe document...
1033sub starttls { 1119sub starttls {
1034 my ($self, $ssl, $ctx) = @_; 1120 my ($self, $ssl, $ctx) = @_;
1035 1121
1036 $self->stoptls; 1122 $self->stoptls;
1037 1123

Diff Legend

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