The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use 5.008001;
use strict;
use warnings;
use utf8;

use Test::More 0.96;
BEGIN { $ENV{PERL_BSON_BACKEND} = "" }
BEGIN { $INC{"BSON/XS.pm"} = undef }

binmode( Test::More->builder->$_, ":utf8" )
  for qw/output failure_output todo_output/;

use lib 't/lib';
use TestUtils;

use BSON qw/encode decode/;
use BSON::Types ':all';
use Tie::IxHash;

my ($hash);

# test BSON::Doc constructor
is( scalar @{bson_doc()}, 0, "empty bson_doc() is empty doc" );
is( scalar @{BSON::Doc->new}, 0, "empty constructor is empty doc" );

eval { bson_doc( a => 1, b => 2, a => 3, c => 4 ) };
like( $@, qr/duplicate keys not allowed/i, "duplicate keys in bson_doc() throw error" );

# test overloading
# XXX TBD

my @kv = qw/A B/;

subtest "Top level document" => sub {

    # hashref -> hashref
    $hash = decode( encode( { @kv } ) );
    is( ref($hash), 'HASH', "hashref->hashref" );
    is_deeply( $hash, { @kv }, "value correct" );

    # BSON::Doc -> hashref
    $hash = decode( encode( bson_doc( @kv ) ) );
    is( ref($hash), 'HASH', "BSON::Doc->hashref" );
    is_deeply( $hash, { @kv }, "value correct" );

    # BSON::Raw -> hashref
    $hash = decode( encode( bson_raw( encode { @kv } ) ) );
    is( ref($hash), 'HASH', "BSON::Raw->hashref" );
    is_deeply( $hash, { @kv }, "value correct" );

    # MongoDB::BSON::Raw -> hashref
    my $raw = encode({@kv});
    $hash = decode( encode( bless \$raw, "MongoDB::BSON::Raw" ) );
    is( ref($hash), 'HASH', "MongoDB::BSON::Raw->hashref" );
    is_deeply( $hash, { @kv }, "value correct" );

    # Tie::IxHash tied hashref
    tie my %ixhash, 'Tie::IxHash', @kv;
    $hash = decode( encode( \%ixhash ) );
    is( ref($hash), 'HASH', "Tie::IxHash(tied)->hashref" );
    is_deeply( $hash, { @kv }, "value correct" );

    # Tie::IxHash object
    my $ixdoc = Tie::IxHash->new(@kv);
    $hash = decode( encode( $ixdoc ) );
    is( ref($hash), 'HASH', "Tie::IxHash(OO)->hashref" );
    is_deeply( $hash, { @kv }, "value correct" );

    SKIP: {
        eval { require MongoDB::BSON::_EncodedDoc };
        skip( "MongoDB::BSON::_EncodedDoc not installed", 4 )
        unless $INC{'MongoDB/BSON/_EncodedDoc.pm'};
        $hash = decode( encode( MongoDB::BSON::_EncodedDoc->new( bson => $raw, metadata => {} ) ) );
        is( ref($hash), 'HASH', "MongoDB::BSON::_EncodedDoc->hashref" );
        is_deeply( $hash, { @kv }, "value correct" );
    }

};

subtest "Subdocument" => sub {

    # hashref -> hashref
    $hash = decode( encode( { doc => { @kv } } ) );
    is( ref($hash->{doc}), 'HASH', "hashref->hashref" );
    is_deeply( $hash, { doc => { @kv } }, "value correct" );

    # BSON::Doc -> hashref
    $hash = decode( encode( { doc => bson_doc( @kv ) } ) );
    is( ref($hash->{doc}), 'HASH', "BSON::Doc->hashref" );
    is_deeply( $hash->{doc}, { @kv }, "value correct" );

    # BSON::Raw -> hashref
    $hash = decode( encode( { doc => bson_raw( encode( { @kv } ) ) } ) );
    is( ref($hash->{doc}), 'HASH', "BSON::Raw->hashref" );
    is_deeply( $hash->{doc}, { @kv }, "value correct" );

    # MongoDB::BSON::Raw -> hashref
    my $raw = encode({@kv});
    $hash = decode( encode( { doc => bless \$raw, "MongoDB::BSON::Raw" } ) );
    is( ref($hash->{doc}), 'HASH', "MongoDB::BSON::Raw->hashref" );
    is_deeply( $hash->{doc}, { @kv }, "value correct" );

    # Tie::IxHash tied hashref
    tie my %ixhash, 'Tie::IxHash', @kv;
    $hash = decode( encode( { doc => \%ixhash } ) );
    is( ref($hash->{doc}), 'HASH', "Tie::IxHash(tied)->hashref" );
    is_deeply( $hash->{doc}, { @kv }, "value correct" );

    # Tie::IxHash object
    my $ixdoc = Tie::IxHash->new(@kv);
    $hash = decode( encode( { doc => $ixdoc } ) );
    is( ref($hash->{doc}), 'HASH', "Tie::IxHash(OO)->hashref" );
    is_deeply( $hash->{doc}, { @kv }, "value correct" );

    SKIP: {
        eval { require MongoDB::BSON::_EncodedDoc };
        skip( "MongoDB::BSON::_EncodedDoc not installed", 4 )
        unless $INC{'MongoDB/BSON/_EncodedDoc.pm'};
        $hash = decode( encode( { doc => MongoDB::BSON::_EncodedDoc->new( bson => $raw, metadata => {} ) } ) );
        is( ref($hash->{doc}), 'HASH', "MongoDB::BSON::_EncodedDoc->hashref" );
        is_deeply( $hash->{doc}, { @kv }, "value correct" );
    }
};

subtest "Ordered top level doc" => sub {
    # hashref -> hashref
    $hash = decode( encode( { @kv } ), ordered => 1 );
    is( ref($hash), 'HASH', "hashref->hashref(ordered)" );
    ok( tied(%$hash), "hashref is tied" );
    is_deeply( $hash, { @kv }, "value correct" );

    # BSON::Doc -> hashref
    $hash = decode( encode( bson_doc( @kv, C => 'D' ) ), ordered => 1 );
    tie my %ixhash, 'Tie::IxHash', @kv, C => 'D';
    is( ref($hash), 'HASH', "BSON::Doc->hashref" );
    ok( tied(%$hash), "hashref is tied" );
    is_deeply( $hash, \%ixhash, "value correct" );

};

subtest "Ordered subdoc" => sub {

    # hashref -> hashref
    $hash = decode( encode( { doc => { @kv } } ), ordered => 1 );
    is( ref($hash->{doc}), 'HASH', "hashref->hashref" );
    ok( tied(%{$hash->{doc}}), "hashref is tied" );
    is_deeply( $hash, { doc => { @kv } }, "value correct" );

    # BSON::Doc -> hashref
    $hash = decode( encode( { doc => bson_doc( @kv, C => 'D' ) } ), ordered => 1 );
    tie my %ixhash, 'Tie::IxHash', @kv, C => 'D';
    is( ref($hash->{doc}), 'HASH', "BSON::Doc->hashref" );
    ok( tied(%{$hash->{doc}}), "hashref is tied" );
    is_deeply( $hash->{doc}, \%ixhash, "value correct" );

};

# TODO:
# Hash::Ordered to hashref

done_testing;

#
# This file is part of BSON
#
# This software is Copyright (c) 2016 by Stefan G. and MongoDB, Inc.
#
# This is free software, licensed under:
#
#   The Apache License, Version 2.0, January 2004
#
#
# vim: set ts=4 sts=4 sw=4 et tw=75: