``````use 5.010001;
use strict;
use warnings;

package BSON::Decimal128;
# ABSTRACT: BSON type wrapper for Decimal128

use version;
our \$VERSION = 'v1.12.2';

use Carp;
use Math::BigInt;

use Moo;

#pod =attr value
#pod
#pod The Decimal128 value represented as string.  If not provided, it will be
#pod generated from the C<bytes> attribute on demand.
#pod
#pod =cut

has 'value' => (
is => 'lazy',
);

#pod =attr bytes
#pod
#pod The Decimal128 value represented in L<Binary Integer
#pod Decimal|https://en.wikipedia.org/wiki/Binary_Integer_Decimal> (BID) format.
#pod If not provided, it will be generated from the C<value> attribute on
#pod demand.
#pod
#pod =cut

has 'bytes' => (
is => 'lazy',
);

use namespace::clean -except => 'meta';

use constant {
PLIM  => 34,    # precision limit, i.e. max coefficient chars
EMAX  => 6144,  # for 9.999999999999999999999999999999999E+6144
EMIN  => -6143, # for 1.000000000000000000000000000000000E-6143
AEMAX => 6111,  # EMAX - (PLIM - 1); largest encodable exponent
AEMIN => -6176, # EMIN - (PLIM - 1); smallest encodable exponent
BIAS  => 6176,  # offset for encoding exponents
};

my \$digits     = qr/[0-9]+/;
my \$decimal_re = qr{
( [-+]? )                                        # maybe a sign
( (?:\$digits \. \$digits? ) | (?: \.? \$digits ) ) # decimal-part
( (?:e [-+]? \$digits)? )                         # maybe exponent
}ix;

sub _build_value {
return _bid_to_string( \$_->{bytes} );
}

sub _build_bytes {
return _string_to_bid( \$_->{value} );
}

sub BUILD {
my \$self = shift;

croak "One and only one of 'value' or 'bytes' must be provided"
unless 1 == grep { exists \$self->{\$_} } qw/value bytes/;

# must check for errors and canonicalize value if provided
if (exists \$self->{value}) {
\$self->{value} = _bid_to_string( \$self->bytes );
}

return;
}

sub _bid_to_string {
my \$bid = shift;
my \$binary = unpack( "B*", scalar reverse(\$bid) );
my ( \$coef, \$e );

# sign bit
my \$pos = !substr( \$binary, 0, 1 );

# detect special values from first 5 bits after sign bit
my \$special = substr( \$binary, 1, 5 );
if ( \$special eq "11111" ) {
return "NaN";
}
if ( \$special eq "11110" ) {
return \$pos ? "Infinity" : "-Infinity";
}

if ( substr( \$binary, 1, 2 ) eq '11' ) {
# Bits: 1*sign 2*ignored 14*exponent 111*significand.
# Implicit 0b100 prefix in significand.
\$coef = "" . Math::BigInt->new( "0b100" . substr( \$binary, 17 ) );
\$e = unpack( "n", pack( "B*", "00" . substr( \$binary, 3, 14 ) ) ) - BIAS;
}
else {
# Bits: 1*sign 14*exponent 113*significand
\$coef = "" . Math::BigInt->new( "0b" . substr( \$binary, 15 ) );
\$e = unpack( "n", pack( "B*", "00" . substr( \$binary, 1, 14 ) ) ) - BIAS;
}

# Out of range is treated as zero
if ( length(\$coef) > PLIM ) {
\$coef = "0";
}

# Shortcut on zero
if ( \$coef == 0 && \$e == 0 ) {
return \$pos ? "0" : "-0";
}

# convert to scientific form ( e.g. 123E+4 -> 1.23E6 )
my \$adj_exp = \$e + length(\$coef) - 1;
# warn "# XXX COEF: \$coef; EXP: \$e; AEXP: \$adj_exp\n";

# exponential notation
if ( \$e > 0 || \$adj_exp < -6 ) {
# insert decimal if more than one digit
if ( length(\$coef) > 1 ) {
substr( \$coef, 1, 0, "." );
}

return (
( \$pos ? "" : "-" ) . \$coef . "E" . ( \$adj_exp >= 0 ? "+" : "" ) . \$adj_exp );
}

# not exponential notation (integers or small negative exponents)
else {
# e == 0 means integer
return \$pos ? \$coef : "-\$coef"
if \$e == 0;

if ( length(\$coef) < abs(\$e) ) {
substr( \$coef, 0, 0, "0" x ( abs(\$e) - length(\$coef) ) );
}

# maybe coefficient is exact length?
return \$pos ? "0.\$coef" : "-0.\$coef"
if length(\$coef) == abs(\$e);

# otherwise length(coef) > abs(\$e), so insert dot after first digit
substr( \$coef, \$e, 0, "." );
return \$pos ? \$coef : "-\$coef";
}
}

