BSON

 view release on metacpan or  search on metacpan

lib/BSON.pm  view on Meta::CPAN

#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};

lib/BSON.pm  view on Meta::CPAN

            );
        }

        if ( exists $data->{'$numberDecimal'} ) {
            return BSON::Decimal128->new( value => $data->{'$numberDecimal'} );
        }

        # Following extended JSON is non-standard

        if ( exists $data->{'$numberDouble'} ) {
            if ( $data->{'$numberDouble'} eq '-0' && $] lt '5.014' && ! HAS_LD ) {
                $data->{'$numberDouble'} = '-0.0';
            }
            return BSON::Double->new( value => $data->{'$numberDouble'} );
        }

        if ( exists $data->{'$symbol'} ) {
            return BSON::Symbol->new(value => $data->{'$symbol'});
        }

        for my $key (keys %$data) {

lib/BSON.pm  view on Meta::CPAN

        return BSON::DBRef->new( '$ref' => $hash->{'$ref'}, '$id' => $id );
    }

    if ( exists $hash->{'$numberDecimal'} ) {
        return BSON::Decimal128->new( value => $hash->{'$numberDecimal'} );
    }

    # Following extended JSON is non-standard

    if ( exists $hash->{'$numberDouble'} ) {
        if ( $hash->{'$numberDouble'} eq '-0' && $] lt '5.014' && ! HAS_LD ) {
            $hash->{'$numberDouble'} = '-0.0';
        }
        return BSON::Double->new( value => $hash->{'$numberDouble'} );
    }

    if ( exists $hash->{'$symbol'} ) {
        return $hash->{'$symbol'};
    }

    return $hash;

lib/BSON/Double.pm  view on Meta::CPAN

#pod 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     {"$numberDouble" : "42.0"}
#pod
#pod If C<BSON_EXTJSON> is false and the value is 'Inf', '-Inf' or 'NaN'
#pod (which are illegal in regular JSON), then an exception is thrown.
#pod
#pod =cut

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

my $win32_specials = qr/-?1.\#IN[DF]/i;
my $unix_specials = qr/-?(?:inf|nan)/i;
my $illegal = $use_win32_specials ? qr/^$win32_specials/ : qr/^$unix_specials/;

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 TO_JSON {

lib/BSON/PP.pm  view on Meta::CPAN

};

sub _printable {
    my $value = shift;
    $value =~ s/([^[:print:]])/sprintf("\\x%02x",ord($1))/ge;
    return $value;
}

sub _split_re {
    my $value = shift;
    if ( $] ge 5.010 ) {
        return re::regexp_pattern($value);
    }
    else {
        $value =~ s/^\(\?\^?//;
        $value =~ s/\)$//;
        my ( $opt, $re ) = split( /:/, $value, 2 );
        $opt =~ s/\-\w+$//;
        return ( $re, $opt );
    }
}

t/legacy/02-oid.t  view on Meta::CPAN

my $try = eval { my $o5 = BSON::ObjectId->new('abcde'); 1 };
isnt( $try, 1, 'Dies 1' );

$try = eval { my $o5 = BSON::ObjectId->new('12345678901234567890123$'); 1 };
isnt( $try, 1, 'Dies 2' );


SKIP: {
    skip "No threads during coverage testing", 39 if COVERTEST;
    skip "No threads", 39 unless $Config{useithreads};
    skip "Threads not supported before 5.8.5", 39 if $] lt "5.008005";
    my @threads = map {
        threads->create(
            sub {
                [ map { BSON::ObjectId->new } 0 .. 3 ];
            }
        );
    } 0 .. 9;

    my @oids = map { @{ $_->join } } @threads;

t/legacy/10-bson.t  view on Meta::CPAN

    is_deeply(
        [ unpack "C*", $bson ],
        \@expected_bytes,
        'Regex encode'
    );
    my $hash = decode( $bson );
    is(ref $hash->{a}, 'BSON::Regex');
    is(ref $hash->{b}, 'BSON::Regex');

    SKIP: {
        skip "Comparing regexes is fragile before 5.10", 1 if $] lt 5.010;
        $hash->{$_} = $hash->{$_}->try_compile for qw/a b/;
        for (qw/a b/) {
            is_deeply(
                [ re::regexp_pattern( $hash->{$_} ) ],
                [ re::regexp_pattern( $h{$_} ) ],
                "Regex decode of key $_",
            );
        }
    }

t/legacy/10-bson.t  view on Meta::CPAN

            40,  63, 58, 40, 63,  58,  91, 69,  93,  41, 40, 63,
            58,  40, 63, 58, 91,  43,  45, 93,  63,  41, 40, 63,
            58,  91, 48, 49, 50,  51,  52, 53,  54,  55, 56, 57,
            93,  43, 41, 41, 124, 41,  41, 0,   105, 0,  0
        ],
        'real num regex'
    );
    $hash = decode( $bson );
    is(ref $hash->{a}, 'BSON::Regex');
    SKIP: {
        skip "Comparing regexes is fragile before 5.10", 2 if $] lt 5.010;
        $hash->{a} = $hash->{a}->try_compile;
        # after try_compile, "i" flags are put into the regex, so we must
        # do the same with the original
        my ($p,$f) = re::regexp_pattern($h{a});
        $h{a} = qr{(?$f:$p)};
        is_deeply(
            [ re::regexp_pattern( $hash->{a} ) ],
            [ re::regexp_pattern( $h{a} ) ],
            "Regex decode of key a",
        );