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.28 by root, Sat May 24 22:27:11 2008 UTC vs.
Revision 1.39 by root, Tue May 27 04:59:51 2008 UTC

… …
2 2
3no warnings; 3no warnings;
4use strict; 4use strict;
5 5
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util (); 7use AnyEvent::Util qw(WSAWOULDBLOCK);
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
17This module is experimental.
18
19=cut 17=cut
20 18
21our $VERSION = '0.04'; 19our $VERSION = '0.04';
22 20
23=head1 SYNOPSIS 21=head1 SYNOPSIS
… …
25 use AnyEvent; 23 use AnyEvent;
26 use AnyEvent::Handle; 24 use AnyEvent::Handle;
27 25
28 my $cv = AnyEvent->condvar; 26 my $cv = AnyEvent->condvar;
29 27
30 my $ae_fh = AnyEvent::Handle->new (fh => \*STDIN); 28 my $handle =
31
32 #TODO
33
34 # or use the constructor to pass the callback:
35
36 my $ae_fh2 =
37 AnyEvent::Handle->new ( 29 AnyEvent::Handle->new (
38 fh => \*STDIN, 30 fh => \*STDIN,
39 on_eof => sub { 31 on_eof => sub {
40 $cv->broadcast; 32 $cv->broadcast;
41 }, 33 },
42 #TODO
43 ); 34 );
44 35
45 $cv->wait; 36 # send some request line
37 $handle->push_write ("getinfo\015\012");
38
39 # read the response line
40 $handle->push_read (line => sub {
41 my ($handle, $line) = @_;
42 warn "read line <$line>\n";
43 $cv->send;
44 });
45
46 $cv->recv;
46 47
47=head1 DESCRIPTION 48=head1 DESCRIPTION
48 49
49This module is a helper module to make it easier to do event-based I/O on 50This 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 51filehandles. For utility functions for doing non-blocking connects and accepts
… …
90 91
91The object will not be in a usable state when this callback has been 92The object will not be in a usable state when this callback has been
92called. 93called.
93 94
94On callback entrance, the value of C<$!> contains the operating system 95On callback entrance, the value of C<$!> contains the operating system
95error (or C<ENOSPC> or C<EPIPE>). 96error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>).
97
98The callback should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you.
96 100
97While not mandatory, it is I<highly> recommended to set this callback, as 101While not mandatory, it is I<highly> recommended to set this callback, as
98you will not be notified of errors otherwise. The default simply calls 102you will not be notified of errors otherwise. The default simply calls
99die. 103die.
100 104
… …
164 168
165Use the given Net::SSLeay::CTX object to create the new TLS connection 169Use the given Net::SSLeay::CTX object to create the new TLS connection
166(unless a connection object was specified directly). If this parameter is 170(unless a connection object was specified directly). If this parameter is
167missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 171missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
168 172
173=item filter_r => $cb
174
175=item filter_w => $cb
176
177These exist, but are undocumented at this time.
178
169=back 179=back
170 180
171=cut 181=cut
172
173our (%RH, %WH);
174
175sub register_read_type($$) {
176 $RH{$_[0]} = $_[1];
177}
178
179sub register_write_type($$) {
180 $WH{$_[0]} = $_[1];
181}
182 182
183sub new { 183sub new {
184 my $class = shift; 184 my $class = shift;
185 185
186 my $self = bless { @_ }, $class; 186 my $self = bless { @_ }, $class;
… …
205} 205}
206 206
207sub _shutdown { 207sub _shutdown {
208 my ($self) = @_; 208 my ($self) = @_;
209 209
210 delete $self->{rw}; 210 delete $self->{_rw};
211 delete $self->{ww}; 211 delete $self->{_ww};
212 delete $self->{fh}; 212 delete $self->{fh};
213} 213}
214 214
215sub error { 215sub error {
216 my ($self) = @_; 216 my ($self) = @_;
… …
218 { 218 {
219 local $!; 219 local $!;
220 $self->_shutdown; 220 $self->_shutdown;
221 } 221 }
222 222
223 if ($self->{on_error}) {
224 $self->{on_error}($self); 223 $self->{on_error}($self)
225 } else { 224 if $self->{on_error};
225
226 die "AnyEvent::Handle uncaught fatal error: $!"; 226 Carp::croak "AnyEvent::Handle uncaught fatal error: $!";
227 }
228} 227}
229 228
230=item $fh = $handle->fh 229=item $fh = $handle->fh
231 230
232This method returns the file handle of the L<AnyEvent::Handle> object. 231This method returns the file handle of the L<AnyEvent::Handle> object.
233 232
234=cut 233=cut
235 234
236sub fh { $_[0]->{fh} } 235sub fh { $_[0]{fh} }
237 236
238=item $handle->on_error ($cb) 237=item $handle->on_error ($cb)
239 238
240Replace the current C<on_error> callback (see the C<on_error> constructor argument). 239Replace the current C<on_error> callback (see the C<on_error> constructor argument).
241 240
… …
297=cut 296=cut
298 297
299sub _drain_wbuf { 298sub _drain_wbuf {
300 my ($self) = @_; 299 my ($self) = @_;
301 300
302 unless ($self->{ww}) { 301 if (!$self->{_ww} && length $self->{wbuf}) {
302
303 Scalar::Util::weaken $self; 303 Scalar::Util::weaken $self;
304
304 my $cb = sub { 305 my $cb = sub {
305 my $len = syswrite $self->{fh}, $self->{wbuf}; 306 my $len = syswrite $self->{fh}, $self->{wbuf};
306 307
307 if ($len > 0) { 308 if ($len >= 0) {
308 substr $self->{wbuf}, 0, $len, ""; 309 substr $self->{wbuf}, 0, $len, "";
309 310
310 $self->{on_drain}($self) 311 $self->{on_drain}($self)
311 if $self->{low_water_mark} >= length $self->{wbuf} 312 if $self->{low_water_mark} >= length $self->{wbuf}
312 && $self->{on_drain}; 313 && $self->{on_drain};
313 314
314 delete $self->{ww} unless length $self->{wbuf}; 315 delete $self->{_ww} unless length $self->{wbuf};
315 } elsif ($! != EAGAIN && $! != EINTR) { 316 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) {
316 $self->error; 317 $self->error;
317 } 318 }
318 }; 319 };
319 320
321 # try to write data immediately
322 $cb->();
323
324 # if still data left in wbuf, we need to poll
320 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 325 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
321 326 if length $self->{wbuf};
322 $cb->($self);
323 }; 327 };
328}
329
330our %WH;
331
332sub register_write_type($$) {
333 $WH{$_[0]} = $_[1];
324} 334}
325 335
326sub push_write { 336sub push_write {
327 my $self = shift; 337 my $self = shift;
338
339 if (@_ > 1) {
340 my $type = shift;
341
342 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
343 ->($self, @_);
344 }
328 345
329 if ($self->{filter_w}) { 346 if ($self->{filter_w}) {
330 $self->{filter_w}->($self, \$_[0]); 347 $self->{filter_w}->($self, \$_[0]);
331 } else { 348 } else {
332 $self->{wbuf} .= $_[0]; 349 $self->{wbuf} .= $_[0];
333 $self->_drain_wbuf; 350 $self->_drain_wbuf;
334 } 351 }
335} 352}
353
354=item $handle->push_write (type => @args)
355
356=item $handle->unshift_write (type => @args)
357
358Instead of formatting your data yourself, you can also let this module do
359the job by specifying a type and type-specific arguments.
360
361Predefined types are (if you have ideas for additional types, feel free to
362drop by and tell us):
363
364=over 4
365
366=item netstring => $string
367
368Formats the given value as netstring
369(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
370
371=back
372
373=cut
374
375register_write_type netstring => sub {
376 my ($self, $string) = @_;
377
378 sprintf "%d:%s,", (length $string), $string
379};
380
381=item json => $array_or_hashref
382
383=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args)
384
385This function (not method) lets you add your own types to C<push_write>.
386Whenever the given C<type> is used, C<push_write> will invoke the code
387reference with the handle object and the remaining arguments.
388
389The code reference is supposed to return a single octet string that will
390be appended to the write buffer.
391
392Note that this is a function, and all types registered this way will be
393global, so try to use unique names.
394
395=cut
336 396
337############################################################################# 397#############################################################################
338 398
339=back 399=back
340 400
… …
419 479
420 if ( 480 if (
421 defined $self->{rbuf_max} 481 defined $self->{rbuf_max}
422 && $self->{rbuf_max} < length $self->{rbuf} 482 && $self->{rbuf_max} < length $self->{rbuf}
423 ) { 483 ) {
424 $! = &Errno::ENOSPC; return $self->error; 484 $! = &Errno::ENOSPC;
485 $self->error;
425 } 486 }
426 487
427 return if $self->{in_drain}; 488 return if $self->{in_drain};
428 local $self->{in_drain} = 1; 489 local $self->{in_drain} = 1;
429 490
430 while (my $len = length $self->{rbuf}) { 491 while (my $len = length $self->{rbuf}) {
431 no strict 'refs'; 492 no strict 'refs';
432 if (my $cb = shift @{ $self->{queue} }) { 493 if (my $cb = shift @{ $self->{_queue} }) {
433 if (!$cb->($self)) { 494 unless ($cb->($self)) {
434 if ($self->{eof}) { 495 if ($self->{_eof}) {
435 # no progress can be made (not enough data and no data forthcoming) 496 # no progress can be made (not enough data and no data forthcoming)
436 $! = &Errno::EPIPE; return $self->error; 497 $! = &Errno::EPIPE;
498 $self->error;
437 } 499 }
438 500
439 unshift @{ $self->{queue} }, $cb; 501 unshift @{ $self->{_queue} }, $cb;
440 return; 502 return;
441 } 503 }
442 } elsif ($self->{on_read}) { 504 } elsif ($self->{on_read}) {
443 $self->{on_read}($self); 505 $self->{on_read}($self);
444 506
445 if ( 507 if (
446 $self->{eof} # if no further data will arrive 508 $self->{_eof} # if no further data will arrive
447 && $len == length $self->{rbuf} # and no data has been consumed 509 && $len == length $self->{rbuf} # and no data has been consumed
448 && !@{ $self->{queue} } # and the queue is still empty 510 && !@{ $self->{_queue} } # and the queue is still empty
449 && $self->{on_read} # and we still want to read data 511 && $self->{on_read} # and we still want to read data
450 ) { 512 ) {
451 # then no progress can be made 513 # then no progress can be made
452 $! = &Errno::EPIPE; return $self->error; 514 $! = &Errno::EPIPE;
515 $self->error;
453 } 516 }
454 } else { 517 } else {
455 # read side becomes idle 518 # read side becomes idle
456 delete $self->{rw}; 519 delete $self->{_rw};
457 return; 520 return;
458 } 521 }
459 } 522 }
460 523
461 if ($self->{eof}) { 524 if ($self->{_eof}) {
462 $self->_shutdown; 525 $self->_shutdown;
463 $self->{on_eof}($self) 526 $self->{on_eof}($self)
464 if $self->{on_eof}; 527 if $self->{on_eof};
465 } 528 }
466} 529}
… …
515interested in (which can be none at all) and return a true value. After returning 578interested in (which can be none at all) and return a true value. After returning
516true, it will be removed from the queue. 579true, it will be removed from the queue.
517 580
518=cut 581=cut
519 582
583our %RH;
584
585sub register_read_type($$) {
586 $RH{$_[0]} = $_[1];
587}
588
520sub push_read { 589sub push_read {
521 my $self = shift; 590 my $self = shift;
522 my $cb = pop; 591 my $cb = pop;
523 592
524 if (@_) { 593 if (@_) {
… …
526 595
527 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 596 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
528 ->($self, $cb, @_); 597 ->($self, $cb, @_);
529 } 598 }
530 599
531 push @{ $self->{queue} }, $cb; 600 push @{ $self->{_queue} }, $cb;
532 $self->_drain_rbuf; 601 $self->_drain_rbuf;
533} 602}
534 603
535sub unshift_read { 604sub unshift_read {
536 my $self = shift; 605 my $self = shift;
… …
542 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read") 611 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
543 ->($self, $cb, @_); 612 ->($self, $cb, @_);
544 } 613 }
545 614
546 615
547 unshift @{ $self->{queue} }, $cb; 616 unshift @{ $self->{_queue} }, $cb;
548 $self->_drain_rbuf; 617 $self->_drain_rbuf;
549} 618}
550 619
551=item $handle->push_read (type => @args, $cb) 620=item $handle->push_read (type => @args, $cb)
552 621
… …
554 623
555Instead of providing a callback that parses the data itself you can chose 624Instead of providing a callback that parses the data itself you can chose
556between a number of predefined parsing formats, for chunks of data, lines 625between a number of predefined parsing formats, for chunks of data, lines
557etc. 626etc.
558 627
559The types currently supported are: 628Predefined types are (if you have ideas for additional types, feel free to
629drop by and tell us):
560 630
561=over 4 631=over 4
562 632
563=item chunk => $octets, $cb->($self, $data) 633=item chunk => $octets, $cb->($self, $data)
564 634
… …
638sub unshift_read_line { 708sub unshift_read_line {
639 my $self = shift; 709 my $self = shift;
640 $self->unshift_read (line => @_); 710 $self->unshift_read (line => @_);
641} 711}
642 712
713=item netstring => $cb->($string)
714
715A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
716
717Throws an error with C<$!> set to EBADMSG on format violations.
718
719=cut
720
721register_read_type netstring => sub {
722 my ($self, $cb) = @_;
723
724 sub {
725 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
726 if ($_[0]{rbuf} =~ /[^0-9]/) {
727 $! = &Errno::EBADMSG;
728 $self->error;
729 }
730 return;
731 }
732
733 my $len = $1;
734
735 $self->unshift_read (chunk => $len, sub {
736 my $string = $_[1];
737 $_[0]->unshift_read (chunk => 1, sub {
738 if ($_[1] eq ",") {
739 $cb->($_[0], $string);
740 } else {
741 $! = &Errno::EBADMSG;
742 $self->error;
743 }
744 });
745 });
746
747 1
748 }
749};
750
751=item regex => $accept[, $reject[, $skip], $cb->($data)
752
753Makes a regex match against the regex object C<$accept> and returns
754everything up to and including the match.
755
756Example: read a single line terminated by '\n'.
757
758 $handle->push_read (regex => qr<\n>, sub { ... });
759
760If C<$reject> is given and not undef, then it determines when the data is
761to be rejected: it is matched against the data when the C<$accept> regex
762does not match and generates an C<EBADMSG> error when it matches. This is
763useful to quickly reject wrong data (to avoid waiting for a timeout or a
764receive buffer overflow).
765
766Example: expect a single decimal number followed by whitespace, reject
767anything else (not the use of an anchor).
768
769 $handle->push_read (regex => qr<^[0-9]+\s>, qr<[^0-9]>, sub { ... });
770
771If C<$skip> is given and not C<undef>, then it will be matched against
772the receive buffer when neither C<$accept> nor C<$reject> match,
773and everything preceding and including the match will be accepted
774unconditionally. This is useful to skip large amounts of data that you
775know cannot be matched, so that the C<$accept> or C<$reject> regex do not
776have to start matching from the beginning. This is purely an optimisation
777and is usually worth only when you expect more than a few kilobytes.
778
779Example: expect a http header, which ends at C<\015\012\015\012>. Since we
780expect the header to be very large (it isn't in practise, but...), we use
781a skip regex to skip initial portions. The skip regex is tricky in that
782it only accepts something not ending in either \015 or \012, as these are
783required for the accept regex.
784
785 $handle->push_read (regex =>
786 qr<\015\012\015\012>,
787 undef, # no reject
788 qr<^.*[^\015\012]>,
789 sub { ... });
790
791=cut
792
793register_read_type regex => sub {
794 my ($self, $cb, $accept, $reject, $skip) = @_;
795
796 my $data;
797 my $rbuf = \$self->{rbuf};
798
799 sub {
800 # accept
801 if ($$rbuf =~ $accept) {
802 $data .= substr $$rbuf, 0, $+[0], "";
803 $cb->($self, $data);
804 return 1;
805 }
806
807 # reject
808 if ($reject && $$rbuf =~ $reject) {
809 $! = &Errno::EBADMSG;
810 $self->error;
811 }
812
813 # skip
814 if ($skip && $$rbuf =~ $skip) {
815 $data .= substr $$rbuf, 0, $+[0], "";
816 }
817
818 ()
819 }
820};
821
643=back 822=back
823
824=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args)
825
826This function (not method) lets you add your own types to C<push_read>.
827
828Whenever the given C<type> is used, C<push_read> will invoke the code
829reference with the handle object, the callback and the remaining
830arguments.
831
832The code reference is supposed to return a callback (usually a closure)
833that works as a plain read callback (see C<< ->push_read ($cb) >>).
834
835It should invoke the passed callback when it is done reading (remember to
836pass C<$self> as first argument as all other callbacks do that).
837
838Note that this is a function, and all types registered this way will be
839global, so try to use unique names.
840
841For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
842search for C<register_read_type>)).
644 843
645=item $handle->stop_read 844=item $handle->stop_read
646 845
647=item $handle->start_read 846=item $handle->start_read
648 847
… …
654=cut 853=cut
655 854
656sub stop_read { 855sub stop_read {
657 my ($self) = @_; 856 my ($self) = @_;
658 857
659 delete $self->{rw}; 858 delete $self->{_rw};
660} 859}
661 860
662sub start_read { 861sub start_read {
663 my ($self) = @_; 862 my ($self) = @_;
664 863
665 unless ($self->{rw} || $self->{eof}) { 864 unless ($self->{_rw} || $self->{_eof}) {
666 Scalar::Util::weaken $self; 865 Scalar::Util::weaken $self;
667 866
668 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 867 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
669 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 868 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
670 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 869 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
671 870
672 if ($len > 0) { 871 if ($len > 0) {
673 $self->{filter_r} 872 $self->{filter_r}
674 ? $self->{filter_r}->($self, $rbuf) 873 ? $self->{filter_r}->($self, $rbuf)
675 : $self->_drain_rbuf; 874 : $self->_drain_rbuf;
676 875
677 } elsif (defined $len) { 876 } elsif (defined $len) {
678 delete $self->{rw}; 877 delete $self->{_rw};
679 $self->{eof} = 1; 878 $self->{_eof} = 1;
680 $self->_drain_rbuf; 879 $self->_drain_rbuf;
681 880
682 } elsif ($! != EAGAIN && $! != EINTR) { 881 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) {
683 return $self->error; 882 return $self->error;
684 } 883 }
685 }); 884 });
686 } 885 }
687} 886}
688 887
689sub _dotls { 888sub _dotls {
690 my ($self) = @_; 889 my ($self) = @_;
691 890
692 if (length $self->{tls_wbuf}) { 891 if (length $self->{_tls_wbuf}) {
693 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) { 892 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
694 substr $self->{tls_wbuf}, 0, $len, ""; 893 substr $self->{_tls_wbuf}, 0, $len, "";
695 } 894 }
696 } 895 }
697 896
698 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) { 897 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
699 $self->{wbuf} .= $buf; 898 $self->{wbuf} .= $buf;
700 $self->_drain_wbuf; 899 $self->_drain_wbuf;
701 } 900 }
702 901
703 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 902 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
… …
729C<"connect">, C<"accept"> or an existing Net::SSLeay object). 928C<"connect">, C<"accept"> or an existing Net::SSLeay object).
730 929
731The second argument is the optional C<Net::SSLeay::CTX> object that is 930The second argument is the optional C<Net::SSLeay::CTX> object that is
732used when AnyEvent::Handle has to create its own TLS connection object. 931used when AnyEvent::Handle has to create its own TLS connection object.
733 932
933The TLS connection object will end up in C<< $handle->{tls} >> after this
934call and can be used or changed to your liking. Note that the handshake
935might have already started when this function returns.
936
734=cut 937=cut
735 938
736# TODO: maybe document... 939# TODO: maybe document...
737sub starttls { 940sub starttls {
738 my ($self, $ssl, $ctx) = @_; 941 my ($self, $ssl, $ctx) = @_;
… …
753 # but the openssl maintainers basically said: "trust us, it just works". 956 # but the openssl maintainers basically said: "trust us, it just works".
754 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 957 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
755 # and mismaintained ssleay-module doesn't even offer them). 958 # and mismaintained ssleay-module doesn't even offer them).
756 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 959 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
757 Net::SSLeay::CTX_set_mode ($self->{tls}, 960 Net::SSLeay::CTX_set_mode ($self->{tls},
758 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 961 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
759 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 962 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
760 963
761 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 964 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
762 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 965 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
763 966
764 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio}); 967 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
765 968
766 $self->{filter_w} = sub { 969 $self->{filter_w} = sub {
767 $_[0]{tls_wbuf} .= ${$_[1]}; 970 $_[0]{_tls_wbuf} .= ${$_[1]};
768 &_dotls; 971 &_dotls;
769 }; 972 };
770 $self->{filter_r} = sub { 973 $self->{filter_r} = sub {
771 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]}); 974 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
772 &_dotls; 975 &_dotls;
773 }; 976 };
774} 977}
775 978
776=item $handle->stoptls 979=item $handle->stoptls
… …
782 985
783sub stoptls { 986sub stoptls {
784 my ($self) = @_; 987 my ($self) = @_;
785 988
786 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 989 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
990
787 delete $self->{tls_rbio}; 991 delete $self->{_rbio};
788 delete $self->{tls_wbio}; 992 delete $self->{_wbio};
789 delete $self->{tls_wbuf}; 993 delete $self->{_tls_wbuf};
790 delete $self->{filter_r}; 994 delete $self->{filter_r};
791 delete $self->{filter_w}; 995 delete $self->{filter_w};
792} 996}
793 997
794sub DESTROY { 998sub DESTROY {
… …
832 } 1036 }
833} 1037}
834 1038
835=back 1039=back
836 1040
1041=head1 SUBCLASSING AnyEvent::Handle
1042
1043In many cases, you might want to subclass AnyEvent::Handle.
1044
1045To make this easier, a given version of AnyEvent::Handle uses these
1046conventions:
1047
1048=over 4
1049
1050=item * all constructor arguments become object members.
1051
1052At least initially, when you pass a C<tls>-argument to the constructor it
1053will end up in C<< $handle->{tls} >>. Those members might be changes or
1054mutated later on (for example C<tls> will hold the TLS connection object).
1055
1056=item * other object member names are prefixed with an C<_>.
1057
1058All object members not explicitly documented (internal use) are prefixed
1059with an underscore character, so the remaining non-C<_>-namespace is free
1060for use for subclasses.
1061
1062=item * all members not documented here and not prefixed with an underscore
1063are free to use in subclasses.
1064
1065Of course, new versions of AnyEvent::Handle may introduce more "public"
1066member variables, but thats just life, at least it is documented.
1067
1068=back
1069
837=head1 AUTHOR 1070=head1 AUTHOR
838 1071
839Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 1072Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
840 1073
841=cut 1074=cut

Diff Legend

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