File Coverage

blib/lib/Net/Amazon/TreeHash.pm
Criterion Covered Total %
statement 49 56 87.5
branch 2 6 33.3
condition 4 4 100.0
subroutine 8 9 88.8
pod 0 5 0.0
total 63 80 78.7


line stmt bran cond sub pod time code
1             # mt-aws-glacier - AWS Glacier sync client
2             # Copyright (C) 2012 Victor Efimov
3             # vs@vs-dev.com http://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 .
20              
21              
22             package Net::Amazon::TreeHash;
23              
24              
25              
26 1     1   31189 use strict;
  1         4  
  1         50  
27 1     1   6 use warnings;
  1         2  
  1         41  
28 1     1   1357 use Digest::SHA qw/sha256/;
  1         4426  
  1         654  
29              
30             =head1 NAME
31              
32             Net::Amazon::TreeHash - An implementation of the Amazon AWS TreeHash checksum algorithm
33              
34             =head1 VERSION
35              
36             Version 0.71
37              
38             =cut
39              
40             our $VERSION = '0.71';
41              
42             =head1 SYNOPSIS
43              
44             This module implements TreeHash algorithm for Amazon AWS Glacier API (version 2012-06-01)
45              
46             Usage:
47              
48             use Net::Amazon::TreeHash;
49              
50             my $th = Net::Amazon::TreeHash->new();
51            
52             $th->eat_data(\$mydata);
53             ...
54            
55             $th->calc_tree();
56             my $hash = $th->get_final_hash();
57              
58             =head1 NOT IMPLEMENTED
59              
60             A function to get hash of the part of data (such function would be usefull for Glacier multipart upload)
61              
62             =head1 SEE ALSO
63              
64             An application for AWS Glacier synchronization. It is available at L.
65              
66             =head1 AUTHOR
67              
68             Victor Efimov C<< >>
69              
70             https://github.com/vsespb/mt-aws-glacier
71              
72             =head1 BUGS
73              
74             Does not work for 0-length files (however it's useless for Glacier).
75              
76             =cut
77              
78              
79             sub new
80             {
81 229     229 0 12102481 my ($class, %args) = @_;
82 229         385 my $self = \%args;
83 229         487 $self->{tree} = [];
84 229         388 $self->{pending} = {};
85 229   100     787 $self->{unit} ||= 1048576;
86 229         344 $self->{processed_size} = 0; # MB
87 229         496 bless $self, $class;
88 229         524 return $self;
89             }
90              
91              
92             sub eat_file
93             {
94 0     0 0 0 my ($self, $fh) = @_;
95 0         0 while (1) {
96 0         0 my $r = sysread($fh, my $data, $self->{unit});
97 0 0       0 if (!defined($r)) {
    0          
98 0         0 die;
99             } elsif ($r > 0) {
100 0         0 $self->_eat_data_one_mb(\$data);
101             } else {
102 0         0 return;
103             }
104             }
105             }
106              
107             sub eat_data
108             {
109 229     229 0 777 my ($self, $dataref) = @_;
110 229         379 my $mb = $self->{unit};
111 229         334 my $n = length($$dataref);
112 229         232 my $i = 0;
113 229         482 while ($i < $n) {
114 3599         26658 my $part = substr($$dataref, $i, $mb);
115 3599         7088 $self->_eat_data_one_mb(\$part);
116 3599         8067 $i += $mb
117             }
118             }
119              
120              
121             sub _eat_data_one_mb
122             {
123 3599     3599   4353 my ($self, $dataref) = @_;
124 3599   100     7947 $self->{tree}->[0] ||= [];
125 3599         3378 push @{ $self->{tree}->[0] }, { joined => 0, start => $self->{processed_size}, finish => $self->{processed_size}, hash => sha256($$dataref) };
  3599         318168  
126 3599         6827 $self->{processed_size}++;
127             }
128              
129             sub calc_tree
130             {
131 229     229 0 726 my ($self) = @_;
132 229         266 my $prev_level = 0;
133 229         254 while (scalar @{ $self->{tree}->[$prev_level] } > 1) {
  1130         2916  
134 901         1095 my $curr_level = $prev_level+1;
135 901         1535 $self->{tree}->[$curr_level] = [];
136            
137 901         1204 my $prev_tree = $self->{tree}->[$prev_level];
138 901         1115 my $curr_tree = $self->{tree}->[$curr_level];
139 901         910 my $len = scalar @$prev_tree;
140 901         1686 for (my $i = 0; $i < $len; $i += 2) {
141 3718 100       6621 if ($len - $i > 1) {
142 3370         3714 my $a = $prev_tree->[$i];
143 3370         3747 my $b = $prev_tree->[$i+1];
144 3370         33631 push @$curr_tree, { joined => 0, start => $a->{start}, finish => $b->{finish}, hash => sha256( $a->{hash}.$b->{hash} ) };
145             } else {
146 348         956 push @$curr_tree, $prev_tree->[$i];
147             }
148             }
149            
150 901         1300 $prev_level = $curr_level;
151             }
152             }
153              
154              
155             sub get_final_hash
156             {
157 229     229 0 775 my ($self) = @_;
158 229         303 return unpack('H*', $self->{tree}->[ $#{$self->{tree}} ]->[0]->{hash} );
  229         1609  
159             }
160              
161              
162             1;