use strict;
use Test::More;
BEGIN { plan tests => 13 };
use JSONRPC::Transport::HTTP;
use JSON;
my $rpc = JSONRPC::Transport::HTTP::CGI->dispatch_to('TestServer');
my $q = new TestCGI;
my $io;
my $json = {
id => "httpReq",
method => "echo",
params => [JSON::True, JSON::False, JSON::Null],
};
$q->param(json => objToJson($json));
like($q->param('json'), qr{"params":\[true,false,null\]}, "check1");
like($q->param('json'), qr{"id":"httpReq"}, "check2");
like($q->param('json'), qr{"method":"echo"}, "check3");
printout($rpc,\$io, query => $q, paramName => 'json');
my $obj = jsonToObj($io)->{result};
isa_ok($obj->[0],'JSON::NotString');
isa_ok($obj->[1],'JSON::NotString');
isa_ok($obj->[2],'JSON::NotString');
ok($obj->[0]);
ok(!$obj->[1]);
ok(!$obj->[2]);
{ local $JSON::UnMapping = 1;
printout($rpc,\$io, query => $q, paramName => 'json');
my $obj = jsonToObj($io)->{result};
is($obj->[0],1);
is($obj->[1],0);
is($obj->[2],undef);
}
$q->param(json => q|{aaa}|);
printout($rpc,\$io, query => $q, paramName => 'json');
ok(1);
sub printout {
my ($rpc, $ioref, @opts) = @_;
{
$$ioref = '';
local *STDOUT;
tie *STDOUT, 'TestSTDOUT', $ioref;
$rpc->handle(@opts);
}
# print $$ioref,"\n";
$$ioref =~ s/^.*?\015\012\015\012//s;
}
#######################################
package TestSTDOUT;
sub TIEHANDLE {
my $class = shift;
my $var = shift;
bless $var, $class;
}
sub PRINT {
my $self = shift;
my $data = shift;
$$self .= $data;
return 1;
}
#######################################
package TestServer;
sub echo {
my $server = shift;
my (@arg) = @_;
return [@arg];
}
#######################################
package TestCGI;
use base qw(CGI);
sub new { bless {}, shift; }
sub request_method { 'POST'; }
sub param {
my $self = shift;
my ($name,$value) = @_;
if(@_ == 0){
return keys %{ $self->{testdata} };
}
elsif(@_ == 1){
return $self->{testdata}->{$_[0]};
}
else{
return $self->{testdata}->{$_[0]} = $_[1];
}
}