File Coverage

lib/App/MtAws/Command/Sync.pm
Criterion Covered Total %
statement 121 121 100.0
branch 55 58 94.8
condition 3 3 100.0
subroutine 24 24 100.0
pod 0 8 0.0
total 203 214 94.8


line stmt bran cond sub pod time code
1             # mt-aws-glacier - Amazon Glacier sync client
2             # Copyright (C) 2012-2014 Victor Efimov
3             # http://mt-aws.com (also http://vs-dev.com) vs@vs-dev.com
4             # License: GPLv3
5             #
6             # This file is part of "mt-aws-glacier"
7             #
8             # mt-aws-glacier is free software: you can redistribute it and/or modify
9             # it under the terms of the GNU General Public License as published by
10             # the Free Software Foundation, either version 3 of the License, or
11             # (at your option) any later version.
12             #
13             # mt-aws-glacier is distributed in the hope that it will be useful,
14             # but WITHOUT ANY WARRANTY; without even the implied warranty of
15             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16             # GNU General Public License for more details.
17             #
18             # You should have received a copy of the GNU General Public License
19             # along with this program. If not, see <http://www.gnu.org/licenses/>.
20              
21             package App::MtAws::Command::Sync;
22              
23             our $VERSION = '1.114_2';
24              
25 2     2   962 use strict;
  2         3  
  2         65  
26 2     2   9 use warnings;
  2         2  
  2         60  
27 2     2   8 use utf8;
  2         3  
  2         14  
28 2     2   38 use Carp;
  2         2  
  2         186  
29 2     2   8 use constant ONE_MB => 1024*1024;
  2         3  
  2         139  
30              
31 2     2   7 use constant SHOULD_CREATE => 1;
  2         2  
  2         89  
32 2     2   8 use constant SHOULD_TREEHASH => 2;
  2         3  
  2         76  
33 2     2   6 use constant SHOULD_NOACTION => 0;
  2         2  
  2         74  
34              
35 2     2   407 use App::MtAws::QueueJob::Iterator;
  2         4  
  2         51  
36 2     2   796 use App::MtAws::QueueJob::VerifyAndUpload;
  2         4  
  2         47  
37 2     2   9 use App::MtAws::QueueJob::Upload;
  2         2  
  2         26  
38 2     2   7 use App::MtAws::QueueJob::Delete;
  2         2  
  2         37  
39              
40 2     2   387 use App::MtAws::ForkEngine qw/with_forks fork_engine/;
  2         3  
  2         105  
41 2     2   9 use App::MtAws::Journal;
  2         2  
  2         35  
42 2     2   6 use App::MtAws::Utils;
  2         4  
  2         1919  
