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.72 by root, Wed Jul 16 21:17:59 2008 UTC vs.
Revision 1.82 by root, Thu Aug 21 18:45:16 2008 UTC

1package AnyEvent::Handle; 1package AnyEvent::Handle;
2 2
3no warnings; 3no warnings;
4use strict; 4use strict qw(subs vars);
5 5
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util qw(WSAEWOULDBLOCK); 7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 8use Scalar::Util ();
9use Carp (); 9use Carp ();
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 = 4.21; 19our $VERSION = 4.232;
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 when an end-of-file condition is detcted, 80Set the callback to be called when an end-of-file condition is detected,
81i.e. in the case of a socket, when the other side has closed the 81i.e. in the case of a socket, when the other side has closed the
82connection cleanly. 82connection cleanly.
83 83
84For sockets, this just means that the other side has stopped sending data,
85you can still try to write data, and, in fact, one can return from the eof
86callback and continue writing data, as only the read part has been shut
87down.
88
84While not mandatory, it is highly recommended to set an eof callback, 89While not mandatory, it is I<highly> recommended to set an eof callback,
85otherwise you might end up with a closed socket while you are still 90otherwise you might end up with a closed socket while you are still
86waiting for data. 91waiting for data.
92
93If an EOF condition has been detected but no C<on_eof> callback has been
94set, then a fatal error will be raised with C<$!> set to <0>.
87 95
88=item on_error => $cb->($handle, $fatal) 96=item on_error => $cb->($handle, $fatal)
89 97
90This is the error callback, which is called when, well, some error 98This is the error callback, which is called when, well, some error
91occured, such as not being able to resolve the hostname, failure to 99occured, such as not being able to resolve the hostname, failure to
92connect or a read error. 100connect or a read error.
93 101
94Some errors are fatal (which is indicated by C<$fatal> being true). On 102Some errors are fatal (which is indicated by C<$fatal> being true). On
95fatal errors the handle object will be shut down and will not be 103fatal errors the handle object will be shut down and will not be usable
104(but you are free to look at the current C< ->rbuf >). Examples of fatal
105errors are an EOF condition with active (but unsatisifable) read watchers
106(C<EPIPE>) or I/O errors.
107
96usable. Non-fatal errors can be retried by simply returning, but it is 108Non-fatal errors can be retried by simply returning, but it is recommended
97recommended to simply ignore this parameter and instead abondon the handle 109to simply ignore this parameter and instead abondon the handle object
98object when this callback is invoked. 110when this callback is invoked. Examples of non-fatal errors are timeouts
111C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
99 112
100On callback entrance, the value of C<$!> contains the operating system 113On callback entrance, the value of C<$!> contains the operating system
101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>). 114error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
102 115
103While not mandatory, it is I<highly> recommended to set this callback, as 116While not mandatory, it is I<highly> recommended to set this callback, as
225You can also provide your own TLS connection object, but you have 238You can also provide your own TLS connection object, but you have
226to make sure that you call either C<Net::SSLeay::set_connect_state> 239to make sure that you call either C<Net::SSLeay::set_connect_state>
227or C<Net::SSLeay::set_accept_state> on it before you pass it to 240or C<Net::SSLeay::set_accept_state> on it before you pass it to
228AnyEvent::Handle. 241AnyEvent::Handle.
229 242
230See the C<starttls> method if you need to start TLs negotiation later. 243See the C<starttls> method if you need to start TLS negotiation later.
231 244
232=item tls_ctx => $ssl_ctx 245=item tls_ctx => $ssl_ctx
233 246
234Use the given Net::SSLeay::CTX object to create the new TLS connection 247Use the given Net::SSLeay::CTX object to create the new TLS connection
235(unless a connection object was specified directly). If this parameter is 248(unless a connection object was specified directly). If this parameter is
288 delete $self->{_rw}; 301 delete $self->{_rw};
289 delete $self->{_ww}; 302 delete $self->{_ww};
290 delete $self->{fh}; 303 delete $self->{fh};
291 304
292 $self->stoptls; 305 $self->stoptls;
306
307 delete $self->{on_read};
308 delete $self->{_queue};
293} 309}
294 310
295sub _error { 311sub _error {
296 my ($self, $errno, $fatal) = @_; 312 my ($self, $errno, $fatal) = @_;
297 313
726 742
727 if ( 743 if (
728 defined $self->{rbuf_max} 744 defined $self->{rbuf_max}
729 && $self->{rbuf_max} < length $self->{rbuf} 745 && $self->{rbuf_max} < length $self->{rbuf}
730 ) { 746 ) {
731 return $self->_error (&Errno::ENOSPC, 1); 747 $self->_error (&Errno::ENOSPC, 1), return;
732 } 748 }
733 749
734 while () { 750 while () {
735 no strict 'refs';
736
737 my $len = length $self->{rbuf}; 751 my $len = length $self->{rbuf};
738 752
739 if (my $cb = shift @{ $self->{_queue} }) { 753 if (my $cb = shift @{ $self->{_queue} }) {
740 unless ($cb->($self)) { 754 unless ($cb->($self)) {
741 if ($self->{_eof}) { 755 if ($self->{_eof}) {
742 # no progress can be made (not enough data and no data forthcoming) 756 # no progress can be made (not enough data and no data forthcoming)
743 $self->_error (&Errno::EPIPE, 1), last; 757 $self->_error (&Errno::EPIPE, 1), return;
744 } 758 }
745 759
746 unshift @{ $self->{_queue} }, $cb; 760 unshift @{ $self->{_queue} }, $cb;
747 last; 761 last;
748 } 762 }
756 && !@{ $self->{_queue} } # and the queue is still empty 770 && !@{ $self->{_queue} } # and the queue is still empty
757 && $self->{on_read} # but we still have on_read 771 && $self->{on_read} # but we still have on_read
758 ) { 772 ) {
759 # no further data will arrive 773 # no further data will arrive
760 # so no progress can be made 774 # so no progress can be made
761 $self->_error (&Errno::EPIPE, 1), last 775 $self->_error (&Errno::EPIPE, 1), return
762 if $self->{_eof}; 776 if $self->{_eof};
763 777
764 last; # more data might arrive 778 last; # more data might arrive
765 } 779 }
766 } else { 780 } else {
768 delete $self->{_rw}; 782 delete $self->{_rw};
769 last; 783 last;
770 } 784 }
771 } 785 }
772 786
787 if ($self->{_eof}) {
788 if ($self->{on_eof}) {
773 $self->{on_eof}($self) 789 $self->{on_eof}($self)
774 if $self->{_eof} && $self->{on_eof}; 790 } else {
791 $self->_error (0, 1);
792 }
793 }
775 794
776 # may need to restart read watcher 795 # may need to restart read watcher
777 unless ($self->{_rw}) { 796 unless ($self->{_rw}) {
778 $self->start_read 797 $self->start_read
779 if $self->{on_read} || @{ $self->{_queue} }; 798 if $self->{on_read} || @{ $self->{_queue} };
905 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 924 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
906 1 925 1
907 } 926 }
908}; 927};
909 928
910# compatibility with older API
911sub push_read_chunk {
912 $_[0]->push_read (chunk => $_[1], $_[2]);
913}
914
915sub unshift_read_chunk {
916 $_[0]->unshift_read (chunk => $_[1], $_[2]);
917}
918
919=item line => [$eol, ]$cb->($handle, $line, $eol) 929=item line => [$eol, ]$cb->($handle, $line, $eol)
920 930
921The callback will be called only once a full line (including the end of 931The callback will be called only once a full line (including the end of
922line marker, C<$eol>) has been read. This line (excluding the end of line 932line marker, C<$eol>) has been read. This line (excluding the end of line
923marker) will be passed to the callback as second argument (C<$line>), and 933marker) will be passed to the callback as second argument (C<$line>), and
938=cut 948=cut
939 949
940register_read_type line => sub { 950register_read_type line => sub {
941 my ($self, $cb, $eol) = @_; 951 my ($self, $cb, $eol) = @_;
942 952
943 $eol = qr|(\015?\012)| if @_ < 3; 953 if (@_ < 3) {
954 # this is more than twice as fast as the generic code below
955 sub {
956 $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return;
957
958 $cb->($_[0], $1, $2);
959 1
960 }
961 } else {
944 $eol = quotemeta $eol unless ref $eol; 962 $eol = quotemeta $eol unless ref $eol;
945 $eol = qr|^(.*?)($eol)|s; 963 $eol = qr|^(.*?)($eol)|s;
946 964
947 sub { 965 sub {
948 $_[0]{rbuf} =~ s/$eol// or return; 966 $_[0]{rbuf} =~ s/$eol// or return;
949 967
950 $cb->($_[0], $1, $2); 968 $cb->($_[0], $1, $2);
969 1
951 1 970 }
952 } 971 }
953}; 972};
954
955# compatibility with older API
956sub push_read_line {
957 my $self = shift;
958 $self->push_read (line => @_);
959}
960
961sub unshift_read_line {
962 my $self = shift;
963 $self->unshift_read (line => @_);
964}
965 973
966=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 974=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
967 975
968Makes a regex match against the regex object C<$accept> and returns 976Makes a regex match against the regex object C<$accept> and returns
969everything up to and including the match. 977everything up to and including the match.
1090register_read_type packstring => sub { 1098register_read_type packstring => sub {
1091 my ($self, $cb, $format) = @_; 1099 my ($self, $cb, $format) = @_;
1092 1100
1093 sub { 1101 sub {
1094 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1102 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1095 defined (my $len = eval { unpack $format, $_[0]->{rbuf} }) 1103 defined (my $len = eval { unpack $format, $_[0]{rbuf} })
1096 or return; 1104 or return;
1097 1105
1106 $format = length pack $format, $len;
1107
1108 # bypass unshift if we already have the remaining chunk
1109 if ($format + $len <= length $_[0]{rbuf}) {
1110 my $data = substr $_[0]{rbuf}, $format, $len;
1111 substr $_[0]{rbuf}, 0, $format + $len, "";
1112 $cb->($_[0], $data);
1113 } else {
1098 # remove prefix 1114 # remove prefix
1099 substr $_[0]->{rbuf}, 0, (length pack $format, $len), ""; 1115 substr $_[0]{rbuf}, 0, $format, "";
1100 1116
1101 # read rest 1117 # read remaining chunk
1102 $_[0]->unshift_read (chunk => $len, $cb); 1118 $_[0]->unshift_read (chunk => $len, $cb);
1119 }
1103 1120
1104 1 1121 1
1105 } 1122 }
1106}; 1123};
1107 1124
1164 1181
1165 require Storable; 1182 require Storable;
1166 1183
1167 sub { 1184 sub {
1168 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1185 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1169 defined (my $len = eval { unpack "w", $_[0]->{rbuf} }) 1186 defined (my $len = eval { unpack "w", $_[0]{rbuf} })
1170 or return; 1187 or return;
1171 1188
1189 my $format = length pack "w", $len;
1190
1191 # bypass unshift if we already have the remaining chunk
1192 if ($format + $len <= length $_[0]{rbuf}) {
1193 my $data = substr $_[0]{rbuf}, $format, $len;
1194 substr $_[0]{rbuf}, 0, $format + $len, "";
1195 $cb->($_[0], Storable::thaw ($data));
1196 } else {
1172 # remove prefix 1197 # remove prefix
1173 substr $_[0]->{rbuf}, 0, (length pack "w", $len), ""; 1198 substr $_[0]{rbuf}, 0, $format, "";
1174 1199
1175 # read rest 1200 # read remaining chunk
1176 $_[0]->unshift_read (chunk => $len, sub { 1201 $_[0]->unshift_read (chunk => $len, sub {
1177 if (my $ref = eval { Storable::thaw ($_[1]) }) { 1202 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1178 $cb->($_[0], $ref); 1203 $cb->($_[0], $ref);
1179 } else { 1204 } else {
1180 $self->_error (&Errno::EBADMSG); 1205 $self->_error (&Errno::EBADMSG);
1206 }
1181 } 1207 });
1182 }); 1208 }
1209
1210 1
1183 } 1211 }
1184}; 1212};
1185 1213
1186=back 1214=back
1187 1215
1448=over 4 1476=over 4
1449 1477
1450=item * all constructor arguments become object members. 1478=item * all constructor arguments become object members.
1451 1479
1452At least initially, when you pass a C<tls>-argument to the constructor it 1480At least initially, when you pass a C<tls>-argument to the constructor it
1453will end up in C<< $handle->{tls} >>. Those members might be changes or 1481will end up in C<< $handle->{tls} >>. Those members might be changed or
1454mutated later on (for example C<tls> will hold the TLS connection object). 1482mutated later on (for example C<tls> will hold the TLS connection object).
1455 1483
1456=item * other object member names are prefixed with an C<_>. 1484=item * other object member names are prefixed with an C<_>.
1457 1485
1458All object members not explicitly documented (internal use) are prefixed 1486All object members not explicitly documented (internal use) are prefixed

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines