File Coverage

blib/lib/Dir/Manifest.pm
Criterion Covered Total %
statement 66 68 97.0
branch 10 12 83.3
condition n/a
subroutine 16 16 100.0
pod 7 7 100.0
total 99 103 96.1


line stmt bran cond sub pod time code
1             package Dir::Manifest;
2             $Dir::Manifest::VERSION = '0.4.0';
3 1     1   70510 use strict;
  1         10  
  1         29  
4 1     1   5 use warnings;
  1         2  
  1         24  
5              
6 1     1   23 use 5.014;
  1         3  
7              
8 1     1   818 use Path::Tiny qw/ path /;
  1         13594  
  1         65  
9 1     1   512 use Dir::Manifest::Key ();
  1         4  
  1         28  
10 1     1   470 use Dir::Manifest::Slurp ();
  1         3  
  1         22  
11              
12 1     1   7 use Moo;
  1         2  
  1         5  
13              
14             has 'manifest_fn' => ( is => 'ro', required => 1 );
15             has 'dir' => ( is => 'ro', required => 1 );
16              
17             my $ALLOWED = qr/[a-zA-Z0-9_\-\.=]/;
18             my $ALPHAN = qr/[a-zA-Z0-9_]/;
19              
20             sub _is_valid_key
21             {
22 16     16   33 my ( $self, $key ) = @_;
23 16 100       148 if ( $key !~ /\A(?:$ALLOWED)+\z/ )
24             {
25 1         10 die
26             "Invalid characters in key \"$key\"! We only allow A-Z, a-z, 0-9, _, dashes and equal signs.";
27             }
28 15 100       69 if ( $key !~ /\A$ALPHAN/ )
29             {
30 1         12 die qq#Key does not start with an alphanumeric - "$key"!#;
31             }
32 14 100       65 if ( $key !~ /$ALPHAN\z/ )
33             {
34 1         10 die qq#Key does not end with an alphanumeric - "$key"!#;
35             }
36              
37 13         29 return;
38             }
39              
40             has '_keys' => (
41             is => 'ro',
42             lazy => 1,
43             default => sub {
44             my $self = shift;
45              
46             my @lines = path( $self->manifest_fn )->lines( { chomp => 1 } );
47             my $ret = +{};
48              
49             foreach my $l (@lines)
50             {
51             $self->_is_valid_key($l);
52             $ret->{$l} = 1;
53             }
54             return $ret;
55             }
56             );
57              
58             has '_dh' => (
59             is => 'ro',
60             lazy => 1,
61             default => sub {
62             my $self = shift;
63             return path( $self->dir );
64             },
65             );
66              
67             sub get_keys
68             {
69 11     11 1 27168 my ($self) = @_;
70              
71 11         21 return [ sort { $a cmp $b } keys %{ $self->_keys } ];
  23         99  
  11         210  
72             }
73              
74             sub get_obj
75             {
76 18     18 1 39 my ( $self, $key ) = @_;
77              
78 18 100       388 if ( not exists $self->_keys->{$key} )
79             {
80 1         17 die "No such key \"$key\"! Perhaps add it to the manifest.";
81             }
82 17         380 return Dir::Manifest::Key->new(
83             { key => $key, fh => $self->_dh->child($key) } );
84             }
85              
86             sub fh
87             {
88 16     16 1 28 my ( $self, $key ) = @_;
89              
90 16         34 return $self->get_obj($key)->fh;
91             }
92              
93             sub text
94             {
95 14     14 1 2354 my ( $self, $key, $opts ) = @_;
96              
97 14         34 return Dir::Manifest::Slurp::slurp( $self->fh($key), $opts );
98             }
99              
100             sub texts_dictionary
101             {
102 4     4 1 1876 my ( $self, $args ) = @_;
103              
104 4         7 my $opts = $args->{slurp_opts};
105              
106 4         9 return +{ map { $_ => $self->text( $_, $opts ) } @{ $self->get_keys } };
  13         40  
  4         10  
107             }
108              
109             sub _update_disk_manifest
110             {
111 2     2   4 my $self = shift;
112              
113 2         10 path( $self->manifest_fn )->spew_raw( map { "$_\n" } @{ $self->get_keys } );
  7         21  
  2         57  
114              
115 2         832 return;
116             }
117              
118             sub add_key
119             {
120 1     1 1 3 my ( $self, $args ) = @_;
121              
122 1         3 my $key = $args->{key};
123 1         3 my $utf8_val = $args->{utf8_val};
124              
125 1 50       25 if ( exists $self->_keys->{$key} )
126             {
127 0         0 die "Key \"$key\" already exists in the dictionary!";
128             }
129              
130 1         13 $self->_is_valid_key($key);
131              
132 1         17 $self->_keys->{$key} = 1;
133              
134 1         16 $self->_update_disk_manifest;
135 1         5 $self->fh($key)->spew_utf8($utf8_val);
136              
137 1         457 return;
138             }
139              
140             sub remove_key
141             {
142 1     1 1 808 my ( $self, $args ) = @_;
143              
144 1         4 my $key = $args->{key};
145              
146 1 50       25 if ( not exists $self->_keys->{$key} )
147             {
148 0         0 die "Key \"$key\" does not exist in the dictionary!";
149             }
150              
151 1         13 $self->fh($key)->remove;
152 1         201 delete $self->_keys->{$key};
153 1         11 $self->_update_disk_manifest;
154              
155 1         4 return;
156             }
157              
158             1;
159              
160             __END__