view release on metacpan or  search on metacpan

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

            0,   26, 0, 0,  0,  16, 48,  0,   1,   0, 0,  0,  16,  49,
            0,   2,  0, 0,  0,  16, 50,  0,   3,   0, 0,  0,  0,   2,
            98,  0,  4, 0,  0,  0,  102, 111, 111, 0, 0,  0
        ],
        'Hash 2 encode'
    );
    is_deeply( decode($bson), \%h, 'Hash 2 decode' );
};

# Regex
subtest regex => sub {
    plan tests => 9;

    my @sp = BSON::PP::_split_re(qr/\w/i);
    is_deeply(\@sp, ['\w', 'i']);

    my $re1_str = q!"(?:[^"\\\]++|\\\.)*+"!;
    my @re1_bytes = (
        34,  40, 63, 58, 91, 94, 34, 92, 92, 93, 43, 43,
        124, 92, 92, 46, 41, 42, 43, 34, 0,  0
    );
    my $re2_str = q!"(?>(?:(?>[^"\\\]+)|\\\.)*)"!;
    my @re2_bytes = (
        34, 40, 63, 62, 40, 63, 58,  40, 63, 62, 91, 94,
        34, 92, 92, 93, 43, 41, 124, 92, 92, 46, 41, 42,
        41, 34, 0,  0
    );

    my @expected_bytes;
    if ($] >= 5.01) {
        # first regex works only on perl >= 5.10
        %h = eval { ( a => qr/$re1_str/, b => qr/$re2_str/ ) };
        die "Can't eval regexes: $@" if $@;
        @expected_bytes = (
            61, 0,  0, 0,
            11, 97, 0, @re1_bytes,
            11, 98, 0, @re2_bytes,
            0
        );
    } else {
        %h = (a => qr/$re2_str/, b => qr/$re2_str/);
        @expected_bytes = (
            67, 0,  0, 0,
            11, 97, 0, @re2_bytes,
            11, 98, 0, @re2_bytes,
            0
        );
    }

    my $bson = encode( \%h );
    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 $_",
            );
        }
    }

    #<<<
    %h = ( a => qr/(?:(?:[+-]?)(?:(?=[0123456789]|[.])(?:[0123456789]*)(?:(?:[.])(?:[0123456789]{0,}))?)(?:(?:[E])(?:(?:[+-]?)(?:[0123456789]+))|))/i );
    #>>>
    $bson = encode(\%h);
    is_deeply(
        [ unpack "C*", $bson ],
        [
            139, 0,  0,  0,  11,  97,  0,  40,  63,  58, 40, 63,
            58,  91,  43, 45,  93,  63, 41, 40,
            63,  58, 40, 63, 61,  91,  48, 49,  50,  51, 52, 53,
            54,  55, 56, 57, 93,  124, 91, 46,  93,  41, 40, 63,
            58,  91, 48, 49, 50,  51,  52, 53,  54,  55, 56, 57,
            93,  42, 41, 40, 63,  58,  40, 63,  58,  91, 46, 93,
            41,  40, 63, 58, 91,  48,  49, 50,  51,  52, 53, 54,
            55,  56, 57, 93, 123, 48,  44, 125, 41,  41, 63, 41,
            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",
        );
    }
};

# Datetime
subtest datetime => sub {
    eval { require DateTime };
    plan skip_all => "Needs DateTime" unless $INC{"DateTime.pm"};
    plan tests => 6;

    my $dt = DateTime->new(
        year      => 1974,
        month     => 10,
        day       => 15,
        hour      => 22,
        minute    => 50,
        second    => 8,
        time_zone => 'UTC'
    );
    my $h = { a => BSON::Time->new( $dt->epoch ) };
    my $bson = encode( $h );
    #<<<
    is_deeply(
        [ unpack "C*", $bson ],
        [ 16, 0, 0, 0, 9, 97, 0, 0, 149, 210, 46, 35, 0, 0, 0, 0 ],
        'encode 1974'
    );
    #>>>
    is_deeply( decode($bson), $h, 'decode 1974' );

    $dt = DateTime->new(
        year      => 1964,
        month     => 10,
        day       => 15,
        hour      => 22,
        minute    => 50,
        second    => 8,
        time_zone => 'UTC'
    );
    $h = { a => BSON::Time->new( $dt->epoch ) };
    $bson = encode( $h );
    #<<<
    is_deeply(
        [ unpack "C*", $bson ],
        [16, 0, 0, 0, 9, 97, 0, 0, 37, 154, 183, 217, 255, 255, 255, 0],
        'encode 1964'
    );
    #>>>
    is_deeply( decode($bson), $h, 'decode 1964' );

    $dt = DateTime->new(