| 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__ |