File Coverage

blib/lib/CTK/Digest/FNV32a.pm
Criterion Covered Total %
statement 26 26 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 35 35 100.0


line stmt bran cond sub pod time code
1             package CTK::Digest::FNV32a; # $Id: FNV32a.pm 294 2020-09-02 06:36:52Z minus $
2 1     1   433 use strict;
  1         2  
  1         28  
3 1     1   5 use utf8;
  1         2  
  1         5  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             CTK::Digest::FNV32a - FNV32a Digest calculation for short strings
10              
11             =head1 VERSION
12              
13             Version 1.01
14              
15             =head1 SYNOPSIS
16              
17             use CTK::Digest::FNV32a;
18             my $fnv32a = CTK::Digest::FNV32a->new();
19             my $digest = $fnv32a->digest( "123456789" ); # 0xbb86b11c
20             my $hexdigest = $fnv32a->digest( "123456789" ); # bb86b11c
21              
22             =head1 DESCRIPTION
23              
24             This is Digest backend module that provides calculate FNV32a Digest for short strings
25              
26             =head1 METHODS
27              
28             =head2 digest
29              
30             my $digest = $fnv32a->digest( "123456789" ); # 0xbb86b11c
31              
32             Returns FNV32a Digest
33              
34             =head2 hexdigest
35              
36             my $hexdigest = $fnv32a->digest( "123456789" ); # bb86b11c
37              
38             Returns FNV32a Digest in hex form
39              
40             =head1 HISTORY
41              
42             See C file
43              
44             =head1 TO DO
45              
46             See C file
47              
48             =head1 BUGS
49              
50             * none noted
51              
52             =head1 SEE ALSO
53              
54             L, L,
55             L, L
56              
57             =head1 AUTHOR
58              
59             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
60              
61             =head1 COPYRIGHT
62              
63             Copyright (C) 1998-2020 D&D Corporation. All Rights Reserved
64              
65             =head1 LICENSE
66              
67             This program is free software; you can redistribute it and/or
68             modify it under the same terms as Perl itself.
69              
70             See C file and L
71              
72             =cut
73              
74 1     1   36 use vars qw/ $VERSION /;
  1         2  
  1         65  
75             $VERSION = 1.01;
76              
77 1     1   7 use parent qw/CTK::Digest/;
  1         2  
  1         5  
78              
79             sub digest {
80 4     4 1 10 my $self = shift;
81 4         7 my $string = $self->{data};
82 4         7 my $hval = 0x811c9dc5;
83              
84 4         5 if ((1<<32) == 4294967296) {
85 4         19 foreach my $c (unpack('C*', $string)) {
86 46         57 $hval ^= $c;
87 46         65 $hval += ((($hval << 1)) + (($hval << 4)) + (($hval << 7)) + (($hval << 8)) + (($hval << 24)));
88 46         59 $hval = $hval & 0xffffffff;
89             }
90             } else {
91 1     1   788 use bigint;
  1         5551  
  1         5  
92             foreach my $c (unpack('C*', $string)) {
93             $hval ^= $c;
94             $hval += ((($hval << 1)) + (($hval << 4)) + (($hval << 7)) + (($hval << 8)) + (($hval << 24)));
95             $hval = $hval & 0xffffffff;
96             }
97             }
98 4         21 return $hval;
99             }
100             sub hexdigest {
101 1     1 1 2 my $self = shift;
102 1         5 return sprintf("%x", $self->digest(@_));
103             }
104              
105             1;
106              
107             __END__