File Coverage

blib/lib/Math/Base85.pm
Criterion Covered Total %
statement 46 46 100.0
branch 3 4 75.0
condition n/a
subroutine 10 10 100.0
pod 0 2 0.0
total 59 62 95.1


line stmt bran cond sub pod time code
1             package Math::Base85;
2              
3 1     1   48096 use strict;
  1         2  
  1         38  
4 1     1   4 use warnings;
  1         1  
  1         28  
5 1     1   4 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $base85_digits);
  1         2  
  1         57  
6              
7 1     1   14 use 5.006;
  1         3  
8 1     1   5 use Carp;
  1         1  
  1         54  
9 1     1   5 use Exporter;
  1         2  
  1         38  
10 1     1   14 use Math::BigInt qw(:constant);
  1         3  
  1         7  
11              
12             $VERSION = '0.5';
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   534 use constant B85_BASE => 85;
  1         2  
  1         131  
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 204 my $num = shift;
80 2         19 my @digits = split(//, $num);
81 2         6 my $answer = Math::BigInt->new("0");
82 2         175 my $n;
83             my $d;
84 2         7 while (defined($d = shift @digits)) {
85 21         2352 $answer = $answer * B85_BASE;
86 21         1338 $n = index($base85_digits, $d);
87 21 100       41 if ($n < 0) {
88 1         231 croak __PACKAGE__ . "::from_base85 -- invalid base 85 digit $d";
89             }
90 20         1139 $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 205 my $num = shift;
112 1         5 my @digits;
113             my $q;
114 1         0 my $r;
115 1         0 my $d;
116 1         4 while ($num > 0) {
117 20         593 $q = $num / B85_BASE;
118 20         2708 $r = $num % B85_BASE;
119 20         1727 $d = substr($base85_digits, $r, 1);
120 20         677 unshift @digits, $d;
121 20         43 $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