my ( \$bidNaN, \$bidPosInf, \$bidNegInf ) =
map { scalar reverse pack( "B*", \$_ . ( "0" x 118 ) ) } qw/ 011111 011110 111110 /;

sub _croak { croak("Couldn't parse '\$_' as valid Decimal128") }

sub _erange { croak("Value '\$_' is out of range for Decimal128") }

sub _erounding { croak("Value '\$_' can't be rounded to Decimal128") }

sub _string_to_bid {
my \$s = shift;

# Check special values
return \$bidNaN    if \$s =~ /\A -? NaN \z/ix;
return \$bidPosInf if \$s =~ /\A \+?Inf(?:inity)? \z/ix;
return \$bidNegInf if \$s =~ /\A -Inf(?:inity)? \z/ix;

# Parse string
my ( \$sign, \$mant, \$exp ) = \$s =~ /\A \$decimal_re \z/x;
\$sign = "" unless defined \$sign;
\$exp = 0 unless defined \$exp && length(\$exp);
\$exp =~ s{^e}{}i;

# Throw error if unparseable
_croak(\$s) unless length \$exp && defined \$mant;

# Extract sign bit
my \$neg = defined(\$sign) && \$sign eq '-' ? "1" : "0";

# Remove leading zeroes unless "0."
\$mant =~ s{^(?:0(?!\.))+}{};

# Locate decimal, remove it and adjust the exponent
my \$dot = index( \$mant, "." );
\$mant =~ s/\.//;
\$exp += \$dot - length(\$mant) if \$dot >= 0;

# Remove leading zeros from mantissa (after decimal point removed)
\$mant =~ s/^0+//;
\$mant = "0" unless length \$mant;

# Apply exact rounding if necessary
if ( length(\$mant) > PLIM ) {
my \$plim = PLIM;
\$mant =~ s{(.{\$plim})(0+)\$}{\$1};
\$exp += length(\$2) if defined \$2 && length \$2;
}
elsif ( \$exp < AEMIN ) {
\$mant =~ s{(.*[1-9])(0+)\$}{\$1};
\$exp += length(\$2) if defined \$2 && length \$2;
}

# Apply clamping if possible
if ( \$mant == 0 ) {
if ( \$exp > AEMAX ) {
\$mant = "0";
\$exp = AEMAX;
}
elsif ( \$exp < AEMIN ) {
\$mant = "0";
\$exp = AEMIN;
}
}
elsif ( \$exp > AEMAX && \$exp - AEMAX <= PLIM - length(\$mant) ) {
\$mant .= "0" x ( \$exp - AEMAX );
\$exp = AEMAX;
}

# Throw errors if result won't fit in Decimal128
_erounding(\$s) if length(\$mant) > PLIM;
_erange(\$s) if \$exp > AEMAX || \$exp < AEMIN;

# Get binary representation of coefficient
my \$coef = Math::BigInt->new(\$mant)->as_bin;
\$coef =~ s/^0b//;

# Get 14-bit binary representation of biased exponent
my \$biased_exp = unpack( "B*", pack( "n", \$exp + BIAS ) );
substr( \$biased_exp, 0, 2, "" );

# Choose representation based on coefficient length
my \$coef_len = length(\$coef);
if ( \$coef_len <= 113 ) {
substr( \$coef, 0, 0, "0" x ( 113 - \$coef_len ) );
return scalar reverse pack( "B*", \$neg . \$biased_exp . \$coef );
}
elsif ( \$coef_len <= 114 ) {
substr( \$coef, 0, 3, "" );
return scalar reverse pack( "B*", \$neg . "11" . \$biased_exp . \$coef );
}
else {
_erange(\$s);
}
}

