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