The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
# $HeadURL: https://svn.oucs.ox.ac.uk/people/oliver/pub/librpc-serialized-perl/trunk/t/22-rpc-serialized-debug.t $
# $LastChangedRevision: 1359 $
# $LastChangedDate: 2008-10-01 16:16:56 +0100 (Wed, 01 Oct 2008) $
# $LastChangedBy: oliver $
#

use strict;
use warnings;

use Test::More tests => 16;

use Data::Serializer;

use_ok('RPC::Serialized');
can_ok( 'RPC::Serialized', 'ifh' );
can_ok( 'RPC::Serialized', 'ofh' );
can_ok( 'RPC::Serialized', 'send' );
can_ok( 'RPC::Serialized', 'recv' );

SKIP: {
skip( "Cannot load IO::String", 11 )
    unless eval {require IO::String };

my $in  = IO::String->new();
my $out = IO::String->new();
# has to use something which is in the Perl core dist
my $ds  = Data::Serializer->new(
    serializer => 'Data::Dumper',
    encoding   => 'b64',
);

my $t = RPC::Serialized->new({
    rpc_serialized => {
        ifh => $in, ofh => $out,
        debug => 1,
    },
    data_serializer => {
        serializer => 'Data::Dumper',
        encoding   => 'b64',
        portable   => 0, # should be overridden to 1
    },
});

isa_ok( $t, 'RPC::Serialized' );
ok( $t->ifh );
ok( $t->ofh );

eval { $t->send( [] ) };
isa_ok( $@, 'RPC::Serialized::X::Protocol' );
is( $@->message, 'Data not a hash reference' );

my $h = { a => 1, b => 2, c => 3 };
my $h_rpc;
{
    $h_rpc = $ds->raw_serialize($h);
}

ok( $t->send($h), 'Sending data' );
is( ${ $out->string_ref }, "$h_rpc\n...\n" );
print quotemeta ${ $out->string_ref };
print quotemeta "$h_rpc\n...\n";

${ $in->string_ref } = "$h_rpc\n...\n";
$in->setpos(0);
my $data = $t->recv;
ok( defined $data );
ok( eq_hash( $h, $data ) );

${ $in->string_ref } = "-\n--\n~?~?!...\n";
$in->setpos(0);
eval { $data = $t->recv };
isa_ok( $@, 'RPC::Serialized::X::Protocol' );
like( $@->message, qr/^Data::Serializer error:/ );

}