FILE: C:\Program Files (x86)\Plesk\perl\lib\bignum.pm

--
package bignum;

use strict;
use warnings;

use Carp qw< carp croak >;

our $VERSION = '0.67';

use Exporter;
our @ISA            = qw( Exporter );
our @EXPORT_OK      = qw( PI e bpi bexp hex oct );
our @EXPORT         = qw( inf NaN );

use overload;

# Defaults: When a constant is an integer, Inf or NaN, it is converted to an
# object of class $int_class. When a constant is a finite non-integer, it is
# converted to an object of class $float_class.

my $int_class = 'Math::BigInt';
my $float_class = 'Math::BigFloat';

##############################################################################

sub accuracy {
    shift;
    $int_class -> accuracy(@_);
    $float_class -> accuracy(@_);
}

sub precision {
    shift;
    $int_class -> precision(@_);
    $float_class -> precision(@_);
}

sub round_mode {
    shift;
    $int_class -> round_mode(@_);
    $float_class -> round_mode(@_);
}

sub div_scale {
    shift;
    $int_class -> div_scale(@_);
    $float_class -> div_scale(@_);
}

sub upgrade {
    shift;
    $int_class -> upgrade(@_);
}

sub downgrade {
    shift;
    $float_class -> downgrade(@_);
}

sub in_effect {
    my $level = shift || 0;
    my $hinthash = (caller($level))[10];
    $hinthash->{bignum};
}

sub _float_constant {
    my $str = shift;

    # See if we can convert the input string to a string using a normalized form
    # consisting of the significand as a signed integer, the character "e", and
    # the exponent as a signed integer, e.g., "+0e+0", "+314e-2", and "-1e+3".

    my $nstr;

    if (
        # See if it is an octal number. An octal number like '0377' is also
        # accepted by the functions parsing decimal and hexadecimal numbers, so
        # handle octal numbers before decimal and hexadecimal numbers.

        $str =~ /^0(?:[Oo]|_*[0-7])/ and
        $nstr = Math::BigInt -> oct_str_to_dec_flt_str($str)

          or

        # See if it is decimal number.

        $nstr = Math::BigInt -> dec_str_to_dec_flt_str($str)

          or

        # See if it is a hexadecimal number. Every hexadecimal number has a
        # prefix, but the functions parsing numbers don't require it, so check
        # to see if it actually is a hexadecimal number.

        $str =~ /^0[Xx]/ and
        $nstr = Math::BigInt -> hex_str_to_dec_flt_str($str)

          or

        # See if it is a binary numbers. Every binary number has a prefix, but
        # the functions parsing numbers don't require it, so check to see if it
        # actually is a binary number.

        $str =~ /^0[Bb]/ and
        $nstr = Math::BigInt -> bin_str_to_dec_flt_str($str))
    {
        my $pos      = index($nstr, 'e');
        my $expo_sgn = substr($nstr, $pos + 1, 1);
        my $sign     = substr($nstr, 0, 1);
        my $mant     = substr($nstr, 1, $pos - 1);
        my $mant_len = CORE::length($mant);
        my $expo     = substr($nstr, $pos + 2);

        # The number is a non-integer if and only if the exponent is negative.

        if ($expo_sgn eq '-') {
            return $float_class -> new($str);

            my $upgrade = $int_class -> upgrade();
            return $upgrade -> new($nstr) if defined $upgrade;

            if ($mant_len <= $expo) {
                return $int_class -> bzero();                   # underflow
            } else {
                $mant = substr $mant, 0, $mant_len - $expo;     # truncate
                return $int_class -> new($sign . $mant);
            }
        } else {
            $mant .= "0" x $expo;                               # pad with zeros
            return $int_class -> new($sign . $mant);
        }
    }

    # If we get here, there is a bug in the code above this point.

    warn "Internal error: unable to handle literal constant '$str'.",
      " This is a bug, so please report this to the module author.";
    return $int_class -> bnan();
}

#############################################################################
# the following two routines are for "use bignum qw/hex oct/;":

use constant LEXICAL => $] > 5.009004;

# Internal function with the same semantics as CORE::hex(). This function is
# not used directly, but rather by other front-end functions.

sub _hex_core {
    my $str = shift;

    # Strip off, clean, and parse as much as we can from the beginning.

    my $x;
    if ($str =~ s/ ^ ( 0? [xX] )? ( [0-9a-fA-F]* ( _ [0-9a-fA-F]+ )* ) //x) {
        my $chrs = $2;
        $chrs =~ tr/_//d;
        $chrs = '0' unless CORE::length $chrs;
        $x = $int_class -> from_hex($chrs);
    } else {
        $x = $int_class -> bzero();
    }

    # Warn about trailing garbage.

    if (CORE::length($str)) {
        require Carp;
        Carp::carp(sprintf("Illegal hexadecimal digit '%s' ignored",
                           substr($str, 0, 1)));
    }

    return $x;
}

