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.149 by root, Thu Jul 16 03:48:33 2009 UTC vs.
Revision 1.156 by root, Wed Jul 22 05:37:32 2009 UTC

1package AnyEvent::Handle; 1package AnyEvent::Handle;
2 2
3no warnings;
4use strict qw(subs vars);
5
6use AnyEvent ();
7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 3use Scalar::Util ();
9use Carp (); 4use Carp ();
10use Fcntl ();
11use Errno qw(EAGAIN EINTR); 5use Errno qw(EAGAIN EINTR);
12 6
7use AnyEvent (); BEGIN { AnyEvent::common_sense }
8use AnyEvent::Util qw(WSAEWOULDBLOCK);
9
13=head1 NAME 10=head1 NAME
14 11
15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 12AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 13
17=cut 14=cut
18 15
19our $VERSION = 4.82; 16our $VERSION = 4.86;
20 17
21=head1 SYNOPSIS 18=head1 SYNOPSIS
22 19
23 use AnyEvent; 20 use AnyEvent;
24 use AnyEvent::Handle; 21 use AnyEvent::Handle;
26 my $cv = AnyEvent->condvar; 23 my $cv = AnyEvent->condvar;
27 24
28 my $hdl; $hdl = new AnyEvent::Handle 25 my $hdl; $hdl = new AnyEvent::Handle
29 fh => \*STDIN, 26 fh => \*STDIN,
30 on_error => sub { 27 on_error => sub {
28 my ($hdl, $fatal, $msg) = @_;
31 warn "got error $_[2]\n"; 29 warn "got error $msg\n";
30 $hdl->destroy;
32 $cv->send; 31 $cv->send;
33 ); 32 );
34 33
35 # send some request line 34 # send some request line
36 $hdl->push_write ("getinfo\015\012"); 35 $hdl->push_write ("getinfo\015\012");
80 79
81=item on_eof => $cb->($handle) 80=item on_eof => $cb->($handle)
82 81
83Set the callback to be called when an end-of-file condition is detected, 82Set the callback to be called when an end-of-file condition is detected,
84i.e. in the case of a socket, when the other side has closed the 83i.e. in the case of a socket, when the other side has closed the
85connection cleanly. 84connection cleanly, and there are no outstanding read requests in the
85queue (if there are read requests, then an EOF counts as an unexpected
86connection close and will be flagged as an error).
86 87
87For sockets, this just means that the other side has stopped sending data, 88For sockets, this just means that the other side has stopped sending data,
88you can still try to write data, and, in fact, one can return from the EOF 89you can still try to write data, and, in fact, one can return from the EOF
89callback and continue writing data, as only the read part has been shut 90callback and continue writing data, as only the read part has been shut
90down. 91down.
91
92While not mandatory, it is I<highly> recommended to set an EOF callback,
93otherwise you might end up with a closed socket while you are still
94waiting for data.
95 92
96If an EOF condition has been detected but no C<on_eof> callback has been 93If an EOF condition has been detected but no C<on_eof> callback has been
97set, then a fatal error will be raised with C<$!> set to <0>. 94set, then a fatal error will be raised with C<$!> set to <0>.
98 95
99=item on_error => $cb->($handle, $fatal, $message) 96=item on_error => $cb->($handle, $fatal, $message)
140 137
141When an EOF condition is detected then AnyEvent::Handle will first try to 138When an EOF condition is detected then AnyEvent::Handle will first try to
142feed all the remaining data to the queued callbacks and C<on_read> before 139feed all the remaining data to the queued callbacks and C<on_read> before
143calling the C<on_eof> callback. If no progress can be made, then a fatal 140calling the C<on_eof> callback. If no progress can be made, then a fatal
144error will be raised (with C<$!> set to C<EPIPE>). 141error will be raised (with C<$!> set to C<EPIPE>).
142
143Note that, unlike requests in the read queue, an C<on_read> callback
144doesn't mean you I<require> some data: if there is an EOF and there
145are outstanding read requests then an error will be flagged. With an
146C<on_read> callback, the C<on_eof> callback will be invoked.
145 147
146=item on_drain => $cb->($handle) 148=item on_drain => $cb->($handle)
147 149
148This sets the callback that is called when the write buffer becomes empty 150This sets the callback that is called when the write buffer becomes empty
149(or when the callback is set and the buffer is empty already). 151(or when the callback is set and the buffer is empty already).
385 $! = $errno; 387 $! = $errno;
386 $message ||= "$!"; 388 $message ||= "$!";
387 389
388 if ($self->{on_error}) { 390 if ($self->{on_error}) {
389 $self->{on_error}($self, $fatal, $message); 391 $self->{on_error}($self, $fatal, $message);
390 $self->destroy; 392 $self->destroy if $fatal;
391 } elsif ($self->{fh}) { 393 } elsif ($self->{fh}) {
392 $self->destroy; 394 $self->destroy;
393 Carp::croak "AnyEvent::Handle uncaught error: $message"; 395 Carp::croak "AnyEvent::Handle uncaught error: $message";
394 } 396 }
395} 397}
512 $self->{_activity} = $NOW; 514 $self->{_activity} = $NOW;
513 515
514 if ($self->{on_timeout}) { 516 if ($self->{on_timeout}) {
515 $self->{on_timeout}($self); 517 $self->{on_timeout}($self);
516 } else { 518 } else {
517 $self->_error (&Errno::ETIMEDOUT); 519 $self->_error (Errno::ETIMEDOUT);
518 } 520 }
519 521
520 # callback could have changed timeout value, optimise 522 # callback could have changed timeout value, optimise
521 return unless $self->{timeout}; 523 return unless $self->{timeout};
522 524
864 866
865 if ( 867 if (
866 defined $self->{rbuf_max} 868 defined $self->{rbuf_max}
867 && $self->{rbuf_max} < length $self->{rbuf} 869 && $self->{rbuf_max} < length $self->{rbuf}
868 ) { 870 ) {
869 $self->_error (&Errno::ENOSPC, 1), return; 871 $self->_error (Errno::ENOSPC, 1), return;
870 } 872 }
871 873
872 while () { 874 while () {
873 # we need to use a separate tls read buffer, as we must not receive data while 875 # we need to use a separate tls read buffer, as we must not receive data while
874 # we are draining the buffer, and this can only happen with TLS. 876 # we are draining the buffer, and this can only happen with TLS.
878 880
879 if (my $cb = shift @{ $self->{_queue} }) { 881 if (my $cb = shift @{ $self->{_queue} }) {
880 unless ($cb->($self)) { 882 unless ($cb->($self)) {
881 if ($self->{_eof}) { 883 if ($self->{_eof}) {
882 # no progress can be made (not enough data and no data forthcoming) 884 # no progress can be made (not enough data and no data forthcoming)
883 $self->_error (&Errno::EPIPE, 1), return; 885 $self->_error (Errno::EPIPE, 1), return;
884 } 886 }
885 887
886 unshift @{ $self->{_queue} }, $cb; 888 unshift @{ $self->{_queue} }, $cb;
887 last; 889 last;
888 } 890 }
896 && !@{ $self->{_queue} } # and the queue is still empty 898 && !@{ $self->{_queue} } # and the queue is still empty
897 && $self->{on_read} # but we still have on_read 899 && $self->{on_read} # but we still have on_read
898 ) { 900 ) {
899 # no further data will arrive 901 # no further data will arrive
900 # so no progress can be made 902 # so no progress can be made
901 $self->_error (&Errno::EPIPE, 1), return 903 $self->_error (Errno::EPIPE, 1), return
902 if $self->{_eof}; 904 if $self->{_eof};
903 905
904 last; # more data might arrive 906 last; # more data might arrive
905 } 907 }
906 } else { 908 } else {
1156 return 1; 1158 return 1;
1157 } 1159 }
1158 1160
1159 # reject 1161 # reject
1160 if ($reject && $$rbuf =~ $reject) { 1162 if ($reject && $$rbuf =~ $reject) {
1161 $self->_error (&Errno::EBADMSG); 1163 $self->_error (Errno::EBADMSG);
1162 } 1164 }
1163 1165
1164 # skip 1166 # skip
1165 if ($skip && $$rbuf =~ $skip) { 1167 if ($skip && $$rbuf =~ $skip) {
1166 $data .= substr $$rbuf, 0, $+[0], ""; 1168 $data .= substr $$rbuf, 0, $+[0], "";
1182 my ($self, $cb) = @_; 1184 my ($self, $cb) = @_;
1183 1185
1184 sub { 1186 sub {
1185 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 1187 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
1186 if ($_[0]{rbuf} =~ /[^0-9]/) { 1188 if ($_[0]{rbuf} =~ /[^0-9]/) {
1187 $self->_error (&Errno::EBADMSG); 1189 $self->_error (Errno::EBADMSG);
1188 } 1190 }
1189 return; 1191 return;
1190 } 1192 }
1191 1193
1192 my $len = $1; 1194 my $len = $1;
1195 my $string = $_[1]; 1197 my $string = $_[1];
1196 $_[0]->unshift_read (chunk => 1, sub { 1198 $_[0]->unshift_read (chunk => 1, sub {
1197 if ($_[1] eq ",") { 1199 if ($_[1] eq ",") {
1198 $cb->($_[0], $string); 1200 $cb->($_[0], $string);
1199 } else { 1201 } else {
1200 $self->_error (&Errno::EBADMSG); 1202 $self->_error (Errno::EBADMSG);
1201 } 1203 }
1202 }); 1204 });
1203 }); 1205 });
1204 1206
1205 1 1207 1
1295 $json->incr_skip; 1297 $json->incr_skip;
1296 1298
1297 $self->{rbuf} = $json->incr_text; 1299 $self->{rbuf} = $json->incr_text;
1298 $json->incr_text = ""; 1300 $json->incr_text = "";
1299 1301
1300 $self->_error (&Errno::EBADMSG); 1302 $self->_error (Errno::EBADMSG);
1301 1303
1302 () 1304 ()
1303 } else { 1305 } else {
1304 $self->{rbuf} = ""; 1306 $self->{rbuf} = "";
1305 1307
1342 # read remaining chunk 1344 # read remaining chunk
1343 $_[0]->unshift_read (chunk => $len, sub { 1345 $_[0]->unshift_read (chunk => $len, sub {
1344 if (my $ref = eval { Storable::thaw ($_[1]) }) { 1346 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1345 $cb->($_[0], $ref); 1347 $cb->($_[0], $ref);
1346 } else { 1348 } else {
1347 $self->_error (&Errno::EBADMSG); 1349 $self->_error (Errno::EBADMSG);
1348 } 1350 }
1349 }); 1351 });
1350 } 1352 }
1351 1353
1352 1 1354 1
1450 if ($self->{_on_starttls}) { 1452 if ($self->{_on_starttls}) {
1451 (delete $self->{_on_starttls})->($self, undef, $err); 1453 (delete $self->{_on_starttls})->($self, undef, $err);
1452 &_freetls; 1454 &_freetls;
1453 } else { 1455 } else {
1454 &_freetls; 1456 &_freetls;
1455 $self->_error (&Errno::EPROTO, 1, $err); 1457 $self->_error (Errno::EPROTO, 1, $err);
1456 } 1458 }
1457} 1459}
1458 1460
1459# poll the write BIO and send the data if applicable 1461# poll the write BIO and send the data if applicable
1460# also decode read data if possible 1462# also decode read data if possible
1635 1637
1636 &_freetls; 1638 &_freetls;
1637 1639
1638 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 1640 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1639 1641
1640 if ($linger && length $self->{wbuf}) { 1642 if ($linger && length $self->{wbuf} && $self->{fh}) {
1641 my $fh = delete $self->{fh}; 1643 my $fh = delete $self->{fh};
1642 my $wbuf = delete $self->{wbuf}; 1644 my $wbuf = delete $self->{wbuf};
1643 1645
1644 my @linger; 1646 my @linger;
1645 1647

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines