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__ |