File Coverage

blib/lib/Math/Revhash.pm
Criterion Covered Total %
statement 48 48 100.0
branch 28 28 100.0
condition 6 6 100.0
subroutine 12 12 100.0
pod 5 5 100.0
total 99 99 100.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             #made by: KorG
3             # vim: sw=4 ts=4 et cc=79 :
4              
5             package Math::Revhash;
6              
7 6     6   517050 use 5.008;
  6         76  
8 6     6   34 use strict;
  6         12  
  6         164  
9 6     6   33 use warnings FATAL => 'all';
  6         10  
  6         245  
10 6     6   33 use Carp;
  6         12  
  6         465  
11 6     6   41 use Exporter 'import';
  6         9  
  6         200  
12 6     6   4689 use Math::BigInt;
  6         114521  
  6         36  
13              
14             our $VERSION = '0.03';
15             $VERSION =~ tr/_//d;
16              
17             our @EXPORT_OK = qw( revhash revunhash );
18              
19             # Fast hashing is based on reverse modulo operations.
20             # Given HASH = NUMBER * A % C, then NUMBER = HASH * B % C in case of B is
21             # a modular inverse of A.
22             # To avoid hash collisions A should be a primary number.
23              
24             # Pre-defined $A and $B for certain lengths
25             my $AB = {
26             1 => [ 103, 7 ],
27             2 => [ 929, 69 ],
28             3 => [ 1619, 979 ],
29             4 => [ 17027, 9963 ],
30             5 => [ 88651, 58851 ],
31             6 => [ 894407, 991543 ],
32             7 => [ 16006519, 8315079 ],
33             8 => [ 130067887, 91167823 ],
34             9 => [ 2700655597, 882024933 ],
35             };
36              
37             # See UNSAFE MODE
38             our $UNSAFE = 0;
39              
40             # Parse and prepare arguments
41             # This function is used by revhash, revunhash and new subroutines
42             sub _argsparse {
43 224450     224450   489051 my ($data, $len, $A, $B, $C) = @_;
44              
45 224450 100       437973 croak "data not defined" unless defined $data;
46 224449 100 100     766075 croak "Invalid length specified" unless defined $len and $len > 0;
47              
48 224446 100       396712 if (defined $C) {
49 2215 100       3816 croak "Hash C value is invalid" unless $C > 0;
50             } else {
51 222231         347047 $C = 10 ** $len;
52             }
53              
54 224445 100 100     699016 croak "data ($data) is out of range" unless $data > 0 and $data < $C;
55              
56 224442 100       380475 if (defined $A) {
57 2217 100       4028 croak "Hash A value is invalid" unless $A > 0;
58             } else {
59 222225         413402 $A = $AB->{$len}->[0];
60             }
61 224441 100       383815 croak "Hash A value is undefined" unless defined $A;
62              
63 224439 100       369689 if (defined $B) {
64 2215 100       3657 croak "Hash B value is invalid" unless $B > 0;
65             } else {
66 222224         323728 $B = $AB->{$len}->[1];
67             }
68 224438 100       359402 $B = Math::BigInt->new($A)->bmodinv($C) unless defined $B;
69 224438 100       576860 croak "Invalid B value for such length and A" if Math::BigInt->is_nan($B);
70              
71 224437         16610152 return ($data, $len, $A, $B, $C);
72             }
73              
74             # Calculate hash of number
75             # args: $number, $length, $A, $B, $C
76             sub revhash {
77 122223 100   122223 1 60097037 @_ = _argsparse @_ unless $UNSAFE;
78              
79 122211         628879 sprintf "%0$_[1]d", $_[0] * $_[2] % $_[4];
80             }
81              
82             # Calculate original number of hash
83             # args: $hash, $length, $A, $B, $C
84             sub revunhash {
85 122211 100   122211 1 466014 @_ = _argsparse @_ unless $UNSAFE;
86              
87 122211         295274 $_[0] * $_[3] % $_[4];
88             }
89              
90             # OO alias
91 11106     11106 1 6433358 sub hash { @_ = ($_[1], @{$_[0]}); goto &revhash }
  11106         33412  
  11106         33449  
92              
93             # OO alias
94 11106     11106 1 34563 sub unhash { @_ = ($_[1], @{$_[0]}); goto &revunhash }
  11106         26149  
  11106         24475  
95              
96             # OO ctor
97             # args: $class, $length, $A, $B, $C
98             sub new {
99 5     5 1 3243 my $obj;
100              
101 5         30 (undef, @{$obj}) = _argsparse(1, @_[1..4]);
  4         14  
102              
103 4         14 bless $obj, $_[0];
104             }
105              
106             1; # End of Math::Revhash
107              
108             __END__