| … | |
… | |
| 69 | |
69 | |
| 70 | package Net::FCP; |
70 | package Net::FCP; |
| 71 | |
71 | |
| 72 | use Carp; |
72 | use Carp; |
| 73 | |
73 | |
| 74 | $VERSION = 0.07; |
74 | $VERSION = 0.08; |
| 75 | |
75 | |
| 76 | no warnings; |
76 | no warnings; |
| 77 | |
77 | |
| 78 | our $EVENT = Net::FCP::Event::Auto::; |
78 | our $EVENT = Net::FCP::Event::Auto::; |
| 79 | $EVENT = Net::FCP::Event::Event;#d# |
79 | $EVENT = Net::FCP::Event::Event;#d# |
| … | |
… | |
| 160 | } elsif ($data =~ /\GEnd(\015?\012|$)/gc) { |
160 | } elsif ($data =~ /\GEnd(\015?\012|$)/gc) { |
| 161 | last; |
161 | last; |
| 162 | } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) { |
162 | } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) { |
| 163 | push @{$meta->{tolc $1}}, $hdr = {}; |
163 | push @{$meta->{tolc $1}}, $hdr = {}; |
| 164 | } elsif ($data =~ /\G(.*)/gcs) { |
164 | } elsif ($data =~ /\G(.*)/gcs) { |
| 165 | die "metadata format error ($1), please report this string: <<$data>>"; |
165 | print STDERR "metadata format error ($1), please report this string: <<$data>>"; |
|
|
166 | die "metadata format error"; |
| 166 | } |
167 | } |
| 167 | } |
168 | } |
| 168 | } |
169 | } |
| 169 | |
170 | |
| 170 | #$meta->{tail} = substr $data, pos $data; |
171 | #$meta->{tail} = substr $data, pos $data; |
| … | |
… | |
| 202 | $self; |
203 | $self; |
| 203 | } |
204 | } |
| 204 | |
205 | |
| 205 | sub progress { |
206 | sub progress { |
| 206 | my ($self, $txn, $type, $attr) = @_; |
207 | my ($self, $txn, $type, $attr) = @_; |
| 207 | warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; |
208 | #warn "progress<$txn,$type," . (join ":", %$attr) . ">\n"; |
| 208 | } |
209 | } |
| 209 | |
210 | |
| 210 | =item $txn = $fcp->txn(type => attr => val,...) |
211 | =item $txn = $fcp->txn(type => attr => val,...) |
| 211 | |
212 | |
| 212 | The low-level interface to transactions. Don't use it. |
213 | The low-level interface to transactions. Don't use it. |
| … | |
… | |
| 772 | sub rcv_data { |
773 | sub rcv_data { |
| 773 | my ($self, $chunk) = @_; |
774 | my ($self, $chunk) = @_; |
| 774 | |
775 | |
| 775 | $self->{data} .= $chunk; |
776 | $self->{data} .= $chunk; |
| 776 | |
777 | |
| 777 | $self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} }); |
778 | $self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} }); |
| 778 | |
779 | |
| 779 | if ($self->{datalength} == length $self->{data}) { |
780 | if ($self->{datalength} == length $self->{data}) { |
| 780 | my $data = delete $self->{data}; |
781 | my $data = delete $self->{data}; |
| 781 | my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; |
782 | my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, ""; |
| 782 | |
783 | |
