Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 183 lines (162 sloc) 5.88 kb
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
#!/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 => 98 }

# 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, $_);
}

# 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 &amp;bogus not defined at &lt;_&gt; 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 = new RPC::XML::boolean $_;
    ok(ref $obj);
    ok($obj->value, $val);
    ok($obj->as_string, "<boolean>$val</boolean>");
    ok($obj->type, 'boolean');
}
# This should not
$obj = new RPC::XML::boolean '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 = new RPC::XML::datetime_iso8601 time2iso8601(time);
ok($obj->type, 'dateTime.iso8601');

# Test the base64 type
require MIME::Base64;
$val = MIME::Base64::encode_base64(q/one reasonable-length string/);
$obj = new RPC::XML::base64(q/one reasonable-length string/);
ok(ref $obj);
ok($obj->as_string, "<base64>$val</base64>");
$obj = new RPC::XML::base64 $val, 'pre-encoded';
ok(ref $obj);
ok($obj->value, q/one reasonable-length string/);
$obj = new RPC::XML::base64 ();
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 = new RPC::XML::array 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);

# Structs
$obj = new RPC::XML::struct (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 = new RPC::XML::struct $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);

# Faults are a subclass of structs
$obj = new RPC::XML::fault (faultCode => 1, faultString => 'test');
ok(ref $obj);
# Since it's a subclass, I won't waste cycles testing the similar methods
$obj = new RPC::XML::fault (faultCode => 1, faultString => 'test',
                            faultFail => 'extras are not allowed');
ok(! ref($obj));
ok($RPC::XML::ERROR =~ /:new: Extra struct/);
$obj = new RPC::XML::fault (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);

# Requests
$obj = new RPC::XML::request 'test.method';
ok(ref $obj);
ok($obj->name eq 'test.method');
ok($obj->args && (@{ $obj->args } == 0));
$obj = new RPC::XML::request ();
ok(! ref($obj));
ok($RPC::XML::ERROR =~ /:new: At least a method name/);
$obj = new RPC::XML::request '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);

# Responses
$obj = new RPC::XML::response '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);
$obj = new RPC::XML::response ();
ok(! ref($obj));
ok($RPC::XML::ERROR =~ /:new: One of a datatype value or a fault/);
$obj = new RPC::XML::response (RPC::XML::fault->new(1, 'test'));
ok(ref $obj);
# The other methods have already been tested
ok($obj->is_fault);

exit 0;
Something went wrong with that request. Please try again.