#!/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'] ) ); } }