File Coverage

blib/lib/Net/IMP/Remote/Sereal.pm
Criterion Covered Total %
statement 39 40 97.5
branch 8 12 66.6
condition n/a
subroutine 12 12 100.0
pod 0 4 0.0
total 59 68 86.7


line stmt bran cond sub pod time code
1             package Net::IMP::Remote::Sereal;
2              
3 2     2   1168 use strict;
  2         5  
  2         99  
4 2     2   9 use warnings;
  2         3  
  2         63  
5 2     2   11 use Net::IMP::Remote::Protocol;
  2         5  
  2         259  
6 2     2   10 use Net::IMP qw(:DEFAULT :log);
  2         3  
  2         567  
7 2     2   13 use Net::IMP::Debug;
  2         3  
  2         14  
8 2     2   209 use Net::IMP::Remote::DualvarMapping;
  2         2  
  2         119  
9 2     2   10 use Sereal::Encoder 0.36;
  2         61  
  2         80  
10 2     2   12 use Sereal::Decoder 0.36;
  2         57  
  2         734  
11              
12             my $wire_version = 0x00000001;
13              
14             sub new {
15 1     1 0 888 bless {
16             encoder => Sereal::Encoder->new,
17             decoder => Sereal::Decoder->new({ incremental => 1 }),
18             }, shift;
19             }
20              
21             sub buf2rpc {
22 35     35 0 4003 my ($self,$rdata) = @_;
23 35         44 decode:
24             my $out = undef;
25 35 100       36 eval { $self->{decoder}->decode( $$rdata, $out ) } or return;
  35         433  
26 12 50       29 return if ! $out;
27 12 100       37 if ( $out->[0] == IMPRPC_SET_VERSION ) {
28 1 50       3 die "wrong version $out->[1], can do $wire_version only"
29             if $out->[1] != $wire_version;
30 1 50       7 return if $$rdata eq '';
31 0         0 goto decode;
32             }
33 11         34 return rpc_i2d($out);
34             }
35              
36             sub rpc2buf {
37 12     12 0 25256 my ($self,$rpc) = @_;
38 12         95 $self->{encoder}->encode(rpc_d2i($rpc))
39             }
40              
41             sub init {
42 1     1 0 935 my ($self,$side) = @_;
43 1 50       5 return if $side == 0;
44 1         4 $self->rpc2buf([IMPRPC_SET_VERSION,$wire_version])
45             }
46              
47             1;