File Coverage

blib/lib/Net/IMP/Remote/Storable.pm
Criterion Covered Total %
statement 40 41 97.5
branch 9 12 75.0
condition n/a
subroutine 11 11 100.0
pod 0 4 0.0
total 60 68 88.2


line stmt bran cond sub pod time code
1             package Net::IMP::Remote::Storable;
2              
3 2     2   1502 use strict;
  2         5  
  2         77  
4 2     2   12 use warnings;
  2         27  
  2         89  
5 2     2   15 use Net::IMP::Remote::Protocol;
  2         4  
  2         221  
6 2     2   15 use Net::IMP qw(:DEFAULT :log);
  2         4  
  2         469  
7 2     2   17 use Net::IMP::Debug;
  2         5  
  2         17  
8 2     2   1255 use Net::IMP::Remote::DualvarMapping;
  2         7  
  2         123  
9 2     2   944 use Storable ();
  2         3927  
  2         720  
10              
11             my $wire_version = 0x00000001;
12              
13             sub new {
14 1     1 0 449 bless {}, shift;
15             }
16              
17             sub buf2rpc {
18 46     46 0 2956 my ($self,$rdata) = @_;
19 46 100       98 decode:
20             return if length($$rdata)<6;
21 42         96 my ($len) = unpack("x2L",$$rdata);
22 42 100       95 return if length($$rdata) - 6 < $len;
23 12         42 my ($op,$args) = unpack("SL/a*",$$rdata);
24 12         33 substr($$rdata,0,$len+6,'');
25 12         29 $args = Storable::thaw($args);
26 12 100       244 if ( $op == IMPRPC_SET_VERSION ) {
27 1 50       4 die "wrong version $args->[0], can do $wire_version only"
28             if $args->[0] != $wire_version;
29 1 50       5 return if $$rdata eq '';
30 0         0 goto decode;
31             }
32 11         49 return rpc_i2d([$op,@$args]);
33             }
34              
35             sub rpc2buf {
36 12     12 0 17583 my ($self,$rpc) = @_;
37 12         22 my ($op,@args) = @{ rpc_d2i($rpc) };
  12         35  
38 12         41 return pack("SL/a*",$op,Storable::nfreeze(\@args));
39             }
40              
41             sub init {
42 1     1 0 603 my ($self,$side) = @_;
43 1 50       4 return if $side == 0;
44 1         3 $self->rpc2buf([IMPRPC_SET_VERSION,$wire_version])
45             }
46              
47             1;