1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
use strict;
use Test::More;
BEGIN { plan tests => 11 };
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));
is($q->param('json'), '{"params":[true,false,null],"id":"httpReq","method":"echo"}');
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];
}
}
|
