File Coverage

blib/lib/Hash/Storage/Driver/Files.pm
Criterion Covered Total %
statement 55 55 100.0
branch 6 8 75.0
condition 2 2 100.0
subroutine 17 17 100.0
pod 0 7 0.0
total 80 89 89.8


line stmt bran cond sub pod time code
1             package Hash::Storage::Driver::Files;
2              
3             our $VERSION = '0.03';
4              
5 1     1   689 use v5.10;
  1         3  
  1         40  
6 1     1   4 use strict;
  1         1  
  1         27  
7 1     1   4 use warnings;
  1         2  
  1         24  
8              
9 1     1   563 use File::Slurp;
  1         10940  
  1         79  
10 1     1   8 use Carp qw/croak/;
  1         2  
  1         43  
11 1     1   37 use Digest::MD5 qw/md5_hex/;
  1         2  
  1         91  
12              
13 1     1   7 use base 'Hash::Storage::Driver::Base';
  1         2  
  1         683  
14              
15             sub new {
16 1     1 0 3 my ($class, %args) = @_;
17              
18 1         7 my $self = $class->SUPER::new(%args);
19 1 50       38 croak "WRONG DIR [$self->{dir}]" unless -d $self->{dir};
20 1         35 return $self;
21             }
22              
23             sub init {
24 1     1 0 2 my ($self) = @_;
25             }
26              
27             sub get {
28 23     23 0 32 my ( $self, $id ) = @_;
29              
30 23         43 my $file = $self->_file_by_id($id);
31 23 100       734 return unless -e $file;
32              
33 14         44 my $serialized = read_file($file);
34 14         996 return $self->{serializer}->deserialize($serialized);
35             }
36              
37             sub set {
38 16     16 0 20 my ( $self, $id, $fields ) = @_;
39              
40             $self->do_exclusively( sub {
41 16   100 16   43 my $data = $self->get($id) || {};
42 16         395 @{$data}{ keys %$fields } = values %$fields;
  16         55  
43              
44 16         60 my $serialized = $self->{serializer}->serialize($data);
45 16         625 write_file( $self->_file_by_id($id), { atomic => 1 }, $serialized );
46 16         136 } );
47             }
48              
49             sub del {
50 2     2 0 4 my ( $self, $id ) = @_;
51             $self->do_exclusively( sub {
52 2     2   6 unlink( $self->_file_by_id($id) );
53 2         15 });
54             }
55              
56             sub list {
57 10     10 0 17 my ( $self, @query ) = @_;
58 10         17 my $dir = $self->{dir};
59 10         14 my @hashes;
60              
61 10 50       95 opendir( my $dh , $dir ) or die "Cannot open dir [$dir]";
62 10         507 while ( my $file = readdir($dh) ){
63 70 100       1868 next if $file !~ /^[a-f0-9]+\.hst$/;
64              
65 50         141 my $serialized = read_file("$dir/$file");
66 50         3474 push @hashes, $self->{serializer}->deserialize($serialized);
67             }
68              
69 10         53 return $self->do_filtering(\@hashes, \@query);
70             }
71              
72             sub count {
73 5     5 0 5 my ( $self, $filter ) = @_;
74 5         10 my $hashes = $self->list(where => $filter);
75 5         434 return scalar(@$hashes);
76             }
77              
78             sub _file_by_id {
79 41     41   59 my ( $self, $id ) = @_;
80 41         153 return $self->{dir} . '/' . md5_hex($id) . '.hst';
81             }
82              
83             1;