exiftool-vendored.exe 12.80.0 → 12.82.1

package/bin/exiftool_files/lib/Math/BigFloat.pm

@@ -19,8 +19,9 @@ use warnings;
 use Carp qw< carp croak >;
 use Math::BigInt ();
 
-our $VERSION = '1.999816';
+our $VERSION = '1.999818';
 
+require Exporter;
 our @ISA        = qw/Math::BigInt/;
 our @EXPORT_OK  = qw/bpi/;
 
@@ -28,8 +29,6 @@ our @EXPORT_OK  = qw/bpi/;
 our ($AUTOLOAD, $accuracy, $precision, $div_scale, $round_mode, $rnd_mode,
      $upgrade, $downgrade, $_trap_nan, $_trap_inf);
 
-my $class = "Math::BigFloat";
-
 use overload
 
   # overload key: with_assign
@@ -273,7 +272,7 @@ sub AUTOLOAD {
     my $name = $AUTOLOAD;
 
     $name =~ s/(.*):://;        # split package
-    my $c = $1 || $class;
+    my $c = $1 || __PACKAGE__;
     no strict 'refs';
     $c->import() if $IMPORT == 0;
     if (!_method_alias($name)) {
@@ -418,7 +417,8 @@ sub new {
         return $self;
     }
 
-    # Handle hexadecimal numbers.
+    # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they
+    # have a "0x" or "0X" prefix.
 
     if ($wanted =~ /^\s*[+-]?0[Xx]/) {
         $self = $class -> from_hex($wanted);
@@ -426,7 +426,42 @@ sub new {
         return $self;
     }
 
-    # Handle binary numbers.
+    # Handle octal numbers. We auto-detect octal numbers if they have a "0"
+    # prefix and a binary exponent.
+
+    if ($wanted =~ /
+                       ^
+                       \s*
+
+                       # sign
+                       [+-]?
+
+                       # prefix
+                       0
+
+                       # significand using the octal digits 0..7
+                       [0-7]+ (?: _ [0-7]+ )*
+                       (?:
+                           \.
+                           (?: [0-7]+ (?: _ [0-7]+ )* )?
+                       )?
+
+                       # exponent (power of 2) using decimal digits
+                       [Pp]
+                       [+-]?
+                       \d+ (?: _ \d+ )*
+
+                       \s*
+                       $
+                 /x)
+    {
+        $self = $class -> from_oct($wanted);
+        $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
+        return $self;
+    }
+
+    # Handle binary numbers. We auto-detect binary numbers if they have a "0b"
+    # or "0B" prefix.
 
     if ($wanted =~ /^\s*[+-]?0[Bb]/) {
         $self = $class -> from_bin($wanted);
@@ -781,6 +816,165 @@ sub from_bin {
     return $self->bnan();
 }
 
+sub from_ieee754 {
+    my $self    = shift;
+    my $selfref = ref $self;
+    my $class   = $selfref || $self;
+
+    # Don't modify constant (read-only) objects.
+
+    return if $selfref && $self->modify('from_ieee754');
+
+    my $in     = shift;     # input string (or raw bytes)
+    my $format = shift;     # format ("binary32", "decimal64" etc.)
+    my $enc;                # significand encoding (applies only to decimal)
+    my $k;                  # storage width in bits
+    my $b;                  # base
+
+    if ($format =~ /^binary(\d+)\z/) {
+        $k = $1;
+        $b = 2;
+    } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
+        $k = $1;
+        $b = 10;
+        $enc = $2 || 'dpd';     # default is dencely-packed decimals (DPD)
+    } elsif ($format eq 'half') {
+        $k = 16;
+        $b = 2;
+    } elsif ($format eq 'single') {
+        $k = 32;
+        $b = 2;
+    } elsif ($format eq 'double') {
+        $k = 64;
+        $b = 2;
+    } elsif ($format eq 'quadruple') {
+        $k = 128;
+        $b = 2;
+    } elsif ($format eq 'octuple') {
+        $k = 256;
+        $b = 2;
+    } elsif ($format eq 'sexdecuple') {
+        $k = 512;
+        $b = 2;
+    }
+
+    if ($b == 2) {
+
+        # Get the parameters for this format.
+
+        my $p;                      # precision (in bits)
+        my $t;                      # number of bits in significand
+        my $w;                      # number of bits in exponent
+
+        if ($k == 16) {             # binary16 (half-precision)
+            $p = 11;
+            $t = 10;
+            $w =  5;
+        } elsif ($k == 32) {        # binary32 (single-precision)
+            $p = 24;
+            $t = 23;
+            $w =  8;
+        } elsif ($k == 64) {        # binary64 (double-precision)
+            $p = 53;
+            $t = 52;
+            $w = 11;
+        } else {                    # binaryN (quadruple-precision and above)
+            if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
+                croak "Number of bits must be 16, 32, 64, or >= 128 and",
+                  " a multiple of 32";
+            }
+            $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
+            $t = $p - 1;
+            $w = $k - $t - 1;
+        }
+
+        # The maximum exponent, minimum exponent, and exponent bias.
+
+        my $emax = Math::BigInt -> new(2) -> bpow($w - 1) -> bdec();
+        my $emin = 1 - $emax;
+        my $bias = $emax;
+
+        # Undefined input.
+
+        unless (defined $in) {
+            carp("Input is undefined");
+            return $self -> bzero();
+        }
+
+        # Make sure input string is a string of zeros and ones.
+
+        my $len = CORE::length $in;
+        if (8 * $len == $k) {                   # bytes
+            $in = unpack "B*", $in;
+        } elsif (4 * $len == $k) {              # hexadecimal
+            if ($in =~ /([^\da-f])/i) {
+                croak "Illegal hexadecimal digit '$1'";
+            }
+            $in = unpack "B*", pack "H*", $in;
+        } elsif ($len == $k) {                  # bits
+            if ($in =~ /([^01])/) {
+                croak "Illegal binary digit '$1'";
+            }
+        } else {
+            croak "Unknown input -- $in";
+        }
+
+        # Split bit string into sign, exponent, and mantissa/significand.
+
+        my $sign = substr($in, 0, 1) eq '1' ? '-' : '+';
+        my $expo = $class -> from_bin(substr($in, 1, $w));
+        my $mant = $class -> from_bin(substr($in, $w + 1));
+
+        my $x;
+
+        $expo -> bsub($bias);                   # subtract bias
+
+        if ($expo < $emin) {                    # zero and subnormals
+            if ($mant == 0) {                   # zero
+                $x = $class -> bzero();
+            } else {                            # subnormals
+                # compute (1/$b)**(N) rather than ($b)**(-N)
+                $x = $class -> new("0.5");      # 1/$b
+                $x -> bpow($bias + $t - 1) -> bmul($mant);
+                $x -> bneg() if $sign eq '-';
+            }
+        }
+
+        elsif ($expo > $emax) {                 # inf and nan
+            if ($mant == 0) {                   # inf
+                $x = $class -> binf($sign);
+            } else {                            # nan
+                $x = $class -> bnan();
+            }
+        }
+
+        else {                                  # normals
+            $mant = $class -> new(2) -> bpow($t) -> badd($mant);
+            if ($expo < $t) {
+                # compute (1/$b)**(N) rather than ($b)**(-N)
+                $x = $class -> new("0.5");      # 1/$b
+                $x -> bpow($t - $expo) -> bmul($mant);
+            } else {
+                $x = $class -> new(2);
+                $x -> bpow($expo - $t) -> bmul($mant);
+            }
+            $x -> bneg() if $sign eq '-';
+        }
+
+        if ($selfref) {
+            $self -> {sign} = $x -> {sign};
+            $self -> {_m}   = $x -> {_m};
+            $self -> {_es}  = $x -> {_es};
+            $self -> {_e}   = $x -> {_e};
+        } else {
+            $self = $x;
+        }
+        return $self;
+    }
+
+    croak("The format '$format' is not yet supported.");
+}
+
 sub bzero {
     # create/assign '+0'
 
@@ -3023,7 +3217,7 @@ sub bsqrt {
 
     return $x if $x->modify('bsqrt');
 
-    return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
+    return $x->bnan() if $x->{sign} !~ /^\+/;  # NaN, -inf or < 0
     return $x if $x->{sign} eq '+inf';         # sqrt(inf) == inf
     return $x->round($a, $p, $r) if $x->is_zero() || $x->is_one();
 
@@ -3783,7 +3977,7 @@ sub mantissa {
 
     if ($x->{sign} !~ /^[+-]$/) {
         my $s = $x->{sign};
-        $s =~ s/^[+]//;
+        $s =~ s/^\+//;
         return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
     }
     my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef);
@@ -3798,7 +3992,7 @@ sub exponent {
 
     if ($x->{sign} !~ /^[+-]$/) {
         my $s = $x->{sign};
-$s =~ s/^[+-]//;
+        $s =~ s/^[+-]//;
         return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
     }
     Math::BigInt->new($x->{_es} . $LIB->_str($x->{_e}), undef, undef);
@@ -3810,9 +4004,9 @@ sub parts {
 
     if ($x->{sign} !~ /^[+-]$/) {
         my $s = $x->{sign};
-$s =~ s/^[+]//;
-my $se = $s;
-$se =~ s/^[-]//;
+        $s =~ s/^\+//;
+        my $se = $s;
+        $se =~ s/^-//;
         return ($class->new($s), $class->new($se)); # +inf => inf and -inf, +inf => inf
     }
     my $m = Math::BigInt->bzero();
@@ -3981,9 +4175,9 @@ sub bstr {
     }
 
     my $es = '0';
-my $len = 1;
-my $cad = 0;
-my $dot = '.';
+    my $len = 1;
+    my $cad = 0;
+    my $dot = '.';
 
     # $x is zero?
     my $not_zero = !($x->{sign} eq '+' && $LIB->_is_zero($x->{_m}));
@@ -4007,8 +4201,8 @@ my $dot = '.';
         } elsif ($e > 0) {
             # expand with zeros
             $es .= '0' x $e;
-$len += $e;
-$cad = 0;
+            $len += $e;
+            $cad = 0;
         }
     }                           # if not zero
 
@@ -4160,6 +4354,197 @@ sub to_bin {
     return $x->{sign} eq '-' ? "-$str" : $str;
 }
 
+sub to_ieee754 {
+    my $x = shift;
+    my $format = shift;
+    my $class = ref $x;
+
+    my $enc;            # significand encoding (applies only to decimal)
+    my $k;              # storage width in bits
+    my $b;              # base
+
+    if ($format =~ /^binary(\d+)\z/) {
+        $k = $1;
+        $b = 2;
+    } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
+        $k = $1;
+        $b = 10;
+        $enc = $2 || 'dpd';     # default is dencely-packed decimals (DPD)
+    } elsif ($format eq 'half') {
+        $k = 16;
+        $b = 2;
+    } elsif ($format eq 'single') {
+        $k = 32;
+        $b = 2;
+    } elsif ($format eq 'double') {
+        $k = 64;
+        $b = 2;
+    } elsif ($format eq 'quadruple') {
+        $k = 128;
+        $b = 2;
+    } elsif ($format eq 'octuple') {
+        $k = 256;
+        $b = 2;
+    } elsif ($format eq 'sexdecuple') {
+        $k = 512;
+        $b = 2;
+    }
+
+    if ($b == 2) {
+
+        # Get the parameters for this format.
+
+        my $p;                      # precision (in bits)
+        my $t;                      # number of bits in significand
+        my $w;                      # number of bits in exponent
+
+        if ($k == 16) {             # binary16 (half-precision)
+            $p = 11;
+            $t = 10;
+            $w =  5;
+        } elsif ($k == 32) {        # binary32 (single-precision)
+            $p = 24;
+            $t = 23;
+            $w =  8;
+        } elsif ($k == 64) {        # binary64 (double-precision)
+            $p = 53;
+            $t = 52;
+            $w = 11;
+        } else {                    # binaryN (quadruple-precition and above)
+            if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
+                croak "Number of bits must be 16, 32, 64, or >= 128 and",
+                  " a multiple of 32";
+            }
+            $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
+            $t = $p - 1;
+            $w = $k - $t - 1;
+        }
+
+        # The maximum exponent, minimum exponent, and exponent bias.
+
+        my $emax = $class -> new(2) -> bpow($w - 1) -> bdec();
+        my $emin = 1 - $emax;
+        my $bias = $emax;
+
+        # Get numerical sign, exponent, and mantissa/significand for bit
+        # string.
+
+        my $sign = 0;
+        my $expo;
+        my $mant;
+
+        if ($x -> is_nan()) {                   # nan
+            $sign = 1;
+            $expo = $emax -> copy() -> binc();
+            $mant = $class -> new(2) -> bpow($t - 1);
+        } elsif ($x -> is_inf()) {              # inf
+            $sign = 1 if $x -> is_neg();
+            $expo = $emax -> copy() -> binc();
+            $mant = $class -> bzero();
+        } elsif ($x -> is_zero()) {             # zero
+            $expo = $emin -> copy() -> bdec();
+            $mant = $class -> bzero();
+        } else {                                # normal and subnormal
+
+            $sign = 1 if $x -> is_neg();
+
+            # Now we need to compute the mantissa and exponent in base $b.
+
+            my $binv = $class -> new("0.5");
+            my $b    = $class -> new(2);
+            my $one  = $class -> bone();
+
+            # We start off by initializing the exponent to zero and the
+            # mantissa to the input value. Then we increase the mantissa and
+            # decrease the exponent, or vice versa, until the mantissa is in
+            # the desired range or we hit one of the limits for the exponent.
+
+            $mant = $x -> copy() -> babs();
+
+            # We need to find the base 2 exponent. First make an estimate of
+            # the base 2 exponent, before adjusting it below. We could skip
+            # this estimation and go straight to the while-loops below, but the
+            # loops are slow, especially when the final exponent is far from
+            # zero and even more so if the number of digits is large. This
+            # initial estimation speeds up the computation dramatically.
+            #
+            #   log2($m * 10**$e) = log10($m + 10**$e) * log(10)/log(2)
+            #                     = (log10($m) + $e) * log(10)/log(2)
+            #                     = (log($m)/log(10) + $e) * log(10)/log(2)
+
+            my ($m, $e) = $x -> nparts();
+            my $ms = $m -> numify();
+            my $es = $e -> numify();
+
+            my $expo_est = (log(abs($ms))/log(10) + $es) * log(10)/log(2);
+            $expo_est = int($expo_est);
+
+            # Limit the exponent.
+
+            if ($expo_est > $emax) {
+                $expo_est = $emax;
+            } elsif ($expo_est < $emin) {
+                $expo_est = $emin;
+            }
+
+            # Don't multiply by a number raised to a negative exponent. This
+            # will cause a division, whose result is truncated to some fixed
+            # number of digits. Instead, multiply by the inverse number raised
+            # to a positive exponent.
+
+            $expo = $class -> new($expo_est);
+            if ($expo_est > 0) {
+                $mant -> bmul($binv -> copy() -> bpow($expo));
+            } elsif ($expo_est < 0) {
+                my $expo_abs = $expo -> copy() -> bneg();
+                $mant -> bmul($b -> copy() -> bpow($expo_abs));
+            }
+
+            # Final adjustment.
+
+            while ($mant >= $b && $expo <= $emax) {
+                $mant -> bmul($binv);
+                $expo -> binc();
+            }
+
+            while ($mant < $one && $expo >= $emin) {
+                $mant -> bmul($b);
+                $expo -> bdec();
+            }
+
+            # Encode as infinity, normal number or subnormal number?
+
+            if ($expo > $emax) {                # overflow => infinity
+                $expo = $emax -> copy() -> binc();
+                $mant = $class -> bzero();
+            } elsif ($expo < $emin) {           # subnormal number
+                my $const = $class -> new(2) -> bpow($t - 1);
+                $mant -> bmul($const);
+                $mant -> bfround(0);
+            } else {                            # normal number
+                $mant -> bdec();                # remove implicit leading bit
+                my $const = $class -> new(2) -> bpow($t);
+                $mant -> bmul($const) -> bfround(0);
+            }
+        }
+
+        $expo -> badd($bias);                   # add bias
+
+        my $signbit = "$sign";
+
+        my $mantbits = $mant -> to_bin();
+        $mantbits = ("0" x ($t - CORE::length($mantbits))) . $mantbits;
+
+        my $expobits = $expo -> to_bin();
+        $expobits = ("0" x ($w - CORE::length($expobits))) . $expobits;
+
+        my $bin = $signbit . $expobits . $mantbits;
+        return pack "B*", $bin;
+    }
+
+    croak("The format '$format' is not yet supported.");
+}
+
 sub as_hex {
     # return number as hexadecimal string (only for integers defined)
 
@@ -4231,7 +4616,7 @@ sub numify {
     }
 
     # Create a string and let Perl's atoi()/atof() handle the rest.
-    return 0 + $x -> bsstr();
+    return 0 + $x -> bnstr();
 }
 
 ###############################################################################
@@ -4242,7 +4627,7 @@ sub import {
     my $class = shift;
     my $l = scalar @_;
     my $lib = '';
-my @a;
+    my @a;
     my $lib_kind = 'try';
     $IMPORT=1;
     for (my $i = 0; $i < $l ; $i++) {
@@ -4314,7 +4699,7 @@ sub _len_to_steps {
 
     # D = 50 => N => 42, so L = 40 and R = 50
     my $l = 40;
-my $r = $d;
+    my $r = $d;
 
     # Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :(
     $l = $l->numify if ref($l);
@@ -4370,7 +4755,6 @@ sub _log {
     $over->bmul($u);
     $factor = $class->new(3); $f = $class->new(2);
 
-    my $steps = 0;
     $limit = $class->new("1E-". ($scale-1));
 
     while (3 < 5) {
@@ -4717,7 +5101,6 @@ sub _pow {
     $over = $u->copy();
 
     $limit = $class->new("1E-". ($scale-1));
-    #my $steps = 0;
     while (3 < 5) {
         # we calculate the next term, and add it to the last
         # when the next term is below our limit, it won't affect the outcome
@@ -4731,8 +5114,6 @@ sub _pow {
         $factor->binc();
 
         last if $x->{sign} !~ /^[-+]$/;
-
-        #$steps++;
     }
 
     if ($do_invert) {
@@ -4795,6 +5176,7 @@ Math::BigFloat - Arbitrary size floating point math package
   $x = Math::BigFloat->from_oct('0377');        # ditto
   $x = Math::BigFloat->from_bin('0b1.1001p-4'); # from binary
   $x = Math::BigFloat->from_bin('0101');        # ditto
+  $x = Math::BigFloat->from_ieee754($b, "binary64");  # from IEEE-754 bytes
   $x = Math::BigFloat->bzero();                 # create a +0
   $x = Math::BigFloat->bone();                  # create a +1
   $x = Math::BigFloat->bone('-');               # create a -1
@@ -4926,6 +5308,7 @@ Math::BigFloat - Arbitrary size floating point math package
   $x->as_hex();       # as signed hexadecimal string with prefixed 0x
   $x->as_bin();       # as signed binary string with prefixed 0b
   $x->as_oct();       # as signed octal string with prefixed 0
+  $x->to_ieee754($format); # to bytes encoded according to IEEE 754-2008
 
   # Other conversion methods
 
@@ -5106,6 +5489,17 @@ using decimal digits.
 
 If called as an instance method, the value is assigned to the invocand.
 
+=item from_ieee754()
+
+Interpret the input as a value encoded as described in IEEE754-2008.  The input
+can be given as a byte string, hex string or binary string. The input is
+assumed to be in big-endian byte-order.
+
+        # both $dbl and $mbf are 3.141592...
+        $bytes = "\x40\x09\x21\xfb\x54\x44\x2d\x18";
+        $dbl = unpack "d>", $bytes;
+        $mbf = Math::BigFloat -> from_ieee754($bytes, "binary64");
+
 =item bpi()
 
     print Math::BigFloat->bpi(100), "\n";
@@ -5225,6 +5619,29 @@ C<ref($x)-E<gt>new()> can parse to create an object.
 
 In Math::BigFloat, C<as_float()> has the same effect as C<copy()>.
 
+=item to_ieee754()
+
+Encodes the invocand as a byte string in the given format as specified in IEEE
+754-2008. Note that the encoded value is the nearest possible representation of
+the value. This value might not be exactly the same as the value in the
+invocand.
+
+    # $x = 3.1415926535897932385
+    $x = Math::BigFloat -> bpi(30);
+
+    $b = $x -> to_ieee754("binary64");  # encode as 8 bytes
+    $h = unpack "H*", $b;               # "400921fb54442d18"
+
+    # 3.141592653589793115997963...
+    $y = Math::BigFloat -> from_ieee754($h, "binary64");
+
+All binary formats in IEEE 754-2008 are accepted. For convenience, som aliases
+are recognized: "half" for "binary16", "single" for "binary32", "double" for
+"binary64", "quadruple" for "binary128", "octuple" for "binary256", and
+"sexdecuple" for "binary512".
+
+See also L<https://en.wikipedia.org/wiki/IEEE_754>.
+
 =back
 
 =head2 ACCURACY AND PRECISION
@@ -5552,11 +5969,11 @@ L<http://annocpan.org/dist/Math-BigInt>
 
 =item * CPAN Ratings
 
-L<http://cpanratings.perl.org/dist/Math-BigInt>
+L<https://cpanratings.perl.org/dist/Math-BigInt>
 
-=item * Search CPAN
+=item * MetaCPAN
 
-L<http://search.cpan.org/dist/Math-BigInt/>
+L<https://metacpan.org/release/Math-BigInt>
 
 =item * CPAN Testers Matrix