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.160 by root, Fri Jul 24 22:47:04 2009 UTC vs.
Revision 1.181 by root, Tue Sep 1 10:40:05 2009 UTC

1package AnyEvent::Handle;
2
3use Scalar::Util ();
4use Carp ();
5use Errno qw(EAGAIN EINTR);
6
7use AnyEvent (); BEGIN { AnyEvent::common_sense }
8use AnyEvent::Util qw(WSAEWOULDBLOCK);
9
10=head1 NAME 1=head1 NAME
11 2
12AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 3AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
13
14=cut
15
16our $VERSION = 4.86;
17 4
18=head1 SYNOPSIS 5=head1 SYNOPSIS
19 6
20 use AnyEvent; 7 use AnyEvent;
21 use AnyEvent::Handle; 8 use AnyEvent::Handle;
… …
59C<on_error> callback. 46C<on_error> callback.
60 47
61All callbacks will be invoked with the handle object as their first 48All callbacks will be invoked with the handle object as their first
62argument. 49argument.
63 50
51=cut
52
53package AnyEvent::Handle;
54
55use Scalar::Util ();
56use List::Util ();
57use Carp ();
58use Errno qw(EAGAIN EINTR);
59
60use AnyEvent (); BEGIN { AnyEvent::common_sense }
61use AnyEvent::Util qw(WSAEWOULDBLOCK);
62
63our $VERSION = $AnyEvent::VERSION;
64
64=head1 METHODS 65=head1 METHODS
65 66
66=over 4 67=over 4
67 68
68=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value... 69=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value...
… …
100This (rarely used) callback is called before a new connection is 101This (rarely used) callback is called before a new connection is
101attempted, but after the file handle has been created. It could be used to 102attempted, but after the file handle has been created. It could be used to
102prepare the file handle with parameters required for the actual connect 103prepare the file handle with parameters required for the actual connect
103(as opposed to settings that can be changed when the connection is already 104(as opposed to settings that can be changed when the connection is already
104established). 105established).
106
107The return value of this callback should be the connect timeout value in
108seconds (or C<0>, or C<undef>, or the empty list, to indicate the default
109timeout is to be used).
105 110
106=item on_connect => $cb->($handle, $host, $port, $retry->()) 111=item on_connect => $cb->($handle, $host, $port, $retry->())
107 112
108This callback is called when a connection has been successfully established. 113This callback is called when a connection has been successfully established.
109 114
… …
212memory and push it into the queue, but instead only read more data from 217memory and push it into the queue, but instead only read more data from
213the file when the write queue becomes empty. 218the file when the write queue becomes empty.
214 219
215=item timeout => $fractional_seconds 220=item timeout => $fractional_seconds
216 221
222=item rtimeout => $fractional_seconds
223
224=item wtimeout => $fractional_seconds
225
217If non-zero, then this enables an "inactivity" timeout: whenever this many 226If non-zero, then these enables an "inactivity" timeout: whenever this
218seconds pass without a successful read or write on the underlying file 227many seconds pass without a successful read or write on the underlying
219handle, the C<on_timeout> callback will be invoked (and if that one is 228file handle (or a call to C<timeout_reset>), the C<on_timeout> callback
220missing, a non-fatal C<ETIMEDOUT> error will be raised). 229will be invoked (and if that one is missing, a non-fatal C<ETIMEDOUT>
230error will be raised).
231
232There are three variants of the timeouts that work fully independent
233of each other, for both read and write, just read, and just write:
234C<timeout>, C<rtimeout> and C<wtimeout>, with corresponding callbacks
235C<on_timeout>, C<on_rtimeout> and C<on_wtimeout>, and reset functions
236C<timeout_reset>, C<rtimeout_reset>, and C<wtimeout_reset>.
221 237
222Note that timeout processing is also active when you currently do not have 238Note that timeout processing is also active when you currently do not have
223any outstanding read or write requests: If you plan to keep the connection 239any outstanding read or write requests: If you plan to keep the connection
224idle then you should disable the timout temporarily or ignore the timeout 240idle then you should disable the timout temporarily or ignore the timeout
225in the C<on_timeout> callback, in which case AnyEvent::Handle will simply 241in the C<on_timeout> callback, in which case AnyEvent::Handle will simply
… …
434 delete $self->{_skip_drain_rbuf}; 450 delete $self->{_skip_drain_rbuf};
435 $self->_start; 451 $self->_start;
436 452
437 $self->{on_connect} 453 $self->{on_connect}
438 and $self->{on_connect}($self, $host, $port, sub { 454 and $self->{on_connect}($self, $host, $port, sub {
439 delete @$self{qw(fh _tw _ww _rw _eof _queue rbuf _wbuf tls _tls_rbuf _tls_wbuf)}; 455 delete @$self{qw(fh _tw _rtw _wtw _ww _rw _eof _queue rbuf _wbuf tls _tls_rbuf _tls_wbuf)};
440 $self->{_skip_drain_rbuf} = 1; 456 $self->{_skip_drain_rbuf} = 1;
441 &$retry; 457 &$retry;
442 }); 458 });
443 459
444 } else { 460 } else {
445 if ($self->{on_connect_error}) { 461 if ($self->{on_connect_error}) {
446 $self->{on_connect_error}($self, "$!"); 462 $self->{on_connect_error}($self, "$!");
447 $self->destroy; 463 $self->destroy;
448 } else { 464 } else {
449 $self->fatal ($!, 1); 465 $self->_error ($!, 1);
450 } 466 }
451 } 467 }
452 }, 468 },
453 sub { 469 sub {
454 local $self->{fh} = $_[0]; 470 local $self->{fh} = $_[0];
455 471
472 $self->{on_prepare}
456 $self->{on_prepare}->($self) 473 ? $self->{on_prepare}->($self)
457 if $self->{on_prepare}; 474 : ()
458 } 475 }
459 ); 476 );
460 } 477 }
461 478
462 } else { 479 } else {
… …
469sub _start { 486sub _start {
470 my ($self) = @_; 487 my ($self) = @_;
471 488
472 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 489 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
473 490
491 $self->{_activity} =
492 $self->{_ractivity} =
474 $self->{_activity} = AnyEvent->now; 493 $self->{_wactivity} = AE::now;
475 $self->_timeout; 494
495 $self->timeout (delete $self->{timeout} ) if $self->{timeout};
496 $self->rtimeout (delete $self->{rtimeout}) if $self->{rtimeout};
497 $self->wtimeout (delete $self->{wtimeout}) if $self->{wtimeout};
476 498
477 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay}; 499 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
478 500
479 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) 501 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx})
480 if $self->{tls}; 502 if $self->{tls};
… …
484 $self->start_read 506 $self->start_read
485 if $self->{on_read} || @{ $self->{_queue} }; 507 if $self->{on_read} || @{ $self->{_queue} };
486 508
487 $self->_drain_wbuf; 509 $self->_drain_wbuf;
488} 510}
489
490#sub _shutdown {
491# my ($self) = @_;
492#
493# delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)};
494# $self->{_eof} = 1; # tell starttls et. al to stop trying
495#
496# &_freetls;
497#}
498 511
499sub _error { 512sub _error {
500 my ($self, $errno, $fatal, $message) = @_; 513 my ($self, $errno, $fatal, $message) = @_;
501 514
502 $! = $errno; 515 $! = $errno;
… …
539 $_[0]{on_eof} = $_[1]; 552 $_[0]{on_eof} = $_[1];
540} 553}
541 554
542=item $handle->on_timeout ($cb) 555=item $handle->on_timeout ($cb)
543 556
544Replace the current C<on_timeout> callback, or disables the callback (but 557=item $handle->on_rtimeout ($cb)
545not the timeout) if C<$cb> = C<undef>. See the C<timeout> constructor
546argument and method.
547 558
548=cut 559=item $handle->on_wtimeout ($cb)
549 560
550sub on_timeout { 561Replace the current C<on_timeout>, C<on_rtimeout> or C<on_wtimeout>
551 $_[0]{on_timeout} = $_[1]; 562callback, or disables the callback (but not the timeout) if C<$cb> =
552} 563C<undef>. See the C<timeout> constructor argument and method.
564
565=cut
566
567# see below
553 568
554=item $handle->autocork ($boolean) 569=item $handle->autocork ($boolean)
555 570
556Enables or disables the current autocork behaviour (see C<autocork> 571Enables or disables the current autocork behaviour (see C<autocork>
557constructor argument). Changes will only take effect on the next write. 572constructor argument). Changes will only take effect on the next write.
… …
597 612
598sub on_starttls { 613sub on_starttls {
599 $_[0]{on_stoptls} = $_[1]; 614 $_[0]{on_stoptls} = $_[1];
600} 615}
601 616
617=item $handle->rbuf_max ($max_octets)
618
619Configures the C<rbuf_max> setting (C<undef> disables it).
620
621=cut
622
623sub rbuf_max {
624 $_[0]{rbuf_max} = $_[1];
625}
626
602############################################################################# 627#############################################################################
603 628
604=item $handle->timeout ($seconds) 629=item $handle->timeout ($seconds)
605 630
631=item $handle->rtimeout ($seconds)
632
633=item $handle->wtimeout ($seconds)
634
606Configures (or disables) the inactivity timeout. 635Configures (or disables) the inactivity timeout.
607 636
608=cut 637=item $handle->timeout_reset
609 638
610sub timeout { 639=item $handle->rtimeout_reset
640
641=item $handle->wtimeout_reset
642
643Reset the activity timeout, as if data was received or sent.
644
645These methods are cheap to call.
646
647=cut
648
649for my $dir ("", "r", "w") {
650 my $timeout = "${dir}timeout";
651 my $tw = "_${dir}tw";
652 my $on_timeout = "on_${dir}timeout";
653 my $activity = "_${dir}activity";
654 my $cb;
655
656 *$on_timeout = sub {
657 $_[0]{$on_timeout} = $_[1];
658 };
659
660 *$timeout = sub {
611 my ($self, $timeout) = @_; 661 my ($self, $new_value) = @_;
612 662
613 $self->{timeout} = $timeout; 663 $self->{$timeout} = $new_value;
614 $self->_timeout; 664 delete $self->{$tw}; &$cb;
615} 665 };
616 666
667 *{"${dir}timeout_reset"} = sub {
668 $_[0]{$activity} = AE::now;
669 };
670
671 # main workhorse:
617# reset the timeout watcher, as neccessary 672 # reset the timeout watcher, as neccessary
618# also check for time-outs 673 # also check for time-outs
619sub _timeout { 674 $cb = sub {
620 my ($self) = @_; 675 my ($self) = @_;
621 676
622 if ($self->{timeout} && $self->{fh}) { 677 if ($self->{$timeout} && $self->{fh}) {
623 my $NOW = AnyEvent->now; 678 my $NOW = AE::now;
624 679
625 # when would the timeout trigger? 680 # when would the timeout trigger?
626 my $after = $self->{_activity} + $self->{timeout} - $NOW; 681 my $after = $self->{$activity} + $self->{$timeout} - $NOW;
627 682
628 # now or in the past already? 683 # now or in the past already?
629 if ($after <= 0) { 684 if ($after <= 0) {
630 $self->{_activity} = $NOW; 685 $self->{$activity} = $NOW;
631 686
632 if ($self->{on_timeout}) { 687 if ($self->{$on_timeout}) {
633 $self->{on_timeout}($self); 688 $self->{$on_timeout}($self);
634 } else { 689 } else {
635 $self->_error (Errno::ETIMEDOUT); 690 $self->_error (Errno::ETIMEDOUT);
691 }
692
693 # callback could have changed timeout value, optimise
694 return unless $self->{$timeout};
695
696 # calculate new after
697 $after = $self->{$timeout};
636 } 698 }
637 699
638 # callback could have changed timeout value, optimise 700 Scalar::Util::weaken $self;
639 return unless $self->{timeout}; 701 return unless $self; # ->error could have destroyed $self
640 702
641 # calculate new after 703 $self->{$tw} ||= AE::timer $after, 0, sub {
642 $after = $self->{timeout}; 704 delete $self->{$tw};
705 $cb->($self);
706 };
707 } else {
708 delete $self->{$tw};
643 } 709 }
644
645 Scalar::Util::weaken $self;
646 return unless $self; # ->error could have destroyed $self
647
648 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
649 delete $self->{_tw};
650 $self->_timeout;
651 });
652 } else {
653 delete $self->{_tw};
654 } 710 }
655} 711}
656 712
657############################################################################# 713#############################################################################
658 714
… …
706 my $len = syswrite $self->{fh}, $self->{wbuf}; 762 my $len = syswrite $self->{fh}, $self->{wbuf};
707 763
708 if (defined $len) { 764 if (defined $len) {
709 substr $self->{wbuf}, 0, $len, ""; 765 substr $self->{wbuf}, 0, $len, "";
710 766
711 $self->{_activity} = AnyEvent->now; 767 $self->{_activity} = $self->{_wactivity} = AE::now;
712 768
713 $self->{on_drain}($self) 769 $self->{on_drain}($self)
714 if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf}) 770 if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf})
715 && $self->{on_drain}; 771 && $self->{on_drain};
716 772
… …
722 778
723 # try to write data immediately 779 # try to write data immediately
724 $cb->() unless $self->{autocork}; 780 $cb->() unless $self->{autocork};
725 781
726 # if still data left in wbuf, we need to poll 782 # if still data left in wbuf, we need to poll
727 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 783 $self->{_ww} = AE::io $self->{fh}, 1, $cb
728 if length $self->{wbuf}; 784 if length $self->{wbuf};
729 }; 785 };
730} 786}
731 787
732our %WH; 788our %WH;
… …
822Other languages could read single lines terminated by a newline and pass 878Other languages could read single lines terminated by a newline and pass
823this line into their JSON decoder of choice. 879this line into their JSON decoder of choice.
824 880
825=cut 881=cut
826 882
883sub json_coder() {
884 eval { require JSON::XS; JSON::XS->new->utf8 }
885 || do { require JSON; JSON->new->utf8 }
886}
887
827register_write_type json => sub { 888register_write_type json => sub {
828 my ($self, $ref) = @_; 889 my ($self, $ref) = @_;
829 890
830 require JSON; 891 my $json = $self->{json} ||= json_coder;
831 892
832 $self->{json} ? $self->{json}->encode ($ref) 893 $json->encode ($ref)
833 : JSON::encode_json ($ref)
834}; 894};
835 895
836=item storable => $reference 896=item storable => $reference
837 897
838Freezes the given reference using L<Storable> and writes it to the 898Freezes the given reference using L<Storable> and writes it to the
… …
976 1036
977sub _drain_rbuf { 1037sub _drain_rbuf {
978 my ($self) = @_; 1038 my ($self) = @_;
979 1039
980 # avoid recursion 1040 # avoid recursion
981 return if exists $self->{_skip_drain_rbuf}; 1041 return if $self->{_skip_drain_rbuf};
982 local $self->{_skip_drain_rbuf} = 1; 1042 local $self->{_skip_drain_rbuf} = 1;
983
984 if (
985 defined $self->{rbuf_max}
986 && $self->{rbuf_max} < length $self->{rbuf}
987 ) {
988 $self->_error (Errno::ENOSPC, 1), return;
989 }
990 1043
991 while () { 1044 while () {
992 # we need to use a separate tls read buffer, as we must not receive data while 1045 # we need to use a separate tls read buffer, as we must not receive data while
993 # we are draining the buffer, and this can only happen with TLS. 1046 # we are draining the buffer, and this can only happen with TLS.
994 $self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf}; 1047 $self->{rbuf} .= delete $self->{_tls_rbuf}
1048 if exists $self->{_tls_rbuf};
995 1049
996 my $len = length $self->{rbuf}; 1050 my $len = length $self->{rbuf};
997 1051
998 if (my $cb = shift @{ $self->{_queue} }) { 1052 if (my $cb = shift @{ $self->{_queue} }) {
999 unless ($cb->($self)) { 1053 unless ($cb->($self)) {
1000 if ($self->{_eof}) { 1054 # no progress can be made
1001 # no progress can be made (not enough data and no data forthcoming) 1055 # (not enough data and no data forthcoming)
1002 $self->_error (Errno::EPIPE, 1), return; 1056 $self->_error (Errno::EPIPE, 1), return
1003 } 1057 if $self->{_eof};
1004 1058
1005 unshift @{ $self->{_queue} }, $cb; 1059 unshift @{ $self->{_queue} }, $cb;
1006 last; 1060 last;
1007 } 1061 }
1008 } elsif ($self->{on_read}) { 1062 } elsif ($self->{on_read}) {
… …
1028 last; 1082 last;
1029 } 1083 }
1030 } 1084 }
1031 1085
1032 if ($self->{_eof}) { 1086 if ($self->{_eof}) {
1033 if ($self->{on_eof}) { 1087 $self->{on_eof}
1034 $self->{on_eof}($self) 1088 ? $self->{on_eof}($self)
1035 } else {
1036 $self->_error (0, 1, "Unexpected end-of-file"); 1089 : $self->_error (0, 1, "Unexpected end-of-file");
1037 } 1090
1091 return;
1092 }
1093
1094 if (
1095 defined $self->{rbuf_max}
1096 && $self->{rbuf_max} < length $self->{rbuf}
1097 ) {
1098 $self->_error (Errno::ENOSPC, 1), return;
1038 } 1099 }
1039 1100
1040 # may need to restart read watcher 1101 # may need to restart read watcher
1041 unless ($self->{_rw}) { 1102 unless ($self->{_rw}) {
1042 $self->start_read 1103 $self->start_read
… …
1129 my $type = shift; 1190 my $type = shift;
1130 1191
1131 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read") 1192 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
1132 ->($self, $cb, @_); 1193 ->($self, $cb, @_);
1133 } 1194 }
1134
1135 1195
1136 unshift @{ $self->{_queue} }, $cb; 1196 unshift @{ $self->{_queue} }, $cb;
1137 $self->_drain_rbuf; 1197 $self->_drain_rbuf;
1138} 1198}
1139 1199
… …
1391=cut 1451=cut
1392 1452
1393register_read_type json => sub { 1453register_read_type json => sub {
1394 my ($self, $cb) = @_; 1454 my ($self, $cb) = @_;
1395 1455
1396 my $json = $self->{json} ||= 1456 my $json = $self->{json} ||= json_coder;
1397 eval { require JSON::XS; JSON::XS->new->utf8 }
1398 || do { require JSON; JSON->new->utf8 };
1399 1457
1400 my $data; 1458 my $data;
1401 my $rbuf = \$self->{rbuf}; 1459 my $rbuf = \$self->{rbuf};
1402 1460
1403 sub { 1461 sub {
… …
1523 my ($self) = @_; 1581 my ($self) = @_;
1524 1582
1525 unless ($self->{_rw} || $self->{_eof}) { 1583 unless ($self->{_rw} || $self->{_eof}) {
1526 Scalar::Util::weaken $self; 1584 Scalar::Util::weaken $self;
1527 1585
1528 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1586 $self->{_rw} = AE::io $self->{fh}, 0, sub {
1529 my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf}); 1587 my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf});
1530 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1588 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
1531 1589
1532 if ($len > 0) { 1590 if ($len > 0) {
1533 $self->{_activity} = AnyEvent->now; 1591 $self->{_activity} = $self->{_ractivity} = AE::now;
1534 1592
1535 if ($self->{tls}) { 1593 if ($self->{tls}) {
1536 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf); 1594 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf);
1537 1595
1538 &_dotls ($self); 1596 &_dotls ($self);
… …
1546 $self->_drain_rbuf; 1604 $self->_drain_rbuf;
1547 1605
1548 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1606 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1549 return $self->_error ($!, 1); 1607 return $self->_error ($!, 1);
1550 } 1608 }
1551 }); 1609 };
1552 } 1610 }
1553} 1611}
1554 1612
1555our $ERROR_SYSCALL; 1613our $ERROR_SYSCALL;
1556our $ERROR_WANT_READ; 1614our $ERROR_WANT_READ;
… …
1677 require Net::SSLeay; 1735 require Net::SSLeay;
1678 1736
1679 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 1737 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1680 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 1738 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1681 1739
1682 $tls = $self->{tls}; 1740 $tls = delete $self->{tls};
1683 $ctx = $self->{tls_ctx}; 1741 $ctx = $self->{tls_ctx};
1684 1742
1685 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session 1743 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1686 1744
1687 if ("HASH" eq ref $ctx) { 1745 if ("HASH" eq ref $ctx) {
… …
1716 Net::SSLeay::CTX_set_mode ($tls, 1|2); 1774 Net::SSLeay::CTX_set_mode ($tls, 1|2);
1717 1775
1718 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1776 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1719 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1777 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1720 1778
1779 Net::SSLeay::BIO_write ($self->{_rbio}, delete $self->{rbuf});
1780
1721 Net::SSLeay::set_bio ($tls, $self->{_rbio}, $self->{_wbio}); 1781 Net::SSLeay::set_bio ($tls, $self->{_rbio}, $self->{_wbio});
1722 1782
1723 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) } 1783 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }
1724 if $self->{on_starttls}; 1784 if $self->{on_starttls};
1725 1785
… …
1754 my ($self) = @_; 1814 my ($self) = @_;
1755 1815
1756 return unless $self->{tls}; 1816 return unless $self->{tls};
1757 1817
1758 $self->{tls_ctx}->_put_session (delete $self->{tls}) 1818 $self->{tls_ctx}->_put_session (delete $self->{tls})
1759 if ref $self->{tls}; 1819 if $self->{tls} > 0;
1760 1820
1761 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)}; 1821 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
1762} 1822}
1763 1823
1764sub DESTROY { 1824sub DESTROY {
… …
1772 my $fh = delete $self->{fh}; 1832 my $fh = delete $self->{fh};
1773 my $wbuf = delete $self->{wbuf}; 1833 my $wbuf = delete $self->{wbuf};
1774 1834
1775 my @linger; 1835 my @linger;
1776 1836
1777 push @linger, AnyEvent->io (fh => $fh, poll => "w", cb => sub { 1837 push @linger, AE::io $fh, 1, sub {
1778 my $len = syswrite $fh, $wbuf, length $wbuf; 1838 my $len = syswrite $fh, $wbuf, length $wbuf;
1779 1839
1780 if ($len > 0) { 1840 if ($len > 0) {
1781 substr $wbuf, 0, $len, ""; 1841 substr $wbuf, 0, $len, "";
1782 } else { 1842 } else {
1783 @linger = (); # end 1843 @linger = (); # end
1784 } 1844 }
1785 }); 1845 };
1786 push @linger, AnyEvent->timer (after => $linger, cb => sub { 1846 push @linger, AE::timer $linger, 0, sub {
1787 @linger = (); 1847 @linger = ();
1788 }); 1848 };
1789 } 1849 }
1790} 1850}
1791 1851
1792=item $handle->destroy 1852=item $handle->destroy
1793 1853
1794Shuts down the handle object as much as possible - this call ensures that 1854Shuts down the handle object as much as possible - this call ensures that
1795no further callbacks will be invoked and as many resources as possible 1855no further callbacks will be invoked and as many resources as possible
1796will be freed. You must not call any methods on the object afterwards. 1856will be freed. Any method you will call on the handle object after
1857destroying it in this way will be silently ignored (and it will return the
1858empty list).
1797 1859
1798Normally, you can just "forget" any references to an AnyEvent::Handle 1860Normally, you can just "forget" any references to an AnyEvent::Handle
1799object and it will simply shut down. This works in fatal error and EOF 1861object and it will simply shut down. This works in fatal error and EOF
1800callbacks, as well as code outside. It does I<NOT> work in a read or write 1862callbacks, as well as code outside. It does I<NOT> work in a read or write
1801callback, so when you want to destroy the AnyEvent::Handle object from 1863callback, so when you want to destroy the AnyEvent::Handle object from
… …
1815sub destroy { 1877sub destroy {
1816 my ($self) = @_; 1878 my ($self) = @_;
1817 1879
1818 $self->DESTROY; 1880 $self->DESTROY;
1819 %$self = (); 1881 %$self = ();
1882 bless $self, "AnyEvent::Handle::destroyed";
1883}
1884
1885sub AnyEvent::Handle::destroyed::AUTOLOAD {
1886 #nop
1820} 1887}
1821 1888
1822=item AnyEvent::Handle::TLS_CTX 1889=item AnyEvent::Handle::TLS_CTX
1823 1890
1824This function creates and returns the AnyEvent::TLS object used by default 1891This function creates and returns the AnyEvent::TLS object used by default

Diff Legend

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