#!/usr/bin/perl # # $HeadURL: https://svn.oucs.ox.ac.uk/people/oliver/pub/librpc-serialized-perl/trunk/t/23-rpc-serialized-trace.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, trace => 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:/ ); }