#!/bin/env perl
BEGIN {
unless(grep /blib/, @INC) {
chdir 't' if -d 't';
unshift @INC, '../lib' if -d '../lib';
}
}
use strict;
use Test;
BEGIN { plan tests => 42; }
use SOAP::Lite;
my($a, $s, $r, $serialized, $deserialized);
{ # check 'use ...'
print "'use SOAP::Lite ...' test(s)...\n";
eval 'use SOAP::Lite 99.99'; # hm, definitely should fail
ok(scalar $@ =~ /99.+required/);
}
# These tests are for backwards compatibility
{ # check use of use_prefix and uri together
# test 2 - turn OFF default namespace
$SIG{__WARN__} = sub { ; }; # turn off deprecation warnings
$serialized = SOAP::Serializer->use_prefix(1)->uri("urn:Test")->method(
'testMethod', SOAP::Data->name(test => 123)
);
ok($serialized =~ m!123!);
# test 3 - turn ON default namespace
$serialized = SOAP::Serializer->use_prefix(0)->uri("urn:Test")->method(
'testMethod', SOAP::Data->name(test => 123)
);
ok($serialized =~ m!123!);
}
{ # check use of default_ns, ns, and use_prefix
# test 4
$serialized = SOAP::Serializer->ns("urn:Test")->method(
'testMethod', SOAP::Data->name(test => 123)
);
ok($serialized =~ m!123!);
# test 5
$serialized = SOAP::Serializer->ns("urn:Test","testns")->method(
'testMethod', SOAP::Data->name(test => 123)
);
ok($serialized =~ m!123!);
# test 6
$serialized = SOAP::Serializer->default_ns("urn:Test")->method(
'testMethod', SOAP::Data->name(test => 123)
);
ok($serialized =~ m!123!);
}
{ # check serialization
print "Arrays, structs, refs serialization test(s)...\n";
$serialized = SOAP::Serializer->serialize(
SOAP::Data->name(test => \SOAP::Data->value(1, [1,2], {a=>3}, \4))
);
ok($serialized =~ m!1- 1
- 2
34!);
}
{ # check simple circular references
print "Simple circular references (\$a=\\\$a) serialization test(s)...\n";
$a = \$a;
$serialized = SOAP::Serializer->namespaces({})->serialize($a);
ok($serialized =~ m!!);
$a = SOAP::Deserializer->deserialize($serialized)->root;
ok(0+$a == 0+(values%$a)[0]);
}
{ # check complex circular references
print "Complex circlular references serialization test(s)...\n";
$a = SOAP::Deserializer->deserialize(<<'EOX')->root;
1
7
-
8
EOX
ok($a->{a}->{next}->{next}->{next}->{next}->{x} ==
$a->{a}->{next}->{x});
$a = { a => 1 }; my $b = { b => $a }; $a->{a} = $b;
$serialized = SOAP::Serializer->autotype(0)->namespaces({})->serialize($a);
ok($serialized =~ m!!);
}
{ # check multirefs
print "Multireferences serialization test(s)...\n";
$a = 1; my $b = \$a;
$serialized = SOAP::Serializer->new(multirefinplace=>1)->serialize(
SOAP::Data->name(test => \SOAP::Data->value($b, $b))
);
ok($serialized =~ m!1!);
$serialized = SOAP::Serializer->namespaces({})->serialize(
SOAP::Data->name(test => \SOAP::Data->value($b, $b))
);
ok($serialized =~ m!1!);
}
{ # check base64, XML encoding of elements and attributes
print "base64, XML encoding of elements and attributes test(s)...\n";
$serialized = SOAP::Serializer->serialize(
SOAP::Data->name(test => \SOAP::Data->value("\0\1\2\3 \4\5\6", "<123>&\015123>"))
);
ok($serialized =~ m!AAECAyAgIAQFBg==<123>&
</123>!);
$serialized = SOAP::Serializer->namespaces({})->serialize(
SOAP::Data->name(name=>'value')->attr({attr => '<123>"&"123>'})
);
ok($serialized =~ m!^<\?xml version="1.0" encoding="UTF-8"\?>value$!);
}
{ # check objects and SOAP::Data
print "Blessed references and SOAP::Data encoding test(s)...\n";
$serialized = SOAP::Serializer->serialize(SOAP::Data->uri('some_urn' => bless {a => 1} => 'ObjectType'));
ok($serialized =~ m!1!);
}
{ # check serialization/deserialization of simple types
print "Serialization/deserialization of simple types test(s)...\n";
$a = 'abc234xyz';
$serialized = SOAP::Serializer->serialize(SOAP::Data->type(hex => $a));
ok($serialized =~ m!61626332333478797A!);
ok(SOAP::Deserializer->deserialize($serialized)->root eq $a);
$a = <<"EOBASE64";
qwertyuiop[]asdfghjkl;'zxcvbnm,./QWERTYUIOP{}ASDFGHJKL:"ZXCVBNM<>?`1234567890-=\~!@#$%^&*()_+|
EOBASE64
$serialized = SOAP::Serializer->serialize($a);
ok(index($serialized, quotemeta(q!qwertyuiop[]asdfghjkl;'zxcvbnm,./QWERTYUIOP{}ASDFGHJKL:"ZXCVBNM<>?`1234567890-=~\!@#0^&*()_+|!)));
if (UNIVERSAL::isa(SOAP::Deserializer->parser->parser => 'XML::Parser::Lite')) {
skip(q!Entity decoding is not supported in XML::Parser::Lite! => undef);
} else {
ok(SOAP::Deserializer->deserialize($serialized)->root eq $a);
}
$a = <<"EOBASE64";
qwertyuiop[]asdfghjkl;'zxcvbnm,./
QWERTYUIOP{}ASDFGHJKL:"ZXCVBNM<>?
\x00
EOBASE64
$serialized = SOAP::Serializer->serialize($a);
ok($serialized =~ /base64/);
}
{ # check serialization/deserialization of blessed reference
print "Serialization/deserialization of blessed reference test(s)...\n";
$serialized = SOAP::Serializer->serialize(bless {a => 1} => 'SOAP::Lite');
$a = SOAP::Deserializer->deserialize($serialized)->root;
ok(ref $a eq 'SOAP::Lite' && UNIVERSAL::isa($a => 'HASH'));
$a = SOAP::Deserializer->deserialize(
SOAP::Serializer->serialize(bless [a => 1] => 'SOAP::Lite')
)->root;
ok(ref $a eq 'SOAP::Lite' && UNIVERSAL::isa($a => 'ARRAY'));
}
{ # check serialization/deserialization of undef/empty elements
print "Serialization/deserialization of undef/empty elements test(s)...\n";
{ local $^W; # suppress warnings
$a = undef;
$serialized = SOAP::Serializer->serialize(
SOAP::Data->type(negativeInteger => $a)
);
ok(! defined SOAP::Deserializer->deserialize($serialized)->root);
my $type = 'nonstandardtype';
eval {
$serialized = SOAP::Serializer->serialize(
SOAP::Data->type($type => $a)
);
};
ok($@ =~ /for type '$type' is not specified/);
$serialized = SOAP::Serializer->serialize(
SOAP::Data->type($type => {})
);
ok(ref SOAP::Deserializer->deserialize($serialized)->root eq $type);
}
}
{
print "Check for unspecified Transport module test(s)...\n";
eval { SOAP::Lite->new->abc() };
ok($@ =~ /A service address has not been specified/);
}
{
print "Deserialization of CDATA test(s)...\n";
UNIVERSAL::isa(SOAP::Deserializer->parser->parser => 'XML::Parser::Lite') ?
skip(q!CDATA decoding is not supported in XML::Parser::Lite! => undef) :
ok(SOAP::Deserializer->deserialize(']]>')->root eq '<123>');
}
{
print "Test of XML::Parser External Entity vulnerability...\n";
UNIVERSAL::isa(SOAP::Deserializer->parser->parser => 'XML::Parser::Lite') ?
skip(q!External entity references are not supported in XML::Parser::Lite! => undef) :
ok(!eval { SOAP::Deserializer->deserialize(' ]>≪')->root } and $@ =~ /^External entity/);
}
{
print "Test SOAP:: prefix with no +autodispatch option...\n";
eval { A->SOAP::b };
ok($@ =~ /^SOAP:: prefix/);
}
{
# check deserialization of an array of multiple elements
# nested within a complex type
print "Deserialization of document/literal arrays nested in complex types...\n";
my $input = '100onetwo';
my $deserializer = SOAP::Deserializer->new;
my $ret = $deserializer->deserialize($input);
my @arr = @{$ret->result->{'complexFoo'}{'arrayFoo'}};
ok($#arr == 1);
ok("one" eq $arr[0]);
ok("two" eq $arr[1]);
ok(100 == $ret->result->{"id"});
# If only one araryFoo tag is found, it's deserialized as a scalar.
$input = '100one';
$ret = $deserializer->deserialize($input);
ok("one" eq $ret->result->{'complexFoo'}{'arrayFoo'});
}
{
print "Serialization of docunemt/literal arrays\n";
# check array serialization with autotyping disabled
my $serializer = SOAP::Serializer->new;
$serializer->autotype(0);
my $hash = {
"scalar" => 1,
"array" => [ 2, 3],
"hash" => {
"scalar" => 4,
"array" => [ 5, 6],
}
};
my $xml = $serializer->serialize($hash);
ok($xml =~ m{
]*>
(:?
(:?
56
|4
){2}
| 23
| 1
){3}
}xms
);
# deserialize it and check that a similar object is created
my $deserializer = SOAP::Deserializer->new;
my $obj = $deserializer->deserialize($xml)->root;
ok(1, $obj->{"scalar"});
my @arr= @{$obj->{"array"}};
ok(2, $arr[0]);
ok(3, $arr[1]);
ok(4, $obj->{"hash"}{"scalar"});
@arr = @{$obj->{"hash"}{"array"}};
ok(5, $arr[0]);
ok(6, $arr[1]);
}