File Coverage

blib/lib/Data/Keys/E/Store/Dir.pm
Criterion Covered Total %
statement 34 34 100.0
branch 11 16 68.7
condition 3 6 50.0
subroutine 6 6 100.0
pod 2 2 100.0
total 56 64 87.5


line stmt bran cond sub pod time code
1             package Data::Keys::E::Store::Dir;
2              
3             =head1 NAME
4              
5             Data::Keys::E::Store::Dir - folder storage
6              
7             =head1 SYNOPSIS
8              
9             my $dk = Data::Keys->new(
10             'base_dir' => '/some/folder',
11             'extend_with' => 'Store::Dir',
12             );
13              
14             =head1 DESCRIPTION
15              
16             Store values into a folder. Keys are the file names.
17              
18             =head1 METHODS
19              
20             =cut
21              
22 11     11   1187 use warnings;
  11         9  
  11         334  
23 11     11   36 use strict;
  11         11  
  11         330  
24              
25             our $VERSION = '0.03';
26              
27 11     11   443 use Moose::Role;
  11         3191  
  11         87  
28              
29             has 'base_dir' => ( isa => 'Str', is => 'rw',);
30              
31             after 'init' => sub {
32             my $self = shift;
33              
34             confess 'base_dir is a mandatory argument'
35             if not $self->base_dir;
36             confess $self->base_dir.' is not a writable folder'
37             if (not -d $self->base_dir) or (not -w $self->base_dir);
38            
39             return;
40             };
41              
42             =head2 get($filename)
43              
44             Reads C<$filename> and returns its content.
45              
46             =cut
47              
48             sub get {
49 20     20 1 1527 my $self = shift;
50 20         27 my $key = shift;
51 20 50       49 confess 'too many arguments ' if @_;
52            
53 20         87 my $filename = $self->_make_filename($key);
54 20         29 return eval { IO::Any->slurp([$filename]) };
  20         124  
55             }
56              
57             =head2 set($filename, $content)
58              
59             Writes C<$content> into the C<$filename>. Returns C<$filename>.
60              
61             =cut
62              
63             sub set {
64 22     22 1 1302 my $self = shift;
65 22         75 my $key = shift;
66 22         33 my $value = shift;
67 22 50       65 confess 'too many arguments ' if @_;
68              
69 22         59 my ($new_key, $filename) = $self->_make_filename($key);
70              
71             # if value is undef, remove the file
72 22 100       54 if (not defined $value) {
73 2 50 66     78 unlink($filename) || (not -f $filename) || warn 'failed to remove "'.$filename.'"';
74 2         12 return $new_key;
75             }
76              
77 20         58 eval { IO::Any->spew([$filename], $value, { 'atomic' => 1 }); };
  20         230  
78 20 100       8760 confess 'failed to store "'.$key.'" - '.$@
79             if $@;
80            
81 18         52 return $new_key;
82             }
83              
84             sub _make_filename {
85 59     59   56 my $self = shift;
86 59         57 my $key = shift;
87 59 50 33     297 confess 'need key (with length > 0) as argument'
88             if ((not defined $key) or (length($key) == 0));
89 59 50       106 confess 'too many arguments ' if @_;
90            
91 59         1911 my $filename = File::Spec->catfile(
92             $self->base_dir,
93             $key
94             );
95            
96 59 100       191 return ($key, $filename)
97             if wantarray;
98 20         40 return $filename;
99             }
100              
101             1;
102              
103              
104             __END__
105              
106             =head1 AUTHOR
107              
108             Jozef Kutej
109              
110             =cut