#pod =method TO_JSON
#pod
#pod Returns the value as a string.
#pod
#pod If the C<BSON_EXTJSON> option is true, it will instead
#pod be compatible with MongoDB's L<extended JSON|https://github.com/mongodb/specifications/blob/master/source/extended-json.rst>
#pod format, which represents it as a document as follows:
#pod
#pod     {"\$numberDecimal" : "2.23372036854775807E+57"}
#pod
#pod =cut

sub TO_JSON {
return "" . \$_->value unless \$ENV{BSON_EXTJSON};
return { '\$numberDecimal' => "" . (\$_->value)  };
}

q{""}    => sub { \$_->value },
fallback => 1,
);

1;

=pod

=encoding UTF-8

BSON::Decimal128 - BSON type wrapper for Decimal128

version v1.12.2

use BSON::Types ':all';

# string representation
\$decimal = bson_decimal128( "1.23456789E+1000" );

# binary representation in BID format
\$decimal = BSON::Decimal128->new( bytes => \$bid )

This module provides a BSON type wrapper for Decimal128 values.

It may be initialized with either a numeric value in string form, or
with a binary Decimal128 representation (16 bytes), but not both.

Initialization from a string will throw an error if the string cannot be
parsed as a Decimal128 or if the resulting number would not fit into 128
bits.  If required, clamping or exact rounding will be applied to try to
fit the value into 128 bits.

The Decimal128 value represented as string.  If not provided, it will be
generated from the C<bytes> attribute on demand.

The Decimal128 value represented in L<Binary Integer
Decimal|https://en.wikipedia.org/wiki/Binary_Integer_Decimal> (BID) format.
If not provided, it will be generated from the C<value> attribute on
demand.

Returns the value as a string.

If the C<BSON_EXTJSON> option is true, it will instead
be compatible with MongoDB's L<extended JSON|https://github.com/mongodb/specifications/blob/master/source/extended-json.rst>
format, which represents it as a document as follows:

{"\$numberDecimal" : "2.23372036854775807E+57"}

=for Pod::Coverage BUILD

The stringification operator (C<"">) is overloaded to return a (normalized)

=over 4

=item *

David Golden <david@mongodb.com>

=item *

Stefan G. <minimalist@lavabit.com>

=back

This software is Copyright (c) 2020 by Stefan G. and MongoDB, Inc.

This is free software, licensed under:

The Apache License, Version 2.0, January 2004

=cut

__END__

# vim: set ts=4 sts=4 sw=4 et tw=75:
``````
{"ft_lang_label":"__label__en","ft_lang_prob":0.5271149,"math_prob":0.9196903,"size":8693,"snap":"2022-40-2023-06","text_gpt3_token_len":2815,"char_repetition_ratio":0.122108415,"word_repetition_ratio":0.111930296,"special_character_ratio":0.39790636,"punctuation_ratio":0.20124224,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.9953427,"pos_list":[0],"im_url_duplicate_count":[null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2023-02-09T06:31:41Z\",\"WARC-Record-ID\":\"<urn:uuid:e0e06797-089f-4159-9200-a5f30c589f76>\",\"Content-Length\":\"26799\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:1f224db0-e13c-4d26-b400-12361ea99fbb>\",\"WARC-Concurrent-To\":\"<urn:uuid:76914e24-0fa1-49a0-80f9-5fc2e21e2172>\",\"WARC-IP-Address\":\"146.75.34.217\",\"WARC-Target-URI\":\"https://web-stage.metacpan.org/release/MONGODB/BSON-v1.12.2/source/lib/BSON/Decimal128.pm\",\"WARC-Payload-Digest\":\"sha1:UJHPJ4PD6JVJNROCFFKSSV4PCQBXMHRM\",\"WARC-Block-Digest\":\"sha1:23ML25UTUIVPPZG5S5MBHBPV4W2VBFSB\",\"WARC-Identified-Payload-Type\":\"text/html\",\"warc_filename\":\"/cc_download/warc_2023/CC-MAIN-2023-06/CC-MAIN-2023-06_segments_1674764501407.6_warc_CC-MAIN-20230209045525-20230209075525-00310.warc.gz\"}"}