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::QueueJob::VerifyAndUpload; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our $VERSION = '1.114_2'; |
24
|
|
|
|
|
|
|
|
25
|
3
|
|
|
3
|
|
724
|
use strict; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
81
|
|
26
|
3
|
|
|
3
|
|
36
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
206
|
|
27
|
3
|
|
|
3
|
|
14
|
use Carp; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
151
|
|
28
|
|
|
|
|
|
|
|
29
|
3
|
|
|
3
|
|
14
|
use App::MtAws::QueueJobResult; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
179
|
|
30
|
3
|
|
|
3
|
|
1431
|
use App::MtAws::QueueJob::Verify; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
77
|
|
31
|
3
|
|
|
3
|
|
1103
|
use App::MtAws::QueueJob::Upload; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
149
|
|
32
|
3
|
|
|
3
|
|
11
|
use base 'App::MtAws::QueueJob'; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
954
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub init |
35
|
|
|
|
|
|
|
{ |
36
|
22
|
|
|
22
|
0
|
35
|
my ($self) = @_; |
37
|
22
|
100
|
|
|
|
203
|
defined($self->{filename})||confess "no filename"; |
38
|
21
|
100
|
|
|
|
177
|
defined($self->{relfilename}) || confess "no relfilename"; |
39
|
20
|
100
|
|
|
|
297
|
defined($self->{delete_after_upload}) || confess "delete_after_upload must be defined"; |
40
|
19
|
100
|
|
|
|
164
|
$self->{partsize}||confess; |
41
|
18
|
100
|
|
|
|
170
|
$self->{treehash}||confess; |
42
|
17
|
100
|
|
|
|
46
|
if ($self->{delete_after_upload}) { |
43
|
12
|
100
|
|
|
|
160
|
confess "archive_id must present if you're deleting" unless $self->{archive_id}; |
44
|
|
|
|
|
|
|
} else { |
45
|
5
|
50
|
|
|
|
15
|
confess "archive_id not needed here" if $self->{archive_id}; |
46
|
|
|
|
|
|
|
} |
47
|
16
|
|
|
|
|
56
|
$self->enter("verify"); |
48
|
16
|
|
|
|
|
24
|
return $self; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub on_verify |
53
|
|
|
|
|
|
|
{ |
54
|
8
|
|
|
8
|
0
|
14
|
my ($self) = @_; |
55
|
|
|
|
|
|
|
return |
56
|
|
|
|
|
|
|
state("wait"), |
57
|
24
|
|
|
|
|
78
|
job( App::MtAws::QueueJob::Verify->new( map { $_ => $self->{$_} } qw/filename relfilename treehash/ ), sub { |
58
|
8
|
|
|
8
|
|
15
|
my $j = shift; |
59
|
8
|
50
|
|
|
|
24
|
confess unless defined $j->{match}; |
60
|
8
|
100
|
|
|
|
36
|
$j->{match} ? state("done") : state("upload"); |
61
|
8
|
|
|
|
|
25
|
}); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub on_upload |
66
|
|
|
|
|
|
|
{ |
67
|
4
|
|
|
4
|
0
|
10
|
my ($self) = @_; |
68
|
|
|
|
|
|
|
return |
69
|
|
|
|
|
|
|
state("wait"), |
70
|
20
|
|
|
|
|
61
|
job( App::MtAws::QueueJob::Upload->new(map { $_ => $self->{$_} } qw/filename relfilename partsize delete_after_upload archive_id/), sub { # archive_id can be undef |
71
|
4
|
|
|
4
|
|
24
|
state("done"); |
72
|
4
|
|
|
|
|
11
|
}); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub will_do |
76
|
|
|
|
|
|
|
{ |
77
|
1
|
|
|
1
|
0
|
5
|
my ($self) = @_; |
78
|
1
|
|
|
|
|
9
|
"Will VERIFY treehash and UPLOAD $self->{filename} if modified"; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
1; |