# Internal function with the same semantics as CORE::oct(). This function is
# not used directly, but rather by other front-end functions.

sub _oct_core {
    my $str = shift;

    $str =~ s/^\s*//;

    # Hexadecimal input.

    return _hex_core($str) if $str =~ /^0?[xX]/;

    my $x;

    # Binary input.

    if ($str =~ /^0?[bB]/) {

        # Strip off, clean, and parse as much as we can from the beginning.

        if ($str =~ s/ ^ ( 0? [bB] )? ( [01]* ( _ [01]+ )* ) //x) {
            my $chrs = $2;
            $chrs =~ tr/_//d;
            $chrs = '0' unless CORE::length $chrs;
            $x = $int_class -> from_bin($chrs);
        }

        # Warn about trailing garbage.

        if (CORE::length($str)) {
            require Carp;
            Carp::carp(sprintf("Illegal binary digit '%s' ignored",
                               substr($str, 0, 1)));
        }

        return $x;
    }

    # Octal input. Strip off, clean, and parse as much as we can from the
    # beginning.

    if ($str =~ s/ ^ ( 0? [oO] )? ( [0-7]* ( _ [0-7]+ )* ) //x) {
        my $chrs = $2;
        $chrs =~ tr/_//d;
        $chrs = '0' unless CORE::length $chrs;
        $x = $int_class -> from_oct($chrs);
    }

    # Warn about trailing garbage. CORE::oct() only warns about 8 and 9, but it
    # is more helpful to warn about all invalid digits.

    if (CORE::length($str)) {
        require Carp;
        Carp::carp(sprintf("Illegal octal digit '%s' ignored",
                           substr($str, 0, 1)));
    }

    return $x;
}

{
    my $proto = LEXICAL ? '_' : ';$';
    eval '
sub hex(' . $proto . ') {' . <<'.';
    my $str = @_ ? $_[0] : $_;
    _hex_core($str);
}
.

    eval '
sub oct(' . $proto . ') {' . <<'.';
    my $str = @_ ? $_[0] : $_;
    _oct_core($str);
}
.
}

#############################################################################
# the following two routines are for Perl 5.9.4 or later and are lexical

my ($prev_oct, $prev_hex, $overridden);

if (LEXICAL) { eval <<'.' }
sub _hex(_) {
    my $hh = (caller 0)[10];
    return $$hh{bignum} ? bignum::_hex_core($_[0])
         : $$hh{bigrat} ? bigrat::_hex_core($_[0])
         : $$hh{bigint} ? bigint::_hex_core($_[0])
         : $prev_hex    ? &$prev_hex($_[0])
         : CORE::hex($_[0]);
}

sub _oct(_) {
    my $hh = (caller 0)[10];
    return $$hh{bignum} ? bignum::_oct_core($_[0])
         : $$hh{bigrat} ? bigrat::_oct_core($_[0])
         : $$hh{bigint} ? bigint::_oct_core($_[0])
         : $prev_oct    ? &$prev_oct($_[0])
         : CORE::oct($_[0]);
}
.

sub _override {
    return if $overridden;
    $prev_oct = *CORE::GLOBAL::oct{CODE};
    $prev_hex = *CORE::GLOBAL::hex{CODE};
    no warnings 'redefine';
    *CORE::GLOBAL::oct = \&_oct;
    *CORE::GLOBAL::hex = \&_hex;
    $overridden = 1;
}

sub unimport {
    delete $^H{bignum};         # no longer in effect
    overload::remove_constant('binary', '', 'float', '', 'integer');
}

