| … | |
… | |
| 45 | |
45 | |
| 46 | package Net::FCP; |
46 | package Net::FCP; |
| 47 | |
47 | |
| 48 | use Carp; |
48 | use Carp; |
| 49 | |
49 | |
| 50 | $VERSION = 0.05; |
50 | $VERSION = 0.07; |
| 51 | |
51 | |
| 52 | no warnings; |
52 | no warnings; |
| 53 | |
53 | |
| 54 | our $EVENT = Net::FCP::Event::Auto::; |
54 | our $EVENT = Net::FCP::Event::Auto::; |
| 55 | $EVENT = Net::FCP::Event::Event;#d# |
55 | $EVENT = Net::FCP::Event::Event;#d# |
| … | |
… | |
| 125 | my ($k, $v) = ($1, $2); |
125 | my ($k, $v) = ($1, $2); |
| 126 | my @p = split /\./, tolc $k, 3; |
126 | my @p = split /\./, tolc $k, 3; |
| 127 | |
127 | |
| 128 | $hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote |
128 | $hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote |
| 129 | $hdr->{$p[0]}{$p[1]} = $v if @p == 2; |
129 | $hdr->{$p[0]}{$p[1]} = $v if @p == 2; |
| 130 | $hdr->{$p[0]}{$p[1]}{$p[3]} = $v if @p == 3; |
130 | $hdr->{$p[0]}{$p[1]}{$p[2]} = $v if @p == 3; |
| 131 | die "FATAL: 4+ dot metadata" if @p >= 4; |
131 | die "FATAL: 4+ dot metadata" if @p >= 4; |
| 132 | } |
132 | } |
| 133 | |
133 | |
| 134 | if ($data =~ /\GEndPart\015?\012/gc) { |
134 | if ($data =~ /\GEndPart\015?\012/gc) { |
| 135 | # nop |
135 | # nop |
| … | |
… | |
| 509 | my ($self) = @_; |
509 | my ($self) = @_; |
| 510 | |
510 | |
| 511 | if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { |
511 | if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) { |
| 512 | for (;;) { |
512 | for (;;) { |
| 513 | if ($self->{datalen}) { |
513 | if ($self->{datalen}) { |
| 514 | warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d# |
514 | #warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d# |
| 515 | if (length $self->{buf} >= $self->{datalen}) { |
515 | if (length $self->{buf} >= $self->{datalen}) { |
| 516 | $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, ""); |
516 | $self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, ""); |
| 517 | } else { |
517 | } else { |
| 518 | last; |
518 | last; |
| 519 | } |
519 | } |
| 520 | } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) { |
520 | } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) { |
| 521 | $self->{datalen} = hex $1; |
521 | $self->{datalen} = hex $1; |
| 522 | warn "expecting new datachunk $self->{datalen}\n";#d# |
522 | #warn "expecting new datachunk $self->{datalen}\n";#d# |
| 523 | } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) { |
523 | } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) { |
| 524 | $self->rcv ($1, { |
524 | $self->rcv ($1, { |
| 525 | map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) } |
525 | map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) } |
| 526 | split /\015?\012/, $2 |
526 | split /\015?\012/, $2 |
| 527 | }); |
527 | }); |
| … | |
… | |
| 557 | } |
557 | } |
| 558 | |
558 | |
| 559 | # used as a default exception thrower |
559 | # used as a default exception thrower |
| 560 | sub rcv_throw_exception { |
560 | sub rcv_throw_exception { |
| 561 | my ($self, $attr, $type) = @_; |
561 | my ($self, $attr, $type) = @_; |
| 562 | $self->throw (new Net::FCP::Exception $type, $attr); |
562 | $self->throw (Net::FCP::Exception->new ($type, $attr)); |
| 563 | } |
563 | } |
| 564 | |
564 | |
| 565 | *rcv_failed = \&Net::FCP::Txn::rcv_throw_exception; |
565 | *rcv_failed = \&Net::FCP::Txn::rcv_throw_exception; |
| 566 | *rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception; |
566 | *rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception; |
| 567 | |
567 | |
