view release on metacpan or  search on metacpan

lib/BSON.pm  view on Meta::CPAN

#pod
#pod     use JSON::MaybeXS;
#pod     my $ext = BSON->perl_to_extjson($data, \%options);
#pod     my $json = encode_json($ext);
#pod
#pod Takes a perl data structure (i.e. hashref) and turns it into an
#pod L<MongoDB Extended JSON|https://github.com/mongodb/specifications/blob/master/source/extended-json.rst>
#pod structure. Note that the structure will still have to be serialized.
#pod
#pod Possible options are:
#pod
#pod =for :list
#pod * C<relaxed> A boolean indicating if "relaxed extended JSON" should
#pod be generated. If not set, the default value is taken from the
#pod C<BSON_EXTJSON_RELAXED> environment variable.
#pod
#pod =cut

my $use_win32_specials = ($^O eq 'MSWin32' && $] lt "5.022");

my $is_inf = $use_win32_specials ? qr/^1.\#INF/i : qr/^inf/i;
my $is_ninf = $use_win32_specials ? qr/^-1.\#INF/i : qr/^-inf/i;
my $is_nan = $use_win32_specials ? qr/^-?1.\#(?:IND|QNAN)/i : qr/^-?nan/i;

sub perl_to_extjson {
    my ($class, $data, $options) = @_;

    local $ENV{BSON_EXTJSON} = 1;
    local $ENV{BSON_EXTJSON_RELAXED} = $ENV{BSON_EXTJSON_RELAXED};
    $ENV{BSON_EXTJSON_RELAXED} = $options->{relaxed};

    if (not defined $data) {
        return undef; ## no critic
    }

    if (blessed($data) and $data->can('TO_JSON')) {
        my $json_data = $data->TO_JSON;
        return $json_data;
    }

    if (not ref $data) {

        if (looks_like_number($data)) {
            if ($ENV{BSON_EXTJSON_RELAXED}) {
                return $data;
            }

            if ($data =~ m{\A-?[0-9_]+\z}) {
                if ($data <= $max_int32) {
                    return { '$numberInt' => "$data" };
                }
                else {
                    return { '$numberLong' => "$data" };
                }
            }
            else {
                return { '$numberDouble' => 'Infinity' }
                    if $data =~ $is_inf;
                return { '$numberDouble' => '-Infinity' }
                    if $data =~ $is_ninf;
                return { '$numberDouble' => 'NaN' }
                    if $data =~ $is_nan;
                my $value = "$data";
                $value = $value / 1.0;
                return { '$numberDouble' => "$value" };
            }
        }

        return $data;
    }

    if (boolean::isBoolean($data)) {
        return $data;
    }

    if (ref $data eq 'HASH') {
        for my $key (keys %$data) {
            my $value = $data->{$key};
            $data->{$key} = $class->perl_to_extjson($value, $options);
        }
        return $data;
    }

    if (ref $data eq 'ARRAY') {
        for my $index (0 .. $#$data) {
            my $value = $data->[$index];
            $data->[$index] = $class->perl_to_extjson($value, $options);
        }
        return $data;
    }

    if (blessed($data) and $data->isa('JSON::PP::Boolean')) {
        return $data;
    }

    if (
        blessed($data) and (
            $data->isa('Math::BigInt') or
            $data->isa('Math::BigFloat')
        )
    ) {
        return $data;
    }

    die sprintf "Unsupported ref value (%s)", ref($data);
}

#pod =method extjson_to_perl
#pod
#pod     use JSON::MaybeXS;
#pod     my $ext = decode_json($json);
#pod     my $data = $bson->extjson_to_perl($ext);
#pod
#pod Takes an
#pod L<MongoDB Extended JSON|https://github.com/mongodb/specifications/blob/master/source/extended-json.rst>
#pod data structure and inflates it into a Perl data structure. Note that
#pod you have to decode the JSON string manually beforehand.
#pod
#pod Canonically specified numerical values like C<{"$numberInt":"23"}> will
#pod be inflated into their respective C<BSON::*> wrapper types. Plain numeric
#pod values will be left as-is.