line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Math::Base85; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
40657
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
25
|
|
4
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
30
|
|
5
|
1
|
|
|
1
|
|
4
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $base85_digits); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
50
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
14
|
use 5.006; |
|
1
|
|
|
|
|
3
|
|
8
|
1
|
|
|
1
|
|
3
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
9
|
1
|
|
|
1
|
|
5
|
use Exporter; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
30
|
|
10
|
1
|
|
|
1
|
|
4
|
use Math::BigInt qw(:constant); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
$VERSION = '0.4'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
@ISA = qw(Math::BigInt); |
15
|
|
|
|
|
|
|
@EXPORT = qw(); |
16
|
|
|
|
|
|
|
@EXPORT_OK = qw(from_base85 to_base85); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
Math::Base85 - Perl extension for base 85 numbers, as referenced by RFC 1924 |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Math::Base85; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
$bigint = from_base85($number); |
27
|
|
|
|
|
|
|
$b85str = to_base85($bigint); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 DESCRIPTION |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
RFC 1924 describes a compact, fixed-size representation of IPv6 |
32
|
|
|
|
|
|
|
addresses which uses a base 85 number system. This module handles |
33
|
|
|
|
|
|
|
some of the uglier details of it. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
The base 85 numbers (from 0 to 84) are as follows: |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
0..9 A..Z a..z ! # $ % & ( ) * + - ; < = > ? @ ^ _ ` { | } ~ |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
At the moment, there's not much in this module. But it should be |
40
|
|
|
|
|
|
|
sufficient for the purposes of RFC 1924. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
This module has a variable called C<$Math::Base85::base85_digits>, |
43
|
|
|
|
|
|
|
which is a string containing the digits of the base 85 alphabet |
44
|
|
|
|
|
|
|
from lowest (0) to highest (~), in that order. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Additionally, the following two functions are defined for general |
47
|
|
|
|
|
|
|
use. (They will be exported upon request.) |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=cut |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
$Math::Base85::base85_digits = join('', |
52
|
|
|
|
|
|
|
'0' .. '9', |
53
|
|
|
|
|
|
|
'A' .. 'Z', |
54
|
|
|
|
|
|
|
'a' .. 'z', |
55
|
|
|
|
|
|
|
'!', '#', qw/$ % & ( ) * + - ; < = > ? @ ^ _ ` { | } ~/, |
56
|
|
|
|
|
|
|
); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Maybe we can make this a little more general... |
60
|
|
|
|
|
|
|
|
61
|
1
|
|
|
1
|
|
475
|
use constant B85_BASE => 85; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
108
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=pod |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head1 from_base85 |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head2 Parameters |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
A string composed of valid base 85 digits. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 Returns |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
A C object representing the number. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=cut |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub from_base85 |
78
|
|
|
|
|
|
|
{ |
79
|
2
|
|
|
2
|
0
|
191
|
my $num = shift; |
80
|
2
|
|
|
|
|
19
|
my @digits = split(//, $num); |
81
|
2
|
|
|
|
|
5
|
my $answer = new Math::BigInt "0"; |
82
|
2
|
|
|
|
|
176
|
my $n; |
83
|
|
|
|
|
|
|
my $d; |
84
|
2
|
|
|
|
|
5
|
while (defined($d = shift @digits)) { |
85
|
21
|
|
|
|
|
2340
|
$answer = $answer * B85_BASE; |
86
|
21
|
|
|
|
|
1333
|
$n = index($base85_digits, $d); |
87
|
21
|
100
|
|
|
|
37
|
if ($n < 0) { |
88
|
1
|
|
|
|
|
201
|
croak __PACKAGE__ . "::from_base85 -- invalid base 85 digit $d"; |
89
|
|
|
|
|
|
|
} |
90
|
20
|
|
|
|
|
1116
|
$answer = $answer + $n; |
91
|
|
|
|
|
|
|
} |
92
|
1
|
|
|
|
|
119
|
return $answer; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=pod |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head1 to_base85 |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head2 Parameters |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
A C object. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head2 Returns |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
A string of base 85 digits representing the number. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub to_base85 |
110
|
|
|
|
|
|
|
{ |
111
|
1
|
|
|
1
|
0
|
172
|
my $num = shift; |
112
|
1
|
|
|
|
|
4
|
my @digits; |
113
|
|
|
|
|
|
|
my $q; |
114
|
1
|
|
|
|
|
0
|
my $r; |
115
|
1
|
|
|
|
|
0
|
my $d; |
116
|
1
|
|
|
|
|
3
|
while ($num > 0) { |
117
|
20
|
|
|
|
|
580
|
$q = $num / B85_BASE; |
118
|
20
|
|
|
|
|
2721
|
$r = $num % B85_BASE; |
119
|
20
|
|
|
|
|
1764
|
$d = substr($base85_digits, $r, 1); |
120
|
20
|
|
|
|
|
687
|
unshift @digits, $d; |
121
|
20
|
|
|
|
|
47
|
$num = $q; |
122
|
|
|
|
|
|
|
} |
123
|
1
|
50
|
|
|
|
27
|
unshift @digits, '0' unless (@digits); |
124
|
1
|
|
|
|
|
6
|
return join('', @digits); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head1 AUTHORS |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=over 4 |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=item * |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Tony Monroe |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=item * |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
Paul Cochrane (maintainer) |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=back |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
Copyright (c) 2001-2002, Tony Monroe . All rights reserved. |
144
|
|
|
|
|
|
|
Copyright (c) 2017, Paul Cochrane . All rights reserved. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
You may use this software under the same terms as Perl itself. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 SEE ALSO |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
perl(1). |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=cut |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
1; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# vim: expandtab shiftwidth=4 |