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.75 by root, Fri Jul 18 02:14:44 2008 UTC vs.
Revision 1.79 by root, Sun Jul 27 08:37:56 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 ();
… …
730 ) { 730 ) {
731 return $self->_error (&Errno::ENOSPC, 1); 731 return $self->_error (&Errno::ENOSPC, 1);
732 } 732 }
733 733
734 while () { 734 while () {
735 no strict 'refs';
736
737 my $len = length $self->{rbuf}; 735 my $len = length $self->{rbuf};
738 736
739 if (my $cb = shift @{ $self->{_queue} }) { 737 if (my $cb = shift @{ $self->{_queue} }) {
740 unless ($cb->($self)) { 738 unless ($cb->($self)) {
741 if ($self->{_eof}) { 739 if ($self->{_eof}) {
… …
905 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 903 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
906 1 904 1
907 } 905 }
908}; 906};
909 907
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) 908=item line => [$eol, ]$cb->($handle, $line, $eol)
920 909
921The callback will be called only once a full line (including the end of 910The 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 911line 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 912marker) will be passed to the callback as second argument (C<$line>), and
… …
938=cut 927=cut
939 928
940register_read_type line => sub { 929register_read_type line => sub {
941 my ($self, $cb, $eol) = @_; 930 my ($self, $cb, $eol) = @_;
942 931
943 $eol = qr|(\015?\012)| if @_ < 3; 932 if (@_ < 3) {
933 # this is more than twice as fast as the generic code below
934 sub {
935 $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return;
936
937 $cb->($_[0], $1, $2);
938 1
939 }
940 } else {
944 $eol = quotemeta $eol unless ref $eol; 941 $eol = quotemeta $eol unless ref $eol;
945 $eol = qr|^(.*?)($eol)|s; 942 $eol = qr|^(.*?)($eol)|s;
946 943
947 sub { 944 sub {
948 $_[0]{rbuf} =~ s/$eol// or return; 945 $_[0]{rbuf} =~ s/$eol// or return;
949 946
950 $cb->($_[0], $1, $2); 947 $cb->($_[0], $1, $2);
948 1
951 1 949 }
952 } 950 }
953}; 951};
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 952
966=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 953=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
967 954
968Makes a regex match against the regex object C<$accept> and returns 955Makes a regex match against the regex object C<$accept> and returns
969everything up to and including the match. 956everything up to and including the match.
… …
1090register_read_type packstring => sub { 1077register_read_type packstring => sub {
1091 my ($self, $cb, $format) = @_; 1078 my ($self, $cb, $format) = @_;
1092 1079
1093 sub { 1080 sub {
1094 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1081 # 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} }) 1082 defined (my $len = eval { unpack $format, $_[0]{rbuf} })
1096 or return; 1083 or return;
1097 1084
1085 $format = length pack $format, $len;
1086
1087 # bypass unshift if we already have the remaining chunk
1088 if ($format + $len <= length $_[0]{rbuf}) {
1089 my $data = substr $_[0]{rbuf}, $format, $len;
1090 substr $_[0]{rbuf}, 0, $format + $len, "";
1091 $cb->($_[0], $data);
1092 } else {
1098 # remove prefix 1093 # remove prefix
1099 substr $_[0]->{rbuf}, 0, (length pack $format, $len), ""; 1094 substr $_[0]{rbuf}, 0, $format, "";
1100 1095
1101 # read rest 1096 # read remaining chunk
1102 $_[0]->unshift_read (chunk => $len, $cb); 1097 $_[0]->unshift_read (chunk => $len, $cb);
1098 }
1103 1099
1104 1 1100 1
1105 } 1101 }
1106}; 1102};
1107 1103
… …
1164 1160
1165 require Storable; 1161 require Storable;
1166 1162
1167 sub { 1163 sub {
1168 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1164 # 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} }) 1165 defined (my $len = eval { unpack "w", $_[0]{rbuf} })
1170 or return; 1166 or return;
1171 1167
1168 my $format = length pack "w", $len;
1169
1170 # bypass unshift if we already have the remaining chunk
1171 if ($format + $len <= length $_[0]{rbuf}) {
1172 my $data = substr $_[0]{rbuf}, $format, $len;
1173 substr $_[0]{rbuf}, 0, $format + $len, "";
1174 $cb->($_[0], Storable::thaw ($data));
1175 } else {
1172 # remove prefix 1176 # remove prefix
1173 substr $_[0]->{rbuf}, 0, (length pack "w", $len), ""; 1177 substr $_[0]{rbuf}, 0, $format, "";
1174 1178
1175 # read rest 1179 # read remaining chunk
1176 $_[0]->unshift_read (chunk => $len, sub { 1180 $_[0]->unshift_read (chunk => $len, sub {
1177 if (my $ref = eval { Storable::thaw ($_[1]) }) { 1181 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1178 $cb->($_[0], $ref); 1182 $cb->($_[0], $ref);
1179 } else { 1183 } else {
1180 $self->_error (&Errno::EBADMSG); 1184 $self->_error (&Errno::EBADMSG);
1185 }
1181 } 1186 });
1182 }); 1187 }
1188
1189 1
1183 } 1190 }
1184}; 1191};
1185 1192
1186=back 1193=back
1187 1194

Diff Legend

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