File Coverage

blib/lib/DataStore/CAS/Virtual.pm
Criterion Covered Total %
statement 27 51 52.9
branch 4 16 25.0
condition 2 17 11.7
subroutine 9 17 52.9
pod 7 7 100.0
total 49 108 45.3


line stmt bran cond sub pod time code
1             package DataStore::CAS::Virtual;
2 2     2   1646 use 5.008;
  2         13  
3 2     2   1156 use Moo 1.000007;
  2         13719  
  2         13  
4 2     2   2095 use Carp;
  2         4  
  2         108  
5 2     2   11 use Try::Tiny;
  2         4  
  2         121  
6 2     2   1060 use Digest 1.16;
  2         1268  
  2         1478  
7              
8             our $VERSION= '0.07';
9              
10             # ABSTRACT: In-memory CAS for debugging and testing
11              
12              
13             has digest => ( is => 'ro', default => sub { 'SHA-1' } );
14             has entries => ( is => 'rw', default => sub { {} } );
15              
16             with 'DataStore::CAS';
17              
18              
19             sub get {
20 2     2 1 6 my ($self, $hash)= @_;
21 2 50       12 defined (my $data= $self->entries->{$hash})
22             or return undef;
23 2         22 return bless { store => $self, hash => $hash, size => length($data), data => $data }, 'DataStore::CAS::File';
24             }
25              
26             sub put_scalar {
27 1     1 1 4 my ($self, $data, $flags)= @_;
28              
29             my $hash= ($flags and defined $flags->{known_hash})? $flags->{known_hash}
30 1 50 33     11 : Digest->new($self->digest)->add($data)->hexdigest;
31              
32             $self->entries->{$hash}= $data
33 1 50 33     41 unless $flags and $flags->{dry_run};
34              
35 1         10 $hash;
36             }
37              
38             sub new_write_handle {
39 0     0 1 0 my ($self, $flags)= @_;
40 0         0 my $data= {
41             buffer => '',
42             flags => $flags
43             };
44 0         0 return DataStore::CAS::FileCreatorHandle->new($self, $data);
45             }
46              
47             sub _handle_write {
48 0     0   0 my ($self, $handle, $buffer, $count, $offset)= @_;
49 0         0 my $data= $handle->_data;
50 0 0       0 utf8::encode($buffer) if utf8::is_utf8($buffer);
51 0   0     0 $offset ||= 0;
52 0   0     0 $count ||= length($buffer)-$offset;
53 0         0 $data->{buffer} .= substr($buffer, $offset, $count);
54 0         0 return $count;
55             }
56              
57             sub _handle_seek {
58 0     0   0 croak "Seek unsupported (for now)"
59             }
60              
61             sub _handle_tell {
62 0     0   0 my ($self, $handle)= @_;
63 0         0 return length($handle->_data->{buffer});
64             }
65              
66             sub commit_write_handle {
67 0     0 1 0 my ($self, $handle)= @_;
68 0         0 return $self->put_scalar($handle->_data->{buffer}, $handle->_data->{flags});
69             }
70              
71             sub open_file {
72 1     1 1 4 my ($self, $file, $flags)= @_;
73 1 50   1   9 open(my $fh, '<', \$self->entries->{$file->hash})
  1         6  
  1         2  
  1         6  
74             or die "open: $!";
75 1         790 return $fh;
76             }
77              
78             sub iterator {
79 0     0 1 0 my $self= shift;
80 0         0 my @entries= sort keys %{$self->entries};
  0         0  
81 0     0   0 sub { shift @entries };
  0         0  
82             }
83              
84             sub delete {
85 0     0 1 0 my ($self, $hash, $flags)= @_;
86             my $deleted= ($flags && $flags->{dry_run})?
87             exists $self->entries->{$hash}
88 0 0 0     0 : defined delete $self->entries->{$hash};
89             $flags->{stats}{$deleted? 'delete_count' : 'delete_missing'}++
90 0 0 0     0 if $flags && $flags->{stats};
    0          
91 0         0 $deleted;
92             }
93              
94             1;
95              
96             __END__