1use strict;
2package Math::BaseCalc;
3{
4  $Math::BaseCalc::VERSION = '1.019';
5}
6use Carp;
7
8sub new {
9  my ($pack, %opts) = @_;
10  my $self = bless {}, $pack;
11  $self->{has_dash} = 0;
12  $self->digits($opts{digits});
13  return $self;
14}
15
16sub digits {
17  my $self = shift;
18  if (@_) {
19    # Set the value
20
21
22    if (ref $_[0]) {
23      $self->{digits} = [ @{ shift() } ];
24    } else {
25      my $name = shift;
26      my %digitsets = $self->_digitsets;
27      croak "Unrecognized digit set '$name'" unless exists $digitsets{$name};
28      $self->{digits} = $digitsets{$name};
29    }
30    foreach my $digit (@{$self->{digits}}) {
31      if ($digit eq '-') {
32        $self->{has_dash} = 1;
33      } elsif ($digit eq '.') {
34        $self->{has_dot} = 1;
35      }
36    }
37
38    $self->{trans} = {};
39    # Build the translation table back to numbers
40    @{$self->{trans}}{@{$self->{digits}}} = 0..$#{$self->{digits}};
41
42  }
43  return @{$self->{digits}};
44}
45
46
47sub _digitsets {
48  return (
49      'bin' => [0,1],
50      'hex' => [0..9,'a'..'f'],
51      'HEX' => [0..9,'A'..'F'],
52      'oct' => [0..7],
53      '64'  => ['A'..'Z','a'..'z',0..9,'+','/'],
54      '62'  => [0..9,'a'..'z','A'..'Z'],
55     );
56}
57
58sub from_base {
59  my $self = shift;
60  return -1*$self->from_base(substr($_[0],1)) if !$self->{has_dash} && $_[0] =~ /^-/; # Handle negative numbers
61  my $str = shift;
62  my $dignum = @{$self->{digits}};
63
64  # Deal with stuff after the decimal point
65  my $add_in = 0;
66  if (!$self->{has_dot} && $str =~ s/\.(.+)//) {
67    $add_in = $self->from_base(reverse $1)/$dignum**length($1);
68  }
69
70  $str = reverse $str;
71  my $result = 0;
72  my $trans = $self->{trans};
73  while (length $str) {
74    ## no critic
75    return undef unless exists $trans->{substr($str,0,1)};
76    # For large numbers, force result to be an integer (not a float)
77    $result = int($result*$dignum + $trans->{chop $str});
78  }
79
80  # The bizarre-looking next line is necessary for proper handling of very large numbers
81  return $add_in ? $result + $add_in : $result;
82}
83
84sub to_base {
85  my ($self,$num) = @_;
86  return '-'.$self->to_base(-1*$num) if $num<0; # Handle negative numbers
87
88  my $dignum = @{$self->{digits}};
89
90  my $result = '';
91  while ($num>0) {
92    substr($result,0,0) = $self->{digits}[ $num % $dignum ];
93    use integer;
94    $num /= $dignum;
95    #$num = (($num - ($num % $dignum))/$dignum);  # An alternative to the above
96  }
97  return length $result ? $result : $self->{digits}[0];
98}
99
100
1011;
102__END__
103
104
105=head1 NAME
106
107Math::BaseCalc - Convert numbers between various bases
108
109=head1 VERSION
110
111version 1.019
112
113=head1 SYNOPSIS
114
115  use Math::BaseCalc;
116
117  my $calc = new Math::BaseCalc(digits => [0,1]); #Binary
118  my $bin_string = $calc->to_base(465); # Convert 465 to binary
119
120  $calc->digits('oct'); # Octal
121  my $number = $calc->from_base('1574'); # Convert octal 1574 to decimal
122
123=head1 DESCRIPTION
124
125This module facilitates the conversion of numbers between various
126number bases.  You may define your own digit sets, or use any of
127several predefined digit sets.
128
129The to_base() and from_base() methods convert between Perl numbers and
130strings which represent these numbers in other bases.  For instance,
131if you're using the binary digit set [0,1], $calc->to_base(5) will
132return the string "101".  $calc->from_base("101") will return the
133number 5.
134
135To convert between, say, base 7 and base 36, use the 2-step process
136of first converting to a Perl number, then to the desired base for the
137result:
138
139 $calc7  = new Math::BaseCalc(digits=>[0..6]);
140 $calc36 = new Math::BaseCalc(digits=>[0..9,'a'..'z']);
141
142 $in_base_36 = $calc36->to_base( $calc7->from_base('3506') );
143
144If you just need to handle regular octal & hexdecimal strings, you
145probably don't need this module.  See the sprintf(), oct(), and hex()
146Perl functions.
147
148=head1 METHODS
149
150=over 4
151
152=item * new Math::BaseCalc
153
154=item * new Math::BaseCalc(digits=>...)
155
156Create a new base calculator.  You may specify the digit set to use,
157by either giving the digits in a list reference (in increasing order,
158with the 'zero' character first in the list) or by specifying the name
159of one of the predefined digit sets (see the digit() method below).
160
161If your digit set includes the character C<->, then a dash at the
162beginning of a number will no longer signify a negative number.
163
164=item * $calc->to_base(NUMBER)
165
166Converts a number to a string representing that number in the
167associated base.
168
169If C<NUMBER> is a C<Math::BigInt> object, C<to_base()> will still work
170fine and give you an exact result string.
171
172=item * $calc->from_base(STRING)
173
174Converts a string representing a number in the associated base to a
175Perl integer.  The behavior when fed strings with characters not in
176$calc's digit set is currently undefined.
177
178If C<STRING> converts to a number too large for perl's integer
179representation, beware that the result may be auto-converted to a
180floating-point representation and thus only be an approximation.
181
182=item * $calc->digits
183
184=item * $calc->digits(...)
185
186Get/set the current digit set of the calculator.  With no arguments,
187simply returns a list of the characters that make up the current digit
188set.  To change the current digit set, pass a list reference
189containing the new digits, or the name of a predefined digit set.
190Currently the predefined digit sets are:
191
192       bin => [0,1],
193       hex => [0..9,'a'..'f'],
194       HEX => [0..9,'A'..'F'],
195       oct => [0..7],
196       64  => ['A'..'Z','a'..'z',0..9,'+','/'],
197       62  => [0..9,'a'..'z','A'..'Z'],
198
199 Examples:
200  $calc->digits('bin');
201  $calc->digits([0..7]);
202  $calc->digits([qw(w a l d o)]);
203
204If any of your "digits" has more than one character, the behavior is
205currently undefined.
206
207=back
208
209=head1 AUTHOR
210
211Ken Williams, kwilliams@cpan.org
212
213=head1 COPYRIGHT
214
215This is free software in the colloquial nice-guy sense of the word.
216Copyright (c) 1999, Ken Williams.  You may redistribute and/or modify
217it under the same terms as Perl itself.
218
219=head1 SEE ALSO
220
221perl(1).
222
223=cut
224