File Coverage

blib/lib/Math/BaseCalc.pm
Criterion Covered Total %
statement 63 63 100.0
branch 20 22 90.9
condition 6 6 100.0
subroutine 9 9 100.0
pod 4 4 100.0
total 102 104 98.0


line stmt bran cond sub pod time code
1             package Math::BaseCalc;
2              
3 6     6   33570 use strict;
  6         14  
  6         163  
4 6     6   34 use Carp;
  6         10  
  6         375  
5 6     6   41 use vars qw($VERSION);
  6         12  
  6         3728  
6             $VERSION = '1.014';
7              
8             sub new {
9 11     11 1 5159 my ($pack, %opts) = @_;
10 11         28 my $self = bless {}, $pack;
11 11         68 $self->{has_dash} = 0;
12 11         34 $self->digits($opts{digits});
13 11         29 return $self;
14             }
15              
16             sub digits {
17 23     23 1 5561 my $self = shift;
18 23 50       65 if (@_) {
19             # Set the value
20              
21              
22 23 100       62 if (ref $_[0]) {
23 16         21 $self->{digits} = [ @{ shift() } ];
  16         53  
24             } else {
25 7         12 my $name = shift;
26 7         15 my %digitsets = $self->_digitsets;
27 7 50       24 croak "Unrecognized digit set '$name'" unless exists $digitsets{$name};
28 7         54 $self->{digits} = $digitsets{$name};
29             }
30 23         71 foreach my $digit (@{$self->{digits}}) {
  23         57  
31 256 100       618 if ($digit eq '-') {
    100          
32 2         4 $self->{has_dash} = 1;
33             } elsif ($digit eq '.') {
34 1         2 $self->{has_dot} = 1;
35             }
36             }
37              
38 23         48 $self->{trans} = {};
39             # Build the translation table back to numbers
40 23         53 @{$self->{trans}}{@{$self->{digits}}} = 0..$#{$self->{digits}};
  23         146  
  23         39  
  23         50  
41              
42             }
43 23         39 return @{$self->{digits}};
  23         50  
44             }
45              
46              
47             sub _digitsets {
48             return (
49 7     7   141 '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              
58             sub from_base {
59 67     67 1 2927 my $self = shift;
60 67 100 100     318 return -1*$self->from_base(substr($_[0],1)) if !$self->{has_dash} && $_[0] =~ /^-/; # Handle negative numbers
61 64         107 my $str = shift;
62 64         93 my $dignum = @{$self->{digits}};
  64         100  
63              
64             # Deal with stuff after the decimal point
65 64         94 my $add_in = 0;
66 64 100 100     299 if (!$self->{has_dot} && $str =~ s/\.(.+)//) {
67 2         7 $add_in = $self->from_base(reverse $1)/$dignum**length($1);
68             }
69              
70 64         122 $str = reverse $str;
71 64         88 my $result = 0;
72 64         94 my $trans = $self->{trans};
73 64         139 while (length $str) {
74             ## no critic
75 248 100       542 return undef unless exists $trans->{substr($str,0,1)};
76             # For large numbers, force result to be an integer (not a float)
77 246         584 $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 62 100       159 return $add_in ? $result + $add_in : $result;
82             }
83              
84             sub to_base {
85 57     57 1 16679 my ($self,$num) = @_;
86 57 100       152 return '-'.$self->to_base(-1*$num) if $num<0; # Handle negative numbers
87              
88 56         267 my $dignum = @{$self->{digits}};
  56         106  
89              
90 56         86 my $result = '';
91 56         134 while ($num>0) {
92 204         8568 substr($result,0,0) = $self->{digits}[ $num % $dignum ];
93 6     6   1805 use integer;
  6         57  
  6         30  
94 204         4965 $num /= $dignum;
95             #$num = (($num - ($num % $dignum))/$dignum); # An alternative to the above
96             }
97 56 100       476 return length $result ? $result : $self->{digits}[0];
98             }
99              
100              
101             1;
102             __END__