File Coverage

blib/lib/SerealX/Store.pm
Criterion Covered Total %
statement 47 48 97.9
branch 17 26 65.3
condition n/a
subroutine 8 8 100.0
pod 3 3 100.0
total 75 85 88.2


line stmt bran cond sub pod time code
1             package SerealX::Store;
2             # ABSTRACT: Sereal based persistence for Perl data structures
3             our $VERSION = '0.003';
4              
5 1     1   31018 use 5.008001;
  1         5  
  1         40  
6 1     1   6 use strict;
  1         2  
  1         35  
7 1     1   4 use warnings;
  1         6  
  1         33  
8              
9 1     1   5 use Sereal::Encoder;
  1         1  
  1         36  
10 1     1   5 use Sereal::Decoder;
  1         1  
  1         590  
11              
12             # Constructor
13             sub new {
14 2     2 1 3975 my ($class, $params) = @_;
15            
16 2         4 my $self = {};
17 2 100       18 if (ref $params->{encoder} eq 'HASH') {
18 1         21 $self->{encoder} = Sereal::Encoder->new($params->{encoder});
19             }
20 2 100       9 if (ref $params->{decoder} eq 'HASH') {
21 1         22 $self->{decoder} = Sereal::Decoder->new($params->{decoder});
22             }
23            
24 2         9 return bless $self, $class;
25             }
26              
27             sub store {
28 2     2 1 3641 my ($self, $data, $path) = @_;
29              
30 2 50       9 die "No file specified" unless $path;
31 2 100       10 if (ref $self->{encoder} ne 'Sereal::Encoder') {
32 1         26 $self->{encoder} = Sereal::Encoder->new();
33             }
34 2         65 my $encoded = $self->{encoder}->encode($data);
35 2 50       375 open(my $fh, ">", $path) or die "Cannot open file $path: $!";
36 2         81 binmode $fh;
37 2 50       46 print $fh $encoded or die "Cannot write to file $path: $!";
38 2 50       108 close $fh or die "Cannot close file $path: $!";
39              
40 2         11 return 1;
41             }
42              
43             sub retrieve {
44 2     2 1 11 my ($self, $path) = @_;
45              
46 2 50       10 die "No file specified" unless $path;
47 2 100       9 if (ref $self->{decoder} ne 'Sereal::Decoder') {
48 1         16 $self->{decoder} = Sereal::Decoder->new();
49             }
50 2 50       75 open(my $fh, "<", $path) or die "Cannot open file $path: $!";
51 2         3 binmode $fh;
52 2         4 my $data;
53 2 50       21 if (my $size = -s $fh) {
54 2         5 my ($pos, $read) = 0;
55 2         8 while ($pos < $size) {
56 2 50       38 defined($read = read($fh, $data, $size - $pos, $pos))
57             or die "Cannot read file $path: $!";
58 2         7 $pos += $read;
59             }
60             }
61             else {
62 0         0 $data = <$fh>;
63             }
64 2 50       23 close $fh or die "Cannot close file $path: $!";
65 2         59 $self->{decoder}->decode($data, my $decoded);
66            
67 2         9 return $decoded;
68             }
69              
70             1;
71              
72             __END__