The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

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];
	}
}