1#!/usr/bin/env perl
2
3# Test the serialization of XML structures to filehandles
4
5## no critic(RequireBriefOpen)
6## no critic(RequireCheckedClose)
7
8use strict;
9use warnings;
10
11use Carp qw(croak);
12use Test::More;
13use File::Spec;
14use IO::Handle;
15
16use RPC::XML ':all';
17
18plan tests => 20;
19
20my ($dir, $vol, $fh, $file, $tmpfile, $faux_req, $faux_res, $ofh, $data);
21
22# We'll be using the <nil /> extension here:
23$RPC::XML::ALLOW_NIL = 1;
24
25($vol, $dir, undef) = File::Spec->splitpath(File::Spec->rel2abs($0));
26$dir = File::Spec->catpath($vol, $dir, q{});
27$file = File::Spec->catfile($dir, 'svsm_text.gif');
28$tmpfile = File::Spec->catfile($dir, "__tmp__${$}__");
29
30END
31{
32    # Make sure we don't leave any droppings...
33    if (-f $tmpfile)
34    {
35        unlink $tmpfile;
36    }
37}
38
39if (! (open $fh, '<', $file))
40{
41    croak "Could not open $file for reading: $!";
42}
43
44$faux_req = RPC::XML::request->new(
45    'test',
46    RPC_STRING 'string',
47    RPC_INT 10,
48    RPC_I4 20,
49    RPC_I8 4_294_967_296,
50    RPC_DOUBLE 0.5,
51    RPC_BOOLEAN 1,
52    RPC_DATETIME_ISO8601 time2iso8601(),
53    [ qw(a b c) ],
54    { one => 2 },
55    RPC_NIL,
56    RPC_BASE64 $fh
57);
58
59# This is a good place to test the length() method, while we're at it
60is(length($faux_req->as_string), $faux_req->length, 'Testing length() method');
61
62if (! (open $ofh, '+>', $tmpfile))
63{
64    croak "Could not open $tmpfile for read/write: $!";
65}
66$ofh->autoflush(1);
67
68$faux_req->serialize($ofh);
69ok(1, 'serialize method did not croak'); # Just happy we made it this far.
70
71is(-s $ofh, length($faux_req->as_string), 'File size is correct');
72
73seek $ofh, 0, 0;
74$data = q{};
75read $ofh, $data, -s $ofh;
76
77is($data, $faux_req->as_string, 'File content is correct');
78
79# Done with these for now
80close $fh;
81close $ofh;
82unlink $tmpfile;
83
84# We'll be doing this next set twice, as RPC::XML::response::serialize has a
85# slightly different code-path for faults and all other responses.
86if (! (open $ofh, '+>', $tmpfile))
87{
88    croak "Could not open $tmpfile for read/write: $!";
89}
90$ofh->autoflush(1);
91
92$faux_res = RPC::XML::response->new(RPC::XML::fault->new(1, 'test'));
93
94is(length($faux_res->as_string), $faux_res->length,
95   'length() in fault response');
96
97$faux_res->serialize($ofh);
98# Again, this means that all the triggered calls managed to not die
99ok(1, 'serialize method did not croak');
100
101is(-s $ofh, length($faux_res->as_string), 'Fault-response file size OK');
102
103seek $ofh, 0, 0;
104$data = q{};
105read $ofh, $data, -s $ofh;
106
107# There have been some changes to how Perl handles iteration of hash keys.
108# As a result, this test has started failing a lot because of the order of
109# keys when serialized doesn't match the order of keys from as_string(). So
110# to get around this, just compare it to both variations that can occur.
111my $variant1 = '<?xml version="1.0" encoding="us-ascii"?><methodResponse>' .
112    '<fault><value><struct><member><name>faultString</name><value><string>' .
113    'test</string></value></member><member><name>faultCode</name><value>' .
114    '<int>1</int></value></member></struct></value></fault></methodResponse>';
115my $variant2 = '<?xml version="1.0" encoding="us-ascii"?><methodResponse>' .
116    '<fault><value><struct><member><name>faultCode</name><value><int>1</int>' .
117    '</value></member><member><name>faultString</name><value><string>test' .
118    '</string></value></member></struct></value></fault></methodResponse>';
119ok(
120    ($data eq $variant1) || ($data eq $variant2),
121    'Fault-response content is correct'
122);
123
124close $ofh;
125unlink $tmpfile;
126
127# Round two, with normal response (not fault)
128if (! (open $ofh, '+>', $tmpfile))
129{
130    croak "Could not open $tmpfile for read/write: $!";
131}
132$ofh->autoflush(1);
133
134$faux_res = RPC::XML::response->new('test');
135
136is(length($faux_res->as_string), $faux_res->length,
137   'length() in normal response');
138
139$faux_res->serialize($ofh);
140# Again, this means that all the triggered calls managed to not die
141ok(1, 'serialize method did not croak');
142
143is(-s $ofh, length($faux_res->as_string), 'Normal response file size OK');
144
145seek $ofh, 0, 0;
146$data = q{};
147read $ofh, $data, -s $ofh;
148
149is($data, $faux_res->as_string, 'Normal response content OK');
150
151close $ofh;
152unlink $tmpfile;
153
154# Test some extra code-paths in the base64 logic:
155
156# Route 1: In-memory content
157if (! (open $ofh, '+>', $tmpfile))
158{
159    croak "Could not open $tmpfile for read/write: $!";
160}
161$ofh->autoflush(1);
162
163$faux_res = RPC::XML::response->new(RPC::XML::base64->new('a simple string'));
164
165is(length($faux_res->as_string), $faux_res->length,
166   'length() in normal response');
167
168$faux_res->serialize($ofh);
169# Again, this means that all the triggered calls managed to not die
170ok(1, 'serialize method did not croak');
171
172is(-s $ofh, length($faux_res->as_string), 'Normal response file size OK');
173
174seek $ofh, 0, 0;
175$data = q{};
176read $ofh, $data, -s $ofh;
177
178is($data, $faux_res->as_string, 'Normal response content OK');
179
180close $ofh;
181unlink $tmpfile;
182
183# Route 2: Spool from a file that is already encoded
184if (! (open $ofh, '+>', $tmpfile))
185{
186    croak "Could not open $tmpfile for read/write: $!";
187}
188$ofh->autoflush(1);
189
190$file = File::Spec->catfile($dir, 'svsm_text.b64');
191if (! (open $fh, '<', $file))
192{
193    croak "Could not open $file for reading: $!";
194}
195$faux_res = RPC::XML::response->new(RPC::XML::base64->new($fh, 'encoded'));
196
197is(length($faux_res->as_string), $faux_res->length,
198   'length() in normal response');
199
200$faux_res->serialize($ofh);
201# Again, this means that all the triggered calls managed to not die
202ok(1, 'serialize method did not croak');
203
204# If we're on Windows, then the re-spooling of the content of svsm_text.b64
205# introduced 32 extra bytes (due to \n\r silliness). Set $offset to 0 or 32
206# depending on the value of $^O.
207my $offset = ($^O =~ /mswin/i) ? 32 : 0;
208is(-s $ofh, length($faux_res->as_string) + $offset,
209   'Normal response file size OK');
210
211seek $ofh, 0, 0;
212$data = q{};
213read $ofh, $data, -s $ofh;
214
215is($data, $faux_res->as_string, 'Normal response content OK');
216
217close $fh;
218close $ofh;
219unlink $tmpfile;
220
221exit;
222