sub import {
    my $class = shift;

    $^H{bignum} = 1;            # we are in effect
    delete $^H{bigint};
    delete $^H{bigrat};

    # for newer Perls always override hex() and oct() with a lexical version:
    if (LEXICAL) {
        _override();
    }

    my @import     = ();                        # common options
    my @int_import = (upgrade => $float_class); # int class only options
    my @flt_import = (downgrade => $int_class); # float class only options
    my @a = ();                                 # unrecognized arguments
    my $ver;                                    # display version info?

    while (@_) {
        my $param = shift;

        # Upgrading.

        if ($param eq 'upgrade') {
            my $arg = shift;
            $float_class = $arg if defined $arg;
            push @int_import, 'upgrade', $arg;
            next;
        }

        # Downgrading.

        if ($param eq 'downgrade') {
            my $arg = shift;
            $int_class = $arg if defined $arg;
            push @flt_import, 'downgrade', $arg;
            next;
        }

        # Accuracy.

        if ($param =~ /^a(ccuracy)?$/) {
            push @import, 'accuracy', shift();
            next;
        }

        # Precision.

        if ($param =~ /^p(recision)?$/) {
            push @import, 'precision', shift();
            next;
        }

        # Rounding mode.

        if ($param eq 'round_mode') {
            push @import, 'round_mode', shift();
            next;
        }

        # Backend library.

        if ($param =~ /^(l|lib|try|only)$/) {
            push @import, $param eq 'l' ? 'lib' : $param;
            push @import, shift() if @_;
            next;
        }

        if ($param =~ /^(v|version)$/) {
            $ver = 1;
            next;
        }

        if ($param =~ /^(PI|e|bexp|bpi|hex|oct)\z/) {
            push @a, $param;
            next;
        }

        croak("Unknown option '$param'");
    }

    eval "require $int_class";
    die $@ if $@;
    $int_class -> import(@int_import, @import);

    eval "require $float_class";
    die $@ if $@;
    $float_class -> import(@flt_import, @import);

    if ($ver) {
        printf "%-31s v%s\n", $class, $class -> VERSION();
        printf " lib => %-23s v%s\n",
          $int_class -> config("lib"), $int_class -> config("lib_version");
        printf "%-31s v%s\n", $int_class, $int_class -> VERSION();
        exit;
    }

    $class -> export_to_level(1, $class, @a);   # export inf, NaN, etc.

    overload::constant

        # This takes care each number written as decimal integer and within the
        # range of what perl can represent as an integer, e.g., "314", but not
        # "3141592653589793238462643383279502884197169399375105820974944592307".

        integer => sub {
            #printf "Value '%s' handled by the 'integer' sub.\n", $_[0];
            my $str = shift;
            return $int_class -> new($str);
        },

        # This takes care of each number written with a decimal point and/or
        # using floating point notation, e.g., "3.", "3.0", "3.14e+2" (decimal),
        # "0b1.101p+2" (binary), "03.14p+2" and "0o3.14p+2" (octal), and
        # "0x3.14p+2" (hexadecimal).

        float => sub {
            #printf "# Value '%s' handled by the 'float' sub.\n", $_[0];
            _float_constant(shift);
        },

        # Take care of each number written as an integer (no decimal point or
        # exponent) using binary, octal, or hexadecimal notation, e.g., "0b101"
        # (binary), "0314" and "0o314" (octal), and "0x314" (hexadecimal).

        binary => sub {
            #printf "# Value '%s' handled by the 'binary' sub.\n", $_[0];
            my $str = shift;
            return $int_class -> new($str) if $str =~ /^0[XxBb]/;
            $int_class -> from_oct($str);
        };
}

sub inf () { $int_class -> binf(); }
sub NaN () { $int_class -> bnan(); }

# This should depend on the current accuracy/precision. Fixme!
sub PI  () { $float_class -> new('3.141592653589793238462643383279502884197'); }
sub e   () { $float_class -> new('2.718281828459045235360287471352662497757'); }

sub bpi ($) {
    my $up = Math::BigFloat -> upgrade();   # get current upgrading, if any ...
    Math::BigFloat -> upgrade(undef);       # ... and disable
    my $x = Math::BigFloat -> bpi(@_);
    Math::BigFloat -> upgrade($up);         # reset the upgrading
    return $x;
}

sub bexp ($$) {
    my $up = Math::BigFloat -> upgrade();   # get current upgrading, if any ...
    Math::BigFloat -> upgrade(undef);       # ... and disable
    my $x = Math::BigFloat -> new(shift) -> bexp(@_);
    Math::BigFloat -> upgrade($up);         # reset the upgrading
    return $x;
}

1;

__END__

=pod

=head1 NAME

bignum - transparent big number support for Perl

=head1 SYNOPSIS

    use bignum;

    $x = 2 + 4.5;                       # Math::BigFloat 6.5
    print 2 ** 512 * 0.1;               # Math::BigFloat 134...09.6
    print 2 ** 512;                     # Math::BigInt 134...096
    print inf + 42;                     # Math::BigInt inf
    print NaN * 7;                      # Math::BigInt NaN
    print hex("0x1234567890123490");    # Perl v5.10.0 or later

    {
        no bignum;
        print 2 ** 256;                 # a normal Perl scalar now
    }

    # for older Perls, import into current package:
    use bignum qw/hex oct/;
    print hex("0x1234567890123490");
    print oct("01234567890123490");

=head1 DESCRIPTION

=head2 Literal numeric constants

By default, every literal integer becomes a Math::BigInt object, and literal
non-integer becomes a Math::BigFloat object. Whether a numeric literal is
considered an integer or non-integers depends only on the value of the constant,
not on how it is represented. For instance, the constants 3.14e2 and 0x1.3ap8
become Math::BigInt objects, because they both represent the integer value
decimal 314.

The default C is equivalent to

    use bignum downgrade => "Math::BigInt", upgrade => "Math::BigFloat";

