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