File Coverage

blib/lib/Digest/MultiHash.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Digest::MultiHash;
4 1     1   1426060 use Moose;
  0            
  0            
5              
6             extends our @ISA, qw(Digest::base);
7              
8             use Carp qw/croak/;
9              
10             use Digest;
11             use Digest::MoreFallbacks;
12             use Scalar::Util qw/blessed/;
13              
14             use namespace::clean -except => [qw(meta)];
15              
16             has width => (
17             isa => "Int",
18             is => "rw",
19             );
20              
21             has hashes => (
22             isa => "ArrayRef",
23             is => "ro",
24             required => 1,
25             default => sub { [qw(SHA-1)] },
26             );
27              
28             has _digest_objects => (
29             isa => "ArrayRef",
30             is => "ro",
31             lazy_build => 1,
32             );
33              
34             sub BUILD {
35             shift->_digest_objects; # force building
36             }
37              
38             sub _call {
39             my ( $self, $method, @args ) = @_;
40             map { $_->$method( @args ) } @{ $self->_digest_objects };
41             }
42              
43             sub _build__digest_objects {
44             my $self = shift;
45              
46             my @digests = map {
47             blessed($_)
48             ? $_
49             : Digest->new(
50             ((ref($_)||'') eq "ARRAY")
51             ? @$_
52             : $_
53             )
54             } @{ $self->hashes };
55              
56             die "No digest module specified" unless @digests;
57              
58             return \@digests;
59             }
60              
61             # MooseX::Clone
62             sub clone {
63             my $self = shift;
64              
65             $self->new(
66             width => $self->width,
67             hashes => $self->hashes,
68             _digest_objects => [ $self->_call("clone") ],
69             );
70             }
71              
72             sub add {
73             my ( $self, @args ) = @_;
74             $self->_call("add", @args);
75             }
76              
77             sub digest {
78             my $self = shift;
79              
80             my @digests = $self->_call("digest");
81            
82             my $width = $self->width || length($digests[0]);
83              
84             my $concat = join "", @digests;
85            
86             die "Chosen hashes are insufficient for desired width" if length($concat) < $width;
87              
88             my ( $buf, @pieces ) = unpack "(a$width)*", $concat;
89              
90             $buf ^= $_ for @pieces;
91              
92             return $buf;
93             }
94              
95             __PACKAGE__;
96              
97             __END__
98              
99             =pod
100              
101             =head1 NAME
102              
103             Digest::MultiHash - XOR based, variable width multiplexing of hashes (a
104             generalized Digest::SV1).
105              
106             =head1 SYNOPSIS
107              
108             use Digest::MultiHash;
109              
110             my $d = Digest::Multihash->new(
111             width => 16, # bytes
112             hashs => ["SHA-512", "Whirlpool"], # see below for arbitrary arguments
113             );
114              
115             $d->add($data);
116              
117             print $d->hexdigest;
118              
119             =head1 DESCRIPTION
120              
121             This class inherits from L<Digest::base>, and provides generalized digest
122             multiplexing.
123              
124             It will multiplex all calls to C<add> to all of it's sub digest objects.
125             Likewise, when the final digest is extracted the digests will be extracted and
126             then XOR'd over eachother according to C<width>.
127              
128             C<width> will default to the width of the first hash if unspecified.
129              
130             C<hashes> defaults to C<SHA-1> for compatibility reasons.
131              
132             This module is useful for generating keys from passphrases, by supplying the
133             desired width and simply making sure there is enough data from the combined
134             hashes.
135              
136             =head1 METHODS
137              
138             See L<Digest> for the complete API. This module inherits from L<Digest::base>.
139              
140             =over 4
141              
142             =item new
143              
144             This methods accepts a hash reference or an even sized list of parameters named
145             according to the methods.
146              
147             =item add
148              
149             =item digest
150              
151             Compute the hash by calling C<digest> on all of the subhashes, splitting the
152             result up into C<width> sized chunk, and then XORing these together.
153              
154             If the result is not aligned on C<width> the result will not be truncated. The
155             shorter string will still be XOR'd with the hash, even if this only affects
156             part of the result.
157              
158             If there are not at least C<width> bytes of data in the output of the combined
159             hashes an error is thrown.
160              
161             =item clone
162              
163             Clones the hash.
164              
165             =item hashes
166              
167             Get the array of hashes to use. Array values in this will be dereferenced
168             before the call to L<Digest/new> to allow passing of arbitrary arguments.
169             Blessed objects (of any class) will be used verbatim.
170              
171             The list of hashes cannot be changed after construction.
172              
173             =item width
174              
175             Get/set the byte-width to use.
176              
177             =back
178              
179             =head1 SEE ALSO
180              
181             L<Digest>, L<Digest::SV1>, L<Digest::SHA1>
182              
183             =cut
184              
185