43              
44              
45              
46             sub is_mtime_differs
47             {
48 10     10 0 6098 my ($options, $journal_file, $absfilename) = @_;
49             my $mtime_differs = $options->{detect} =~ /(^|[-_])mtime([-_]|$)/ ? # don't make stat() call if we don't need it
50             defined($journal_file->{mtime}) && file_mtime($absfilename) != $journal_file->{mtime} :
51 10 100 100     86 undef;
52             }
53              
54             # implements a '--detect' logic for file (with check of file size and mtime)
55             # returns:
56             # SHOULD_CREATE - upload file
57             # SHOULD_TREEHASH - upload a file if treehash differs
58             # SHOULD_NOACTION - don't do anything
59             sub should_upload
60             {
61 20     20 0 13844 my ($options, $journal_file, $absfilename) = @_;
62              
63 20 100       100 if ($options->{detect} eq 'always-positive') {
    100          
    100          
    100          
    100          
    100          
    100          
64 1         3 SHOULD_CREATE;
65             } elsif ($journal_file->{size} != file_size($absfilename)) {
66 10         1438 SHOULD_CREATE;
67             } elsif ($options->{detect} eq 'size-only') {
68 1         1112 SHOULD_NOACTION; # we already checked size above, so NOACTION
69             } elsif ($options->{detect} eq 'mtime') {
70 2 100       11334 is_mtime_differs($options, $journal_file, $absfilename) ? SHOULD_CREATE : SHOULD_NOACTION;
71             } elsif ($options->{detect} eq 'treehash') {
72 1         1216 SHOULD_TREEHASH;
73             } elsif ($options->{detect} eq 'mtime-and-treehash') {
74 2 100       2138 is_mtime_differs($options, $journal_file, $absfilename) ? SHOULD_TREEHASH : SHOULD_NOACTION;
75             } elsif ($options->{detect} eq 'mtime-or-treehash') {
76 2 100       2289 is_mtime_differs($options, $journal_file, $absfilename) ? SHOULD_CREATE : SHOULD_TREEHASH;
77             } else {
78 1         218 confess "Invalid detect option in should_upload";
79             }
80             }
81              
82             sub next_modified
83             {
84 16     16 0 6370 my ($options, $j) = @_;
85 16         27 while (my $rec = shift @{ $j->{listing}{existing} }) {
  25         114  
86 21         49 my $relfilename = $rec->{relfilename};
87 21         81 my $absfilename = $j->absfilename($relfilename);
88 21         69 my $file = $j->latest($relfilename);
89              
90 21         619 my $should_upload = should_upload($options, $file, $absfilename);
91              
92 21 100       344 if ($should_upload == SHOULD_TREEHASH) {
    100          
    100          
93             return App::MtAws::QueueJob::VerifyAndUpload->new(
94             filename => $absfilename, relfilename => $relfilename, partsize => ONE_MB*$options->{partsize},
95             delete_after_upload => 1,
96             archive_id => $file->{archive_id},
97             treehash => $file->{treehash}
98 3         34 );
99             } elsif ($should_upload == SHOULD_CREATE) {
100             return App::MtAws::QueueJob::Upload->new(
101             filename => $absfilename, relfilename => $relfilename, partsize => ONE_MB*$options->{partsize},
102             delete_after_upload => 1,
103             archive_id => $file->{archive_id},
104 8         81 );
105             } elsif ($should_upload == SHOULD_NOACTION) {
106 9         16 next;
107             } else {
108 1         238 confess "Unknown value returned by should_upload";
109             }
110             }
111 4         20 return;
112             }
113              
114             sub next_missing
115             {
116 11     11 0 3763 my ($options, $j) = @_;
117 11 100       15 if (my $rec = shift @{ $j->{listing}{missing} }) {
  11         46  
118             return App::MtAws::QueueJob::Delete->new(
119             relfilename => $rec->{relfilename},
120             archive_id => $j->latest($rec->{relfilename})->{archive_id},
121 9         35 );
122             } else {
123 2         8 return;
124             }
125             }
126              
127             sub next_new
128             {
129 9     9 0 1991 my ($options, $j) = @_;
130 9 100       13 if (my $rec = shift @{ $j->{listing}{new} }) {
  9         39  
131 7         38 my ($absfilename, $relfilename) = ($j->absfilename($rec->{relfilename}), $rec->{relfilename});
132 7         55 App::MtAws::QueueJob::Upload->new(filename => $absfilename, relfilename => $relfilename, partsize => ONE_MB*$options->{partsize}, delete_after_upload => 0);
133             } else {
134 2         9 return;
135             }
136             }
137              
138             sub print_dry_run
139             {
140 7     7 0 3771 my ($itt) = @_;
141 7         16 while (my $rec = $itt->()) {
142 8         53 for ($rec->will_do()) {
143 10         93 print $_, "\n";
144             }
145             }
146             }
147              
148             sub get_journal_opts
149             {
150 43     43 0 27209 my ($options) = @_;
151             return {
152             $options->{'new'} ? ('new' => 1) : (),
153             $options->{'replace-modified'} ? ('existing' => 1) : (),
154 43 100       417 $options->{'delete-removed'} ? ('missing' => 1) : (),
    100          
    100          
155             };
156             }
157              
158             sub run
159             {
160 19     19 0 16185 my ($options, $j) = @_;
161             with_forks !$options->{'dry-run'}, $options, sub {
162 19     19   32100 $j->read_journal(should_exist => 0); # TODO: what about case when --new is missing?
163              
164 19         42010 my $read_journal_opts = get_journal_opts($options);
165              
166 19         119 $j->read_files($read_journal_opts, $options->{'max-number-of-files'}); # TODO: sometimes read only 'new' files
167              
168 19         45418 $j->open_for_write();
169 19         11266 my @joblist;
170              
171 19 100       97 if ($options->{new}) {
172 9         56 my $itt = sub { next_new($options, $j) };
  12         8036  
173 9 100       36 if ($options->{'dry-run'}) {
174 4         17 print_dry_run($itt);
175             } else {
176 5         50 push @joblist, App::MtAws::QueueJob::Iterator->new(iterator => $itt);
177             }
178             }
179              
180 19 100       155 if ($options->{'replace-modified'}) {
181 9 50       43 confess unless $options->{detect};
182 9         52 my $itt = sub { next_modified($options, $j) };
  12         9281  
183 9 100       29 if ($options->{'dry-run'}) {
184 4         17 print_dry_run($itt);
185             } else {
186 5         29 push @joblist, App::MtAws::QueueJob::Iterator->new(iterator => $itt);
187             }
188             }
189 19 100       146 if ($options->{'delete-removed'}) {
190 9         46 my $itt = sub { next_missing($options, $j) };
  12         5831  
191 9 100       31 if ($options->{'dry-run'}) {
192 4         12 print_dry_run($itt);
193             } else {
194 5         23 push @joblist, App::MtAws::QueueJob::Iterator->new(iterator => $itt);
195             }
196             }
197              
198 19 100       122 if (scalar @joblist) {
199 10         16 my $lt = do {
200 10 50       420 confess unless @joblist >= 1;
201 10         60 App::MtAws::QueueJob::Iterator->new(iterator => sub { shift @joblist });
  22         22020  
202             };
203 10         40 my ($R) = fork_engine->{parent_worker}->process_task($lt, $j);
204 10 50       13042 confess unless $R;
205             }
206 19         126 $j->close_for_write();
207             }
208 19         192 }
209              
210              
211             1;
212              
213             __END__