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.29 by root, Sat May 24 23:10:18 2008 UTC vs.
Revision 1.35 by root, Mon May 26 05:46:35 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
168 169
169=back 170=back
170 171
171=cut 172=cut
172 173
173our (%RH, %WH);
174
175sub register_read_type($$) {
176 $RH{$_[0]} = $_[1];
177}
178
179sub register_write_type($$) {
180 $WH{$_[0]} = $_[1];
181}
182
183sub new { 174sub new {
184 my $class = shift; 175 my $class = shift;
185 176
186 my $self = bless { @_ }, $class; 177 my $self = bless { @_ }, $class;
187 178
298 289
299sub _drain_wbuf { 290sub _drain_wbuf {
300 my ($self) = @_; 291 my ($self) = @_;
301 292
302 if (!$self->{ww} && length $self->{wbuf}) { 293 if (!$self->{ww} && length $self->{wbuf}) {
294
303 Scalar::Util::weaken $self; 295 Scalar::Util::weaken $self;
296
304 my $cb = sub { 297 my $cb = sub {
305 my $len = syswrite $self->{fh}, $self->{wbuf}; 298 my $len = syswrite $self->{fh}, $self->{wbuf};
306 299
307 if ($len >= 0) { 300 if ($len >= 0) {
308 substr $self->{wbuf}, 0, $len, ""; 301 substr $self->{wbuf}, 0, $len, "";
310 $self->{on_drain}($self) 303 $self->{on_drain}($self)
311 if $self->{low_water_mark} >= length $self->{wbuf} 304 if $self->{low_water_mark} >= length $self->{wbuf}
312 && $self->{on_drain}; 305 && $self->{on_drain};
313 306
314 delete $self->{ww} unless length $self->{wbuf}; 307 delete $self->{ww} unless length $self->{wbuf};
315 } elsif ($! != EAGAIN && $! != EINTR) { 308 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) {
316 $self->error; 309 $self->error;
317 } 310 }
318 }; 311 };
319 312
313 # try to write data immediately
314 $cb->();
315
316 # if still data left in wbuf, we need to poll
320 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 317 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
321 318 if length $self->{wbuf};
322 $cb->($self);
323 }; 319 };
320}
321
322our %WH;
323
324sub register_write_type($$) {
325 $WH{$_[0]} = $_[1];
324} 326}
325 327
326sub push_write { 328sub push_write {
327 my $self = shift; 329 my $self = shift;
328 330
346=item $handle->unshift_write (type => @args) 348=item $handle->unshift_write (type => @args)
347 349
348Instead of formatting your data yourself, you can also let this module do 350Instead of formatting your data yourself, you can also let this module do
349the job by specifying a type and type-specific arguments. 351the job by specifying a type and type-specific arguments.
350 352
351Predefined types are: 353Predefined types are (if you have ideas for additional types, feel free to
354drop by and tell us):
352 355
353=over 4 356=over 4
354 357
355=item netstring => $string 358=item netstring => $string
356 359
357Formats the given value as netstring 360Formats the given value as netstring
358(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them). 361(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
359 362
363=back
364
360=cut 365=cut
361 366
362register_write_type netstring => sub { 367register_write_type netstring => sub {
363 my ($self, $string) = @_; 368 my ($self, $string) = @_;
364 369
365 sprintf "%d:%s,", (length $string), $string 370 sprintf "%d:%s,", (length $string), $string
366}; 371};
367 372
368=back 373=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args)
369 374
370=cut 375This function (not method) lets you add your own types to C<push_write>.
376Whenever the given C<type> is used, C<push_write> will invoke the code
377reference with the handle object and the remaining arguments.
371 378
379The code reference is supposed to return a single octet string that will
380be appended to the write buffer.
372 381
382Note that this is a function, and all types registered this way will be
383global, so try to use unique names.
384
385=cut
373 386
374############################################################################# 387#############################################################################
375 388
376=back 389=back
377 390
552interested in (which can be none at all) and return a true value. After returning 565interested in (which can be none at all) and return a true value. After returning
553true, it will be removed from the queue. 566true, it will be removed from the queue.
554 567
555=cut 568=cut
556 569
570our %RH;
571
572sub register_read_type($$) {
573 $RH{$_[0]} = $_[1];
574}
575
557sub push_read { 576sub push_read {
558 my $self = shift; 577 my $self = shift;
559 my $cb = pop; 578 my $cb = pop;
560 579
561 if (@_) { 580 if (@_) {
591 610
592Instead of providing a callback that parses the data itself you can chose 611Instead of providing a callback that parses the data itself you can chose
593between a number of predefined parsing formats, for chunks of data, lines 612between a number of predefined parsing formats, for chunks of data, lines
594etc. 613etc.
595 614
596The types currently supported are: 615Predefined types are (if you have ideas for additional types, feel free to
616drop by and tell us):
597 617
598=over 4 618=over 4
599 619
600=item chunk => $octets, $cb->($self, $data) 620=item chunk => $octets, $cb->($self, $data)
601 621
715 } 735 }
716}; 736};
717 737
718=back 738=back
719 739
740=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args)
741
742This function (not method) lets you add your own types to C<push_read>.
743
744Whenever the given C<type> is used, C<push_read> will invoke the code
745reference with the handle object, the callback and the remaining
746arguments.
747
748The code reference is supposed to return a callback (usually a closure)
749that works as a plain read callback (see C<< ->push_read ($cb) >>).
750
751It should invoke the passed callback when it is done reading (remember to
752pass C<$self> as first argument as all other callbacks do that).
753
754Note that this is a function, and all types registered this way will be
755global, so try to use unique names.
756
757For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
758search for C<register_read_type>)).
759
720=item $handle->stop_read 760=item $handle->stop_read
721 761
722=item $handle->start_read 762=item $handle->start_read
723 763
724In rare cases you actually do not want to read anything from the 764In rare cases you actually do not want to read anything from the
752 } elsif (defined $len) { 792 } elsif (defined $len) {
753 delete $self->{rw}; 793 delete $self->{rw};
754 $self->{eof} = 1; 794 $self->{eof} = 1;
755 $self->_drain_rbuf; 795 $self->_drain_rbuf;
756 796
757 } elsif ($! != EAGAIN && $! != EINTR) { 797 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) {
758 return $self->error; 798 return $self->error;
759 } 799 }
760 }); 800 });
761 } 801 }
762} 802}
828 # but the openssl maintainers basically said: "trust us, it just works". 868 # but the openssl maintainers basically said: "trust us, it just works".
829 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 869 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
830 # and mismaintained ssleay-module doesn't even offer them). 870 # and mismaintained ssleay-module doesn't even offer them).
831 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 871 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
832 Net::SSLeay::CTX_set_mode ($self->{tls}, 872 Net::SSLeay::CTX_set_mode ($self->{tls},
833 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 873 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
834 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 874 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
835 875
836 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 876 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
837 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 877 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
838 878
839 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio}); 879 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio});

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines