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