/
10_data.t
199 lines (178 loc) · 6.45 KB
/
10_data.t
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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
#!/usr/bin/perl
# Test the data-manipulation routines in RPC::XML
use strict;
use vars qw($val $obj $class %val_tbl @values);
use Test;
use RPC::XML ':all';
BEGIN { plan tests => 110 }
# First, the most basic data-types
%val_tbl = (
'int' => int(rand 10000) + 1,
i4 => int(rand 10000) + 1,
double => rand 10001,
string => __FILE__
);
for (sort keys %val_tbl)
{
$val = $val_tbl{$_};
$class = "RPC::XML::$_";
$obj = $class->new($val);
ok(ref $obj);
ok($obj->value, $val);
ok($obj->as_string, "<$_>$val</$_>");
ok($obj->type, $_);
ok(length($obj->as_string), $obj->length);
}
# Another little test for RPC::XML::string, to check encoding
$val = 'Subroutine &bogus not defined at <_> line -NaN';
$obj = RPC::XML::string->new($val);
ok($obj->value, $val);
ok($obj->as_string,
"<string>Subroutine &bogus not defined at <_> line -NaN</string>");
# Type boolean is a little funky
# Each of these should be OK
for (qw(0 1 yes no tRuE FaLsE))
{
$val = (/0|no|false/i) ? 0 : 1;
$obj = RPC::XML::boolean->new($_);
ok(ref $obj);
ok($obj->value, $val);
ok($obj->as_string, "<boolean>$val</boolean>");
ok($obj->type, 'boolean');
}
# This should not
$obj = RPC::XML::boolean->new('of course!');
ok(! ref $obj);
ok($RPC::XML::ERROR =~ /::new: Value must be one of/);
# The dateTime.iso8601 type shares all code save for type() with the above, so
# only test that one here
$obj = RPC::XML::datetime_iso8601->new(time2iso8601(time));
ok($obj->type, 'dateTime.iso8601');
ok(length($obj->as_string), $obj->length);
# Test the base64 type
require MIME::Base64;
$val = MIME::Base64::encode_base64(q/one reasonable-length string/, '');
$obj = RPC::XML::base64->new(q/one reasonable-length string/);
ok(ref $obj);
ok($obj->as_string, "<base64>$val</base64>");
# test length()
ok(length($obj->as_string), $obj->length);
$obj = RPC::XML::base64->new($val, 'pre-encoded');
ok(ref $obj);
ok($obj->value, q/one reasonable-length string/);
$obj = RPC::XML::base64->new();
ok(! ref($obj));
ok($RPC::XML::ERROR =~ /::new: Must be called with non-null data/);
# Now we throw some junk at smart_encode()
@values = smart_encode(__FILE__, 10, 3.14159, '2112',
RPC::XML::string->new('2112'), [], {});
ok($values[0]->type, 'string');
ok($values[1]->type, 'int');
ok($values[2]->type, 'double');
ok($values[3]->type, 'int'); # Should have been encoded int regardless of ''
ok($values[4]->type, 'string'); # Was given an object explicitly
ok($values[5]->type, 'array');
ok($values[6]->type, 'struct');
# Arrays
$obj = RPC::XML::array->new(1 .. 10);
ok(ref $obj);
ok($obj->type, 'array');
@values = @{ $obj->value };
ok(@values == 10);
@values = @{ $obj->value(1) };
ok(ref($values[0]) && ($values[0]->type eq 'int'));
ok($obj->as_string =~ m|<array>.*(<int>\d+</int>.*){10}.*</array>|sm);
ok(length($obj->as_string), $obj->length);
# Structs
$obj = RPC::XML::struct->new(key1 => 1, key2 => 2);
ok(ref $obj);
ok($obj->type, 'struct');
$val = $obj->value;
ok(ref($val) eq 'HASH');
ok(scalar(keys %$val) == 2);
ok($val->{key1} == 1);
$val = $obj->value(1);
ok(ref($val->{key1}) && ($val->{key1}->type eq 'int'));
$val->{key1} = RPC::XML::string->new('hello');
$obj = RPC::XML::struct->new($val);
ok(ref $obj);
ok(($obj->value)->{key1} eq 'hello');
ok(($obj->value(1))->{key1}->type eq 'string');
ok($obj->as_string =~ m|<struct>.*(<member>.*
<name>.*</name>.*
<value>.*</value>.*
</member>.*){2}.*</struct>|smx);
ok(length($obj->as_string), $obj->length);
# Test handling of keys that contain XML special characters
$obj = RPC::XML::struct->new('>' => these =>
'<' => are =>
'&' => special =>
'<>' => XML =>
'&&' => 'characters');
ok($obj->as_string =~ tr/&/&/, 7);
# Faults are a subclass of structs
$obj = RPC::XML::fault->new(faultCode => 1, faultString => 'test');
ok(ref $obj);
# Since it's a subclass, I won't waste cycles testing the similar methods
$obj = RPC::XML::fault->new(faultCode => 1, faultString => 'test',
faultFail => 'extras are not allowed');
ok(! ref($obj));
ok($RPC::XML::ERROR =~ /:new: Extra struct/);
$obj = RPC::XML::fault->new(1, 'test');
ok(ref $obj);
ok($obj->code == 1);
ok($obj->string eq 'test');
ok($obj->as_string =~ m|<fault>.*
<value>.*
<struct>.*
(<member>.*
<name>.*</name>.*
<value>.*</value>.*
</member>.*){2}.*
</struct>.*
</value>.*
</fault>|smx);
ok(length($obj->as_string), $obj->length);
# Requests
$obj = RPC::XML::request->new('test.method');
ok(ref $obj);
ok($obj->name eq 'test.method');
ok($obj->args && (@{ $obj->args } == 0));
$obj = RPC::XML::request->new();
ok(! ref($obj));
ok($RPC::XML::ERROR =~ /:new: At least a method name/);
$obj = RPC::XML::request->new('test.method', (1 .. 10));
ok($obj->args && (@{ $obj->args } == 10));
# The new() method uses smart_encode on the args, which has already been
# tested. These are just to ensure that it *does* in fact call it
ok($obj->args->[0]->type eq 'int');
ok($obj->args->[9]->value == 10);
ok($obj->as_string =~ m|<\?xml.*
<methodCall>.*
<methodName>.*</methodName>.*
<params>.*
(<param>.*</param>.*){10}.*
</params>.*
</methodCall>|smx);
ok(length($obj->as_string), $obj->length);
# Responses
$obj = RPC::XML::response->new('ok');
ok(ref $obj);
ok($obj->value->type eq 'string');
ok($obj->value->value eq 'ok');
ok(! $obj->is_fault);
ok($obj->as_string =~ m|<\?xml.*
<methodResponse>.*
<params>.*
<param>.*</param>.*
</params>.*
</methodResponse>|smx);
ok(length($obj->as_string), $obj->length);
$obj = RPC::XML::response->new();
ok(! ref($obj));
ok($RPC::XML::ERROR =~ /:new: One of a datatype, value or a fault/);
$obj = RPC::XML::response->new(RPC::XML::fault->new(1, 'test'));
ok(ref $obj);
# The other methods have already been tested
ok($obj->is_fault);
exit 0;