File Coverage

blib/lib/Encode/Base32/Crockford.pm
Criterion Covered Total %
statement 59 59 100.0
branch 24 24 100.0
condition 3 4 75.0
subroutine 11 11 100.0
pod 5 5 100.0
total 102 103 99.0


line stmt bran cond sub pod time code
1             package Encode::Base32::Crockford;
2             {
3             $Encode::Base32::Crockford::VERSION = '2.112991';
4             }
5              
6 3     3   61903 use warnings;
  3         8  
  3         109  
7 3     3   184 use strict;
  3         7  
  3         118  
8              
9 3     3   25 use base qw(Exporter);
  3         7  
  3         509  
10             our @EXPORT_OK = qw(
11             base32_encode base32_encode_with_checksum
12             base32_decode base32_decode_with_checksum
13             normalize
14             );
15             our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
16              
17 3     3   17 use Carp qw(croak);
  3         6  
  3         220  
18 3     3   15 use Scalar::Util qw(looks_like_number);
  3         7  
  3         3191  
19              
20             my %SYMBOLS;
21              
22             # Note: regular digits do not include I, L, O or U. See spec in documentation.
23             @SYMBOLS{0..9,'A'..'H','J','K','M','N','P'..'T','V'..'Z'} = 0..31;
24              
25             # checksum symbols only from here
26             @SYMBOLS{'*','~','$','=','U'} = 32..36;
27              
28             my %SYMBOLS_INVERSE = reverse %SYMBOLS;
29              
30             sub base32_encode {
31 2055     2055 1 812763 my $number = shift;
32              
33 2055 100       8445 die qq("$number" isn't a number) unless looks_like_number($number);
34              
35 2054 100       5016 return '0' unless $number;
36              
37 2052         2852 my @digits;
38              
39             # Cut a long story short: keep dividing by 32. Use the remainders to make the
40             # digits of the converted number, right to left; the quotient goes to the next
41             # iteration to be divided again. When the quotient hits zero, i.e. there's not
42             # enough for 32 to be a divisor, the value being divided is the final digit.
43 2052         4717 while ($number) {
44 4043         17121 my $remainder = $number % 32;
45 4043         7155 $number = int($number / 32);
46 4043         16608 push @digits, $SYMBOLS_INVERSE{$remainder};
47             }
48              
49 2052   50     14214 return join('', reverse @digits) || '0';
50             }
51              
52             sub base32_encode_with_checksum {
53 1027     1027 1 740411 my $number = shift;
54              
55 1027         2399 my $modulo = $number % 37;
56            
57 1027         7224 return base32_encode($number) . $SYMBOLS_INVERSE{$modulo};
58             }
59              
60             sub normalize {
61 3088     3088 1 4613 my ($string, $options) = @_;
62              
63 3088         3894 my $orig_string = $string;
64              
65 3088         5064 $string = uc($string);
66 3088 100       8148 _normalize_actions($orig_string, $string, $options->{"mode"}) if $string ne $orig_string;
67              
68             # fix possible transcription errors and remove chunking symbols
69 3088 100       21836 _normalize_actions($orig_string, $string, $options->{"mode"}) if $string =~ tr/IiLlOo-/111100/d;
70              
71 3087         17686 $string;
72             }
73              
74             # Actions to carry out if normalize() is operating in a particular mode.
75             sub _normalize_actions {
76 4     4   10 my ($old_string, $new_string, $mode) = @_;
77              
78 4   100     18 $mode ||= '';
79              
80 4 100       15 warn qq(String "$old_string" corrected to "$new_string") if $mode eq "warn";
81 4 100       69 die qq(String "$old_string" requires normalization) if $mode eq "strict";
82             }
83              
84             sub base32_decode {
85 3090     3090 1 11480 my ($string, $options) = @_;
86              
87 3090 100       7317 croak "string is undefined" if not defined $string;
88 3089 100       7505 croak "string is empty" if $string eq '';
89              
90 3088         11625 $string = normalize($string, $options);
91              
92 3087         4528 my $valid;
93              
94 3087 100       10243 if ($options->{"is_checksum"}) {
95 1030 100       3002 die qq(Checksum "$string" is too long; should be one character)
96             if length($string) > 1;
97              
98 1029         11593 $valid = qr/^[A-Z0-9\*\~\$=U]$/;
99              
100             } else {
101             # 'U' is only valid as a checksum symbol.
102 2057         25544 $valid = qr/^[A-TV-Z0-9]+$/;
103             }
104              
105 3086 100       26129 croak qq(String "$string" contains invalid characters) if $string !~ /$valid/;
106            
107            
108 3084         4979 my $total = 0;
109              
110             # For each base32 digit B of position P counted (using zero-based counting)
111             # from right in a number, its decimal value D is calculated with the
112             # following expression:
113             # D = B * 32^P.
114             # As any number raised to the power of 0 is 1, we can define an "offset" value
115             # of 1 for the first digit calculated and simply multiply the offset by 32
116             # after deriving the value for each digit.
117              
118 3084         10414 foreach my $symbol (split(//, $string)) {
119 5084         19598 $total = $total * 32 + $SYMBOLS{$symbol};
120             }
121            
122 3084         24274 $total;
123             }
124              
125             sub base32_decode_with_checksum {
126 1027     1027 1 2678 my ($string, $options) = @_;
127 1027         3581 my $check_string = $string;
128              
129 1027         2534 my $checksum = substr($check_string, (length($check_string) - 1), 1, "");
130              
131 1027         1880 my $value = base32_decode($check_string, $options);
132 1027         4550 my $checksum_value = base32_decode($checksum, { "is_checksum" => 1 });
133 1027         2555 my $modulo = $value % 37;
134              
135 1027 100       2409 croak qq(Checksum symbol "$checksum" is not correct for value "$check_string".)
136             if $checksum_value != $modulo;
137            
138 1026         4829 $value;
139             }
140              
141             1;
142              
143             __END__