Newer
Older
NetAddr-IP / Lite / Calc.pm
@Michael Robinton Michael Robinton on 21 Oct 2014 4 KB Import of MIKER/NetAddr-IP-4.051 from CPAN.
package NetAddr::IP::Calc;

use diagnostics;
use strict;
use vars qw($VERSION);

$VERSION = '1.997';

# Package to store unsigned big integers in decimal and do math with them

# Internally the numbers are stored in an array with at least 1 element, no
# leading zero parts (except the first) and in base 1eX where X is determined
# automatically at loading time to be the maximum possible value

# todo:
# - fully remove funky $# stuff in div() (maybe - that code scares me...)

# USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used
# instead of "/ 1e5" at some places, (marked with USE_MUL). Other platforms
# BS2000, some Crays need USE_DIV instead.
# The BEGIN block is used to determine which of the two variants gives the
# correct result.

# Beware of things like:
# $i = $i * $y + $car; $car = int($i / $BASE); $i = $i % $BASE;
# This works on x86, but fails on ARM (SA1100, iPAQ) due to whoknows what
# reasons. So, use this instead (slower, but correct):
# $i = $i * $y + $car; $car = int($i / $BASE); $i -= $BASE * $car;

##############################################################################
# global constants, flags and accessory

# announce that we are compatible with MBI v1.83 and up
sub api_version () { 2; }
 
# constants for easier life
my ($BASE,$BASE_LEN,$RBASE);

sub _base_len 
  {
  # Set/get the BASE_LEN and assorted other, connected values.
  # Used only by the testsuite, the set variant is used only by the BEGIN
  # block below:
  shift;

  my ($b, $int) = @_;
  if (defined $b)
    {
    if ($] >= 5.008 && $int && $b > 7)
      {
      $BASE_LEN = $b;
      $BASE = int("1e".$BASE_LEN);
      return $BASE_LEN;
      }

    # find whether we can use mul or div in mul()/div()
    $BASE_LEN = $b+1;
    my $caught = 0;
    while (--$BASE_LEN > 5)
      {
      $BASE = int("1e".$BASE_LEN);
      $RBASE = abs('1e-'.$BASE_LEN);			# see USE_MUL
      $caught = 0;
      $caught += 1 if (int($BASE * $RBASE) != 1);	# should be 1
      $caught += 2 if (int($BASE / $BASE) != 1);	# should be 1
      last if $caught != 3;
      }
    }
  return $BASE_LEN;
  }

sub _new
  {
  # (ref to string) return ref to num_array
  # Convert a number from string format (without sign) to internal base
  # 1ex format. Assumes normalized value as input.
  my $il = length($_[1])-1;

  # < BASE_LEN due len-1 above
  return [ int($_[1]) ] if $il < $BASE_LEN;	# shortcut for short numbers

  # this leaves '00000' instead of int 0 and will be corrected after any op
  [ reverse(unpack("a" . ($il % $BASE_LEN+1) 
    . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
  }                                                                             

BEGIN
  {
  # from Daniel Pfeiffer: determine largest group of digits that is precisely
  # multipliable with itself plus carry
  # Test now changed to expect the proper pattern, not a result off by 1 or 2
  my ($e, $num) = 3;	# lowest value we will use is 3+1-1 = 3
  do 
    {
    $num = ('9' x ++$e) + 0;
    $num *= $num + 1.0;
    } while ("$num" =~ /9{$e}0{$e}/);	# must be a certain pattern
  $e--; 				# last test failed, so retract one step
  # the limits below brush the problems with the test above under the rug:
  # the test should be able to find the proper $e automatically
  $e = 5 if $^O =~ /^uts/;	# UTS get's some special treatment
  $e = 5 if $^O =~ /^unicos/;	# unicos is also problematic (6 seems to work
				# there, but we play safe)

  my $int = 0;
  if ($e > 7)
    {
    use integer;
    my $e1 = 7;
    $num = 7;
    do 
      {
      $num = ('9' x ++$e1) + 0;
      $num *= $num + 1;
      } while ("$num" =~ /9{$e1}0{$e1}/);	# must be a certain pattern
    $e1--; 					# last test failed, so retract one step
    if ($e1 > 7)
      { 
      $int = 1; $e = $e1; 
      }
    }
 
  __PACKAGE__->_base_len($e,$int);	# set and store
  }

=head1 LICENSE

This program is free software; you may redistribute it and/or modify it under
the same terms as Perl itself. 

=head1 AUTHORS

=over 4

=item *

Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/>
in late 2000.

=item *

Separated from BigInt and shaped API with the help of John Peacock.

=item *

Fixed, speed-up, streamlined and enhanced by Tels 2001 - 2007.

=item *

API documentation corrected and extended by Peter John Acklam,
E<lt>pjacklam@online.noE<gt>

=item *

Shortened to base length check only for use with NetAddr::IP by
Michael Robinton e<lt>michael@bizsystems.comE<gt>

=back

=cut

1;