The classes used for integers and non-integers can be set at compile time with
the C and C options, for example

    # use Math::BigInt for integers and Math::BigRat for non-integers
    use bignum upgrade => "Math::BigRat";

Note that disabling downgrading and upgrading does not affect how numeric
literals are converted to objects

    # disable both downgrading and upgrading
    use bignum downgrade => undef, upgrade => undef;
    $x = 2.4;       # becomes 2.4 as a Math::BigFloat
    $y = 2;         # becomes 2 as a Math::BigInt

=head2 Upgrading and downgrading

By default, when the result of a computation is an integer, an Inf, or a NaN,
the result is downgraded even when all the operands are instances of the upgrade
class.

    use bignum;
    $x = 2.4;       # becomes 2.4 as a Math::BigFloat
    $y = 1.2;       # becomes 1.2 as a Math::BigFloat
    $z = $x / $y;   # becomes 2 as a Math::BigInt due to downgrading

Equivalently, by default, when the result of a computation is a finite
non-integer, the result is upgraded even when all the operands are instances of
the downgrade class.

    use bignum;
    $x = 7;         # becomes 7 as a Math::BigInt
    $y = 2;         # becomes 2 as a Math::BigInt
    $z = $x / $y;   # becomes 3.5 as a Math::BigFloat due to upgrading

The classes used for downgrading and upgrading can be set at runtime with the
L and L methods, but see L below.

The upgrade and downgrade classes don't have to be Math::BigInt and
Math::BigFloat. For example, to use Math::BigRat as the upgrade class, use

    use bignum upgrade => "Math::BigRat";
    $x = 2;         # becomes 2 as a Math::BigInt
    $y = 3.6;       # becomes 18/5 as a Math::BigRat

The upgrade and downgrade classes can be modified at runtime

    use bignum;
    $x = 3;         # becomes 3 as a Math::BigInt
    $y = 2;         # becomes 2 as a Math::BigInt
    $z = $x / $y;   # becomes 1.5 as a Math::BigFlaot

    bignum -> upgrade("Math::BigRat");
    $w = $x / $y;   # becomes 3/2 as a Math::BigRat

Disabling downgrading doesn't change the fact that literal constant integers are
converted to the downgrade class, it only prevents downgrading as a result of a
computation. E.g.,

    use bignum downgrade => undef;
    $x = 2;         # becomes 2 as a Math::BigInt
    $y = 2.4;       # becomes 2.4 as a Math::BigFloat
    $z = 1.2;       # becomes 1.2 as a Math::BigFloat
    $w = $x / $y;   # becomes 2 as a Math::BigFloat due to no downgrading

If you want all numeric literals, both integers and non-integers, to become
Math::BigFloat objects, use the L pragma.

Equivalently, disabling upgrading doesn't change the fact that literal constant
non-integers are converted to the upgrade class, it only prevents upgrading as a
result of a computation. E.g.,

    use bignum upgrade => undef;
    $x = 2.5;       # becomes 2.5 as a Math::BigFloat
    $y = 7;         # becomes 7 as a Math::BigInt
    $z = 2;         # becomes 2 as a Math::BigInt
    $w = $x / $y;   # becomes 3 as a Math::BigInt due to no upgrading

If you want all numeric literals, both integers and non-integers, to become
Math::BigInt objects, use the L pragma.

You can even do

    use bignum upgrade => "Math::BigRat", upgrade => undef;

which converts all integer literals to Math::BigInt objects and all non-integer
literals to Math::BigRat objects. However, when the result of a computation
involving two Math::BigInt objects results in a non-integer (e.g., 7/2), the
result will be truncted to a Math::BigInt rather than being upgraded to a
Math::BigRat, since upgrading is disabled.

=head2 Overloading

Since all numeric literals become objects, you can call all the usual methods
from Math::BigInt and Math::BigFloat on them. This even works to some extent on
expressions:

    perl -Mbignum -le '$x = 1234; print $x->bdec()'
    perl -Mbignum -le 'print 1234->copy()->binc();'
    perl -Mbignum -le 'print 1234->copy()->binc()->badd(6);'

=head2 Options

C recognizes some options that can be passed while loading it via via
C. The following options exist:

=over 4

=item a or accuracy

This sets the accuracy for all math operations. The argument must be greater
than or equal to zero. See Math::BigInt's bround() method for details.

    perl -Mbignum=a,50 -le 'print sqrt(20)'

Note that setting precision and accuracy at the same time is not possible.

=item p or precision

This sets the precision for all math operations. The argument can be any
integer. Negative values mean a fixed number of digits after the dot, while a
positive value rounds to this digit left from the dot. 0 means round to integer.
See Math::BigInt's bfround() method for details.

    perl -Mbignum=p,-50 -le 'print sqrt(20)'

Note that setting precision and accuracy at the same time is not possible.

=item l, lib, try, or only

Load a different math lib, see L
--