File Coverage

blib/lib/File/Copy/Verify.pm
Criterion Covered Total %
statement 36 42 85.7
branch 14 16 87.5
condition n/a
subroutine 8 9 88.8
pod 2 3 66.6
total 60 70 85.7


line stmt bran cond sub pod time code
1             package File::Copy::Verify;
2 2     2   989 use strict;
  2         2  
  2         47  
3 2     2   5 use warnings;
  2         4  
  2         68  
4              
5             our $VERSION = '0.1.0';
6              
7 2     2   700 use Path::Tiny;
  2         7754  
  2         81  
8 2     2   770 use Safe::Isa;
  2         653  
  2         213  
9 2         11 use Class::Tiny qw(src dst src_hash dst_hash), {
10             hash_algo => 'MD5',
11             keep_invalid => 0,
12 2     2   824 };
  2         4490  
13              
14 2     2   1886 use parent 'Exporter';
  2         438  
  2         8  
15             our @EXPORT_OK = qw(verify_copy copy cp verify_move move mv);
16              
17             =head1 NAME
18              
19             File::Copy::Verify - data-safe copy
20              
21             =head1 SYNOPSIS
22              
23             use File::Copy::Verify qw(verify_copy);
24             use Try::Tiny::Retry;
25              
26             retry {
27             verify_copy('a', 'b'); #or copy or cp - all variants are exportable
28             };
29              
30             #OOP equivalent:
31              
32             $verify_copy = File::Copy::Verify->new(
33             src => 'a',
34             dst => 'b',
35             );
36             retry {
37             $verify_copy->copy();
38             };
39              
40              
41             #I know source SHA-256 hash and I can use for validation
42            
43             retry {
44             File::Copy::Verify::copy('a', 'b', {src_hash => '0'x64, hash_algo => 'SHA-256'});
45             };
46              
47             #OOP equivalent
48            
49             $verify_copy = File::Copy::Verify->new(
50             src => 'a',
51             src_hash => '0' x 64,
52             dst => 'b',
53             hash_algo => 'SHA-256',
54             );
55             retry {
56             $verify_copy->copy();
57             };
58              
59             =head1 DESCRIPTION
60              
61             This module calculates hash before and after copying and if the hash doesn't match, then dies. I recommend Try::Tiny::Retry module for copy retry mechanism.
62             This module is useful for network storages/filesystems, but it is harmful for local storages/filesystems because of overhead. The `verified_copy` function is at least 3 times slower then standard `copy`!
63              
64             File::Copy::Verify is module for verifying copy. Some storages (in particular net storages) can have troubles with valid copy and C function from L doesn't find this problems (like random buffers in copied file).
65              
66             This module calculates hash before and after copying and if hash doesn't match, then dies. I recommend L module for copy retry mechanism.
67              
68             This module is useful for network storages/filesystems, but it is harmful for localstorages/filesystems because of overhead. The Cfunction is at least 3 times slower then standard C!
69              
70             =head1 METHODS
71              
72             =head2 new(%attributes)
73              
74             =head3 %attributes
75              
76             =head4 src
77              
78             source path
79              
80             =head4 dst
81              
82             destination path
83              
84             =head4 hash_algo
85              
86             digest alghoritm used for check
87              
88             default is fast I
89              
90             more about L
91              
92             =head4 src_hash
93              
94             manualy set source hash
95              
96             this is usefully if I know source hash (doesn't calculate again)
97              
98             =head4 dst_hash
99              
100             manualy set destination hash
101              
102             this is usefully if I know destination hash (doesn't calculate again)
103              
104             =head4 keep_invalid
105              
106             If is file invalid (means hash-check failed), C is removed.
107              
108             This decreases potentional problems with bad-copied files.
109              
110             If you need keep this bad file anyway. Or for debugging. Use this option.
111              
112             =cut
113              
114             sub BUILD {
115 7     7 0 1076 my ($self) = @_;
116              
117             #coerce src and dst to Path::Tiny object
118 7 100       151 if (!$self->src->$_isa('Path::Tiny')) {
119 1         33 $self->src(path($self->src));
120             }
121              
122 7 100       191 if (!$self->dst->$_isa('Path::Tiny')) {
123 2         50 $self->dst(path($self->dst));
124             }
125             }
126              
127             =head2 copy()
128              
129             =cut
130              
131             sub copy {
132 12     12 1 24761 my ($self) = @_;
133              
134 12 100       24 if (!$self->$_isa(__PACKAGE__)) {
135 6         74 my ($src, $dst, $options) = @_;
136              
137 6         24 return __PACKAGE__->new(
138             src => $src,
139             dst => $dst,
140             %$options
141             )->copy();
142             }
143              
144 6 100       119 if (!defined $self->src_hash) {
145 3         47 $self->src_hash(
146             $self->src->digest($self->hash_algo)
147             );
148             }
149              
150 6         1443 my $dst = $self->src->copy($self->dst);
151              
152 6 100       4001 if (!defined $self->dst_hash) {
153 3         62 $self->dst_hash(
154             $dst->digest($self->hash_algo)
155             );
156             }
157              
158 6 100       530 if ( uc $self->src_hash ne uc $self->dst_hash ) {
159 2 100       59 if (!$self->keep_invalid) {
160 1         8 $dst->remove();
161             }
162              
163 2         85 die sprintf "Src (%s) hash (%s) and dst (%s) hash (%s) isn't equal",
164             $self->src,
165             $self->src_hash,
166             $dst,
167             $self->dst_hash;
168             }
169             }
170              
171             =head2 move()
172              
173             =cut
174             sub move {
175 0     0 1   my ($self) = @_;
176              
177 0 0         if (!$self->$_isa(__PACKAGE__)) {
178 0           my ($src, $dst, $options) = @_;
179              
180 0           return __PACKAGE__->new(
181             src => $src,
182             dst => $dst,
183             %$options
184             )->move();
185             }
186              
187 0           $self->copy();
188 0           $self->src->remove();
189             }
190              
191             =head1 FUNCTIONS
192              
193             =head2 verify_copy($src, $dst, $options)
194              
195             C<$options> - same parameters (except C and C) like in constructor L
196              
197             =cut
198              
199             sub verify_copy;
200             *verify_copy = \©
201              
202             =head2 copy
203              
204             alias for L
205              
206             =head2 cp
207              
208             alias for L
209              
210             =cut
211              
212             sub cp;
213             *cp = \©
214              
215             =head2 verify_move($src, $dst, $options)
216              
217             same as L and after success copy remove source C<$src> file
218              
219             =cut
220              
221             sub verify_move;
222             *verify_move = \&move;
223              
224             =head2 move
225              
226             alias for L
227              
228             =head2 mv
229              
230             alias for L
231              
232             =cut
233              
234             sub mv;
235             *mv = \&move;
236              
237             =head1 SEE ALSO
238              
239             L - Looks really good, don't support other digests - only MD5, don't support hard-set src or dst hash. Support retry mechanism by default.
240              
241             L - only "checks that the file size of the copied or moved file is the same as the source".
242              
243             =head1 LICENSE
244              
245             Copyright (C) Jan Seidl.
246              
247             This library is free software; you can redistribute it and/or modify
248             it under the same terms as Perl itself.
249              
250             =head1 AUTHOR
251              
252             Jan Seidl Eseidl@avast.comE
253              
254             =cut
255              
256             1;