The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

package Flube;

sub new {
    return bless {}, shift;
}

package main;

use strict;
use warnings;
use Test::More;
use Data::Dumper;
use Data::BISON::Decoder;

my @tests;

BEGIN {
    my @FMB    = ( 0x46, 0x4d, 0x42 );
    my @FMB2   = ( 0x46, 0x4d, 0x42, 0xFF, 0x02, 0x00 );
    my @FMB2br = ( 0x46, 0x4d, 0x42, 0xFF, 0x02, 0x80 );

    my @hello = ( 0x68, 0x65, 0x6c, 0x6c, 0x6f, 0x00 );
    my @abc = ( 0x61, 0x62, 0x63, 0x00 );

    my @hello_world = (
        0x0f, 0x48, 0x65, 0x6c, 0x6c, 0x6f, 0x2c, 0x20,
        0x57, 0x6f, 0x72, 0x6c, 0x64, 0x00
    );
    my @xyz = ( 0x0f, 0x78, 0x79, 0x7a, 0x00 );
    my @two_string_hash
      = ( 0x11, 0x02, 0x00, @abc, @xyz, @hello, @hello_world );

    @tests = (

        # undef
        {
            name    => 'Undef',
            options => {},
            data    => [ @FMB, 0x02 ],
            expect  => undef,
        },

        # Strings
        {
            name    => 'Simple string',
            options => {},
            data    => [ @FMB, @hello_world ],
            expect  => 'Hello, World',
        },
        {
            name    => 'String w/ embedded null',
            options => {},
            data =>
              [ @FMB, 0x0F, 0x5C, 0x00, 0x20, 0x6e, 0x75, 0x6c, 0x6c, 0x00 ],
            expect => "\0 null",
        },
        {
            name    => 'String w/ backslash and null',
            options => {},
            data    => [
                @FMB, 0x0F, 0x5C, 0x00, 0x5C, 0x5C,
                0x20, 0x6e, 0x75, 0x6c, 0x6c, 0x00
            ],
            expect => "\0\\ null",
        },

        # Integers
        {
            name    => 'Integer, zero',
            options => {},
            data    => [ @FMB, 0x05, 0x00 ],
            expect  => 0,
        },
        {
            name    => 'Integer, positive, 1 byte',
            options => {},
            data    => [ @FMB, 0x05, 0x7F ],
            expect  => 127,
        },
        {
            name    => 'Integer, -1',
            options => {},
            data    => [ @FMB, 0x05, 0xFF ],
            expect  => -1,
        },
        {
            name    => 'Integer, positive, 2 bytes, edge',
            options => {},
            data    => [ @FMB, 0x06, 0x80, 0x00 ],
            expect  => 128,
        },
        {
            name    => 'Integer, positive, 2 bytes',
            options => {},
            data    => [ @FMB, 0x06, 0xFF, 0x00 ],
            expect  => 255,
        },
        {
            name    => 'Integer, negative, 1 byte',
            options => {},
            data    => [ @FMB, 0x05, 0x80 ],
            expect  => -128,
        },
        {
            name    => 'Integer, negative, 2 bytes',
            options => {},
            data    => [ @FMB, 0x06, 0x01, 0xFF ],
            expect  => -255,
        },
        {
            name    => 'Integer, positive, 3 bytes',
            options => {},
            data    => [ @FMB, 0x07, 0x00, 0x00, 0x7F ],
            expect  => 0x7F0000,
        },
        {
            name    => 'Integer, negative, 3 bytes',
            options => {},
            data    => [ @FMB, 0x07, 0x00, 0x00, 0x81 ],
            expect  => -0x7F0000,
        },
        {
            name    => 'Integer, positive, 4 bytes',
            options => {},
            data    => [ @FMB, 0x08, 0x00, 0x00, 0x00, 0x7F ],
            expect  => 0x7F000000,
        },
        {
            name    => 'Integer, negative, 4 bytes',
            options => {},
            data    => [ @FMB, 0x08, 0x00, 0x00, 0x00, 0x81 ],
            expect  => -0x7F000000,
        },

        # Arrays
        {
            name    => 'Array, empty',
            options => {},
            data    => [ @FMB, 0x10, 0x00, 0x00 ],
            expect  => [],
        },
        {
            name    => 'Array, one string',
            options => {},
            data    => [ @FMB, 0x10, 0x01, 0x00, @hello_world ],
            expect  => ['Hello, World'],
        },
        {
            name    => 'Array, two strings',
            options => {},
            data    => [ @FMB, 0x10, 0x02, 0x00, @hello_world, @hello_world ],
            expect => [ 'Hello, World', 'Hello, World' ],
        },

        # Hashes
        {
            name    => 'Hash, empty',
            options => {},
            data    => [ @FMB, 0x11, 0x00, 0x00 ],
            expect  => {},
        },
        {
            name    => 'Hash, one string',
            options => {},
            data    => [ @FMB, 0x11, 0x01, 0x00, @hello, @hello_world ],
            expect => { 'hello' => 'Hello, World' },
        },
        {
            name    => 'Hash, two strings',
            options => {},
            data =>
              [ @FMB, 0x11, 0x02, 0x00, @abc, @xyz, @hello, @hello_world ],
            expect => { 'hello' => 'Hello, World', 'abc' => 'xyz' },
        },

        # More complex structures
        {
            name    => 'Array of hash of strings',
            options => {},
            data =>
              [ @FMB, 0x10, 0x02, 0x00, @two_string_hash, @two_string_hash ],
            expect => [
                { 'hello' => 'Hello, World', 'abc' => 'xyz' },
                { 'hello' => 'Hello, World', 'abc' => 'xyz' }
            ],
        },

        # Version 2 data
        {
            name    => 'Simple string, V2',
            options => {},
            data    => [ @FMB2, @hello_world ],
            expect  => 'Hello, World',
        },
        {
            name    => 'Simple string, V2, backref',
            options => {},
            data    => [ @FMB2br, @hello_world ],
            expect  => 'Hello, World',
        },
        {
            name    => 'Backref to string',
            options => {},
            data    => [ @FMB2br, 0x10, 0x02, 0x00, @hello_world, 0x14, 0x01, 0x00 ],
            expect  => [ 'Hello, World', 'Hello, World' ],
        },

    );

    plan tests => 3 * @tests;
}

sub dumpb {
    return join( ', ', map { sprintf( '0x%02x', $_ ) } @_ );
}

for my $test ( @tests ) {
    my $name = $test->{name};
    ok my $dec = Data::BISON::Decoder->new( $test->{options} ),
      "$name: create OK";
    isa_ok $dec, 'Data::BISON::Decoder';
    my $data = join( '', map { chr $_ } @{ $test->{data} } );
    my $got = $dec->decode( $data );
    unless ( is_deeply $got, $test->{expect}, "$name: data matches" ) {
        diag "Data: ", dumpb( @{ $test->{data} } );
        diag( Data::Dumper->Dump( [$got], ['$got'] ) );
        diag( Data::Dumper->Dump( [ $test->{expect} ], ['$exp'] ) );
    }
}