File Coverage

blib/lib/Math/BaseCalc.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	16	18	88.8
condition	3	3	100.0
subroutine	9	9	100.0
pod	4	4	100.0
total	93	95	97.8

package Math::BaseCalc;

use strict;
use Carp;
use vars qw($VERSION);
$VERSION = '1.014';

sub new {
  my ($pack, %opts) = @_;
  my $self = bless {}, $pack;
  $self->{has_dash} = 0;
  $self->digits($opts{digits});
  return $self;
}

sub digits {
  my $self = shift;
  if (@_) {
    # Set the value


    if (ref $_[0]) {
      $self->{digits} = [ @{ shift() } ];
    } else {
      my $name = shift;
      my %digitsets = $self->_digitsets;
      croak "Unrecognized digit set '$name'" unless exists $digitsets{$name};
      $self->{digits} = $digitsets{$name};
    }
    $self->{has_dash} = grep { $_ eq '-' } @{$self->{digits}};

    $self->{trans} = {};
    # Build the translation table back to numbers
    @{$self->{trans}}{@{$self->{digits}}} = 0..$#{$self->{digits}};

  }
  return @{$self->{digits}};
}


sub _digitsets {
  return (
      'bin' => [0,1],
      'hex' => [0..9,'a'..'f'],
      'HEX' => [0..9,'A'..'F'],
      'oct' => [0..7],
      '64'  => ['A'..'Z','a'..'z',0..9,'+','/'],
      '62'  => [0..9,'a'..'z','A'..'Z'],
     );
}

sub from_base {
  my $self = shift;
  return -1*$self->from_base(substr($_[0],1)) if !$self->{has_dash} && $_[0] =~ /^-/; # Handle negative numbers
  my $str = shift;
  my $dignum = @{$self->{digits}};

  # Deal with stuff after the decimal point
  my $add_in = 0;
  if ($str =~ s/\.(.+)//) {
    $add_in = $self->from_base(reverse $1)/$dignum**length($1);
  }

  $str = reverse $str;
  my $result = 0;
  my $trans = $self->{trans};
  while (length $str) {
    ## no critic
    return undef unless exists $trans->{substr($str,0,1)};
    # For large numbers, force result to be an integer (not a float)
    $result = int($result*$dignum + $trans->{chop $str});
  }

  # The bizarre-looking next line is necessary for proper handling of very large numbers
  return $add_in ? $result + $add_in : $result;
}

sub to_base {
  my ($self,$num) = @_;
  return '-'.$self->to_base(-1*$num) if $num<0; # Handle negative numbers

  my $dignum = @{$self->{digits}};

  my $result = '';
  while ($num>0) {
    substr($result,0,0) = $self->{digits}[ $num % $dignum ];
    use integer;
    $num /= $dignum;
    #$num = (($num - ($num % $dignum))/$dignum);  # An alternative to the above
  }
  return length $result ? $result : $self->{digits}[0];
}


1;
__END__