| … | |
… | |
| 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); |
