File Coverage

blib/lib/Digest/ED2K.pm
Criterion Covered Total %
statement 46 46 100.0
branch 8 10 80.0
condition 3 6 50.0
subroutine 13 13 100.0
pod 7 7 100.0
total 77 82 93.9


line stmt bran cond sub pod time code
1             package Digest::ED2K;
2 1     1   22166 use common::sense;
  1         3  
  1         6  
3 1     1   913 use Digest::MD4 ();
  1         1010  
  1         26  
4 1     1   6 use Exporter 'import';
  1         6  
  1         46  
5             our @EXPORT_OK = qw(ed2k ed2k_hex ed2k_base64);
6              
7 1     1   5 use Digest::base 1.03;
  1         22  
  1         45  
8 1     1   23 BEGIN { push @Digest::ED2K::ISA, 'Digest::base' }
9              
10 1     1   697 use version 0.77; our $VERSION = version->declare('v1.1');
  1         1926  
  1         5  
11              
12             sub CHUNK_SIZE() { 9728000 }
13              
14             sub new {
15 12     12 1 10122 my $class = shift;
16 12   33     45271 bless {
17             chunk_ctx => Digest::MD4->new,
18             }, ref $class || $class;
19             }
20              
21             sub clone {
22 1     1 1 6 my $self = shift;
23 1 50       27 bless {
24             ($self->{ctx} ? (ctx => $self->{ctx}->clone) : ()),
25             chunk_ctx => $self->{chunk_ctx}->clone,
26             chunk_length => $self->{chunk_length},
27             }, ref($self);
28             }
29              
30             sub add {
31 15 100   15 1 74 return shift->add(join '', @_) if @_ > 2;
32              
33 12         34 my $self = shift;
34              
35             # Adding buffer won't cross chunk border.
36             # Avoid copying.
37 12 100       79 if (CHUNK_SIZE - $self->{chunk_length} > length $_[0]) {
38 10         34 $self->{chunk_ctx}->add($_[0]);
39 10         23 $self->{chunk_length} += length $_[0];
40              
41 10         1037 return $self;
42             }
43              
44             # Buffer crosses chunk border, copy for modification.
45 2         40 my $buffer = shift;
46              
47 2         13 while ($buffer) {
48 3         19 my $need_length = CHUNK_SIZE - $self->{chunk_length};
49              
50 3         54090 my $substr = substr $buffer, 0, $need_length;
51 3         61011 $self->{chunk_ctx}->add($substr);
52 3         34 $self->{chunk_length} += length $substr;
53              
54             # Completed chunk
55 3 50       32 if ($self->{chunk_length} == CHUNK_SIZE) {
56 3   66     66 my $ctx = $self->{ctx} ||= Digest::MD4->new;
57              
58 3         43 $ctx->add( $self->{chunk_ctx}->digest );
59 3         19 $self->{chunk_length} = 0;
60             }
61              
62 3         14067 $buffer = substr $buffer, $need_length;
63             }
64              
65 2         29 return $self;
66             }
67              
68             sub digest {
69 13     13 1 811 my $self = shift;
70 13         43 my ($ctx, $chunk_ctx) = delete @$self{qw( ctx chunk_ctx chunk_length )};
71 13         78 $self->{chunk_ctx} = Digest::MD4->new;
72              
73             # One chunk
74 13 100       173 return $chunk_ctx->digest unless $ctx;
75              
76             # Multi chunk
77 2         50 $ctx->add( $chunk_ctx->digest )->digest;
78             }
79              
80             sub ed2k(@) {
81 2     2 1 12 Digest::ED2K->new->add(@_)->digest;
82             }
83              
84             sub ed2k_hex(@) {
85 2     2 1 9 Digest::ED2K->new->add(@_)->hexdigest;
86             }
87              
88             sub ed2k_base64(@) {
89 2     2 1 632 Digest::ED2K->new->add(@_)->b64digest;
90             }
91              
92             0x6B63;
93             __END__