File Coverage

blib/lib/Catalyst/Controller/SimpleCAS/Store/File.pm
Criterion Covered Total %
statement 56 84 66.6
branch 7 26 26.9
condition 2 3 66.6
subroutine 15 20 75.0
pod 8 8 100.0
total 88 141 62.4


line stmt bran cond sub pod time code
1             package Catalyst::Controller::SimpleCAS::Store::File;
2              
3 2     2   1391 use warnings;
  2         3  
  2         59  
4 2     2   422 use Moose;
  2         301542  
  2         10  
5              
6             with qw(
7             Catalyst::Controller::SimpleCAS::Store
8             );
9              
10 2     2   9219 use Data::Dumper;
  2         4973  
  2         90  
11 2     2   9 use IO::File;
  2         2  
  2         236  
12 2     2   9 use Try::Tiny;
  2         2  
  2         81  
13 2     2   9 use File::Spec::Functions 'catdir', 'catfile';
  2         1  
  2         93  
14 2     2   8 use Path::Class qw( file dir );
  2         2  
  2         63  
15 2     2   422 use IO::All;
  2         7761  
  2         12  
16 2     2   1069 use File::Copy 'move';
  2         3053  
  2         919  
17              
18             has 'store_dir' => ( is => 'ro', isa => 'Str', required => 1 );
19              
20             sub init_store_dir {
21 4     4 1 2 my $self = shift;
22 4 50       144 return if (-d $self->store_dir);
23 0 0       0 mkdir $self->store_dir or die "Failed to create directory: " . $self->store_dir;
24             }
25              
26             sub add_content {
27 0     0 1 0 my $self = shift;
28 0         0 my $data = shift;
29            
30 0         0 $self->init_store_dir;
31            
32 0         0 my $checksum = $self->calculate_checksum($data);
33 0 0       0 return $checksum if ($self->content_exists($checksum));
34            
35 0         0 my $save_path = $self->checksum_to_path($checksum,1);
36 0 0       0 my $fd= IO::File->new($save_path, '>:raw') or die $!;
37 0         0 $fd->write($data);
38 0         0 $fd->close;
39 0         0 return $checksum;
40             }
41              
42             sub add_content_file {
43 0     0 1 0 my $self = shift;
44 0         0 my $file = shift;
45            
46 0         0 $self->init_store_dir;
47            
48 0         0 my $checksum = $self->file_checksum($file);
49 0 0       0 return $checksum if ($self->content_exists($checksum));
50            
51 0         0 my $save_path = $self->checksum_to_path($checksum,1);
52            
53             try {
54             # This is cleaner, but will fail for various reasons like source/dest
55             # on different file systems:
56 0 0   0   0 link $file, $save_path or die "Failed to create hard link: '$file' -> '$save_path'";
57             }
58             catch {
59 0 0   0   0 move($file, $save_path)
60             or die "SimpleCAS: Failed to move file '$file' -> '$save_path': $!";
61 0         0 };
62            
63 0         0 return $checksum;
64             }
65              
66             sub split_checksum {
67 3     3 1 4 my $self = shift;
68 3         2 my $checksum = shift;
69              
70 3         8 return ( substr($checksum,0,2), substr($checksum,2) );
71             }
72              
73             sub add_content_file_mv {
74 1     1 1 2811 my $self = shift;
75 1         1 my $file = shift;
76            
77 1         3 $self->init_store_dir;
78            
79 1         4 my $checksum = $self->file_checksum($file);
80 1 50       3 if ($self->content_exists($checksum)) {
81 0         0 unlink $file;
82 0         0 return $checksum;
83             }
84            
85 1         2 my $save_path = $self->checksum_to_path($checksum,1);
86 1 50       4 move($file, $save_path)
87             or die "SimpleCAS: Failed to move file '$file' -> '$save_path'";
88            
89 1         136 return $checksum;
90             }
91              
92             sub checksum_to_path {
93 3     3 1 404 my $self = shift;
94 3         3 my $checksum = shift;
95 3         3 my $init = shift;
96            
97 3         5 $self->init_store_dir;
98            
99 3         6 my ($d, $f) = $self->split_checksum($checksum);
100            
101 3         92 my $dir = catdir($self->store_dir, $d);
102 3 100 66     19 if($init and not -d $dir) {
103 1 50       41 mkdir $dir or die "Failed to create directory: " . $dir;
104             }
105            
106 3         44 return catfile( $dir, $f );
107             }
108              
109             sub fetch_content {
110 0     0 1 0 my $self = shift;
111 0         0 my $checksum = shift;
112            
113 0         0 my $file = $self->checksum_to_path($checksum);
114 0 0       0 return undef unless ( -f $file);
115            
116 0         0 return io($file)->slurp;
117             }
118              
119             sub content_exists {
120 1     1 1 2 my $self = shift;
121 1         2 my $checksum = shift;
122            
123 1 50       2 return 1 if ( -f $self->checksum_to_path($checksum) );
124 1         3 return 0;
125             }
126              
127             #### --------------------- ####
128              
129 2     2   11 no Moose;
  2         3  
  2         23  
130             #__PACKAGE__->meta->make_immutable;
131             1;
132              
133             __END__
134              
135             =head1 NAME
136              
137             Catalyst::Controller::SimpleCAS::Store::File - Standard file-based Store for SimpleCAS
138              
139             =head1 SYNOPSIS
140              
141             use Catalyst::Controller::SimpleCAS;
142             ...
143              
144             =head1 DESCRIPTION
145              
146             This is the main "Store" object class used by L<Catalyst::Controller::SimpleCAS> for
147             persisting/storing arbitrary pieces of content on disk according to their CAS (content-addressed
148             storage) name/address, in this case, standard 40 character SHA1 hex strings (160-bit). This is
149             the same thing that Git does, which was the original inspiration for the SimpleCAS module.
150              
151             Currently, this is the only Store class, but others could be implemented and the system was
152             designed with this in mind (i.e. a DBIC-based store). Also, the implementation need not use the
153             40-char sha1 addresses - any content/checksum system for IDs could be implemented.
154              
155             Also note that an actual Git-based store was partially written, but never finished. See the branch
156             named C<partial_git_store> in the GitHub repository for more info.
157              
158             This class is used internally and should not need to be called directly.
159              
160             =head1 ATTRIBUTES
161              
162             =head2 store_dir
163              
164             Where to store the data. This is the only required option and is a pass-through from the option
165             of the same name in L<Catalyst::Controller::SimpleCAS>.
166              
167             =head1 METHODS
168              
169             =head2 add_content
170              
171             =head2 add_content_base64
172              
173             =head2 add_content_file
174              
175             =head2 add_content_file_mv
176              
177             =head2 calculate_checksum
178              
179             =head2 checksum_to_path
180              
181             =head2 content_exists
182              
183             =head2 content_mimetype
184              
185             =head2 content_size
186              
187             =head2 fetch_content
188              
189             =head2 fetch_content_fh
190              
191             =head2 file_checksum
192              
193             =head2 image_size
194              
195             =head2 init_store_dir
196              
197             =head2 split_checksum
198              
199             =head1 SEE ALSO
200              
201             =over
202              
203             =item *
204              
205             L<Catalyst::Controller::SimpleCAS>
206              
207             =back
208              
209             =head1 AUTHOR
210              
211             Henry Van Styn <vanstyn@cpan.org>
212              
213             =head1 COPYRIGHT AND LICENSE
214              
215             This software is copyright (c) 2014 by IntelliTree Solutions llc.
216              
217             This is free software; you can redistribute it and/or modify it under
218             the same terms as the Perl 5 programming language system itself.
219              
220             =cut