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;