… | |
… | |
938 | =cut |
938 | =cut |
939 | |
939 | |
940 | register_read_type line => sub { |
940 | register_read_type line => sub { |
941 | my ($self, $cb, $eol) = @_; |
941 | my ($self, $cb, $eol) = @_; |
942 | |
942 | |
943 | $eol = qr|(\015?\012)| if @_ < 3; |
943 | if (@_ < 3) { |
|
|
944 | # this is more than twice as fast as the generic code below |
|
|
945 | sub { |
|
|
946 | $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return; |
|
|
947 | |
|
|
948 | $cb->($_[0], $1, $2); |
|
|
949 | 1 |
|
|
950 | } |
|
|
951 | } else { |
944 | $eol = quotemeta $eol unless ref $eol; |
952 | $eol = quotemeta $eol unless ref $eol; |
945 | $eol = qr|^(.*?)($eol)|s; |
953 | $eol = qr|^(.*?)($eol)|s; |
946 | |
954 | |
947 | sub { |
955 | sub { |
948 | $_[0]{rbuf} =~ s/$eol// or return; |
956 | $_[0]{rbuf} =~ s/$eol// or return; |
949 | |
957 | |
950 | $cb->($_[0], $1, $2); |
958 | $cb->($_[0], $1, $2); |
|
|
959 | 1 |
951 | 1 |
960 | } |
952 | } |
961 | } |
953 | }; |
962 | }; |
954 | |
963 | |
955 | # compatibility with older API |
964 | # compatibility with older API |
956 | sub push_read_line { |
965 | sub push_read_line { |
… | |
… | |
1090 | register_read_type packstring => sub { |
1099 | register_read_type packstring => sub { |
1091 | my ($self, $cb, $format) = @_; |
1100 | my ($self, $cb, $format) = @_; |
1092 | |
1101 | |
1093 | sub { |
1102 | sub { |
1094 | # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method |
1103 | # 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} }) |
1104 | defined (my $len = eval { unpack $format, $_[0]{rbuf} }) |
1096 | or return; |
1105 | or return; |
1097 | |
1106 | |
1098 | # remove prefix |
1107 | # remove prefix |
1099 | substr $_[0]->{rbuf}, 0, (length pack $format, $len), ""; |
1108 | substr $_[0]{rbuf}, 0, (length pack $format, $len), ""; |
1100 | |
1109 | |
1101 | # read rest |
1110 | # read rest |
1102 | $_[0]->unshift_read (chunk => $len, $cb); |
1111 | $_[0]->unshift_read (chunk => $len, $cb); |
1103 | |
1112 | |
1104 | 1 |
1113 | 1 |
… | |
… | |
1164 | |
1173 | |
1165 | require Storable; |
1174 | require Storable; |
1166 | |
1175 | |
1167 | sub { |
1176 | sub { |
1168 | # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method |
1177 | # 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} }) |
1178 | defined (my $len = eval { unpack "w", $_[0]{rbuf} }) |
1170 | or return; |
1179 | or return; |
1171 | |
1180 | |
1172 | # remove prefix |
1181 | # remove prefix |
1173 | substr $_[0]->{rbuf}, 0, (length pack "w", $len), ""; |
1182 | substr $_[0]{rbuf}, 0, (length pack "w", $len), ""; |
1174 | |
1183 | |
1175 | # read rest |
1184 | # read rest |
1176 | $_[0]->unshift_read (chunk => $len, sub { |
1185 | $_[0]->unshift_read (chunk => $len, sub { |
1177 | if (my $ref = eval { Storable::thaw ($_[1]) }) { |
1186 | if (my $ref = eval { Storable::thaw ($_[1]) }) { |
1178 | $cb->($_[0], $ref); |
1187 | $cb->($_[0], $ref); |