File Coverage

blib/lib/VCS/Lite/Element/Binary.pm
Criterion Covered Total %
statement 55 55 100.0
branch 7 10 70.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 72 75 96.0


line stmt bran cond sub pod time code
1             package VCS::Lite::Element::Binary;
2              
3 4     4   6139 use strict;
  4         7  
  4         221  
4 4     4   18 use warnings;
  4         7  
  4         184  
5              
6             our $VERSION = '0.12';
7              
8             #----------------------------------------------------------------------------
9              
10 4     4   16 use base qw/VCS::Lite::Element/;
  4         4  
  4         695  
11 4     4   19 use Carp;
  4         6  
  4         245  
12 4     4   20 use File::Spec::Functions qw/:ALL !path/;
  4         4  
  4         736  
13 4     4   19 use Params::Validate qw(:all);
  4         6  
  4         2035  
14              
15             our @CARP_NOT = qw/VCS::Lite::Element/;
16              
17             #----------------------------------------------------------------------------
18              
19             sub new {
20 1     1 1 51 my $pkg = shift;
21 1         1 my $name = shift;
22 1         42 my %args = validate ( @_,
23             {
24             store => 0, # Handled by SUPER::new
25             verbose => 0,
26             recordsize => { type => SCALAR, default => 128 },
27             } );
28 1         15 $pkg->SUPER::new($name,%args);
29             }
30              
31             sub _slurp_lite {
32 5     5   619 my $self = shift;
33 5         6 my $name = shift;
34 5         6 my $recsiz = $self->{recordsize};
35              
36 5         5 my $in;
37              
38 5 50       124 open $in,'<',$name or croak "$name: $!";
39 5         10 binmode $in;
40 5         2 my @fil;
41             my $buff;
42 5         42 while (sysread($in,$buff,$recsiz)) {
43 122         329 push @fil,$buff;
44             }
45 5         27 VCS::Lite->new($name,undef,\@fil);
46             }
47              
48             sub _contents {
49 7     7   8 my $self = shift;
50              
51 7         9 my $recsiz = $self->{recordsize};
52 7         40 my $bin = $self->{store}->store_path($self->path,'vbin');
53 7         68 my $cont;
54 7 100       14 if (@_) {
55 2         3 $cont = shift;
56 2         2 my $out;
57 2 50       121 open $out,'>',$bin or croak "$bin: $!";
58 2         4 binmode $out;
59 2         5 for (@$cont) {
60 101         108 my $str = pack 'n',length $_;
61 101         433 syswrite($out,$str.$_);
62             }
63             } else {
64 5 100       74 return [] unless -f $bin;
65 3         4 my $in;
66              
67 3 50       74 open $in,'<',$bin or croak "$bin: $!";
68 3         5 binmode $in;
69 3         3 my @fil;
70             my $buff;
71 3         18 while (sysread($in,$buff,2)) {
72 170         222 my $rsz = unpack 'n',$buff;
73 170         299 sysread($in,$buff,$rsz);
74 170         526 push @fil,$buff;
75             }
76 3         28 $cont = \@fil;
77             }
78 5         19 $cont;
79             }
80            
81             1; #this line is important and will help the module return a true value
82              
83             __END__