#!/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 => 32 }
$SIG{__WARN__} = sub { ; }; # turn off deprecation warnings
use SOAP::Lite;
my($a, $s, $r, $serialized, $deserialized);
my %tests = (
'XML only' => <<'EOM',
<?xml version="1.0" encoding="UTF-8"?>
<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/1999/XMLSchema">
<soap:Body>
<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
<c-gensym5 xsi:type="xsd:int">2</c-gensym5>
<c-gensym7 xsi:type="xsd:int">5</c-gensym7>
</namesp1:add>
</soap:Body>
</soap:Envelope>
EOM
'message with headers' => <<'EOM',
Content-Type: text/xml
<?xml version="1.0" encoding="UTF-8"?>
<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/1999/XMLSchema">
<soap:Body>
<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
<c-gensym5 xsi:type="xsd:int">2</c-gensym5>
<c-gensym7 xsi:type="xsd:int">5</c-gensym7>
</namesp1:add>
</soap:Body>
</soap:Envelope>
EOM
'singlepart MIME' => <<'EOM',
Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<calc061400a.xml@soaplite.com>"
--MIME_boundary
Content-Type: text/xml; charset=UTF-8
Content-Transfer-Encoding: 8bit
Content-ID: <calc061400a.xml@soaplite.com>
<?xml version="1.0" encoding="UTF-8"?>
<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/1999/XMLSchema">
<soap:Body>
<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
<c-gensym5 xsi:type="xsd:int">2</c-gensym5>
<c-gensym7 xsi:type="xsd:int">5</c-gensym7>
</namesp1:add>
</soap:Body>
</soap:Envelope>
--MIME_boundary--
EOM
'multipart MIME' => <<'EOM',
Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<calc061400a.xml@soaplite.com>"
--MIME_boundary
Content-Type: text/xml; charset=UTF-8
Content-Transfer-Encoding: 8bit
Content-ID: <calc061400a.xml@soaplite.com>
<?xml version="1.0" encoding="UTF-8"?>
<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/1999/XMLSchema">
<soap:Body>
<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
<c-gensym5 xsi:type="xsd:int">2</c-gensym5>
<c-gensym7 xsi:type="xsd:int">5</c-gensym7>
</namesp1:add>
</soap:Body>
</soap:Envelope>
--MIME_boundary
Content-Type: text/plain
Content-Transfer-Encoding: binary
Content-ID: <calc061400a.a@soaplite.com>
2
--MIME_boundary
Content-Type: text/plain
Content-Transfer-Encoding: binary
Content-ID: <calc061400a.b@soaplite.com>
5
--MIME_boundary--
EOM
'multipart MIME w/multiref' => <<'EOM',
Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<calc061400a.xml@soaplite.com>"
--MIME_boundary
Content-Type: text/xml; charset=UTF-8
Content-Transfer-Encoding: 8bit
Content-ID: <calc061400a.xml@soaplite.com>
<?xml version="1.0" encoding="UTF-8"?>
<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/1999/XMLSchema">
<soap:Body>
<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
<c-gensym5 href="cid:calc061400a.a@soaplite.com"/>
<c-gensym7 href="cid:calc061400a.b@soaplite.com"/>
</namesp1:add>
</soap:Body>
</soap:Envelope>
--MIME_boundary
Content-Type: text/plain
Content-Transfer-Encoding: binary
Content-ID: <calc061400a.a@soaplite.com>
2
--MIME_boundary
Content-Type: text/plain
Content-Transfer-Encoding: binary
Content-ID: <calc061400a.b@soaplite.com>
5
--MIME_boundary--
EOM
);
eval "SOAP::Packager::MIME->new->initialize_parser";
my $is_mimetools_installed = $@ ? 0 : 1;
(my $reason = $@) =~ s/ at .+// unless $is_mimetools_installed;
print "MIME tests will be skipped: $reason" if defined $reason;
my $package = '
package Calculator;
sub new { bless {} => ref($_[0]) || $_[0] }
sub add { $_[1] + $_[2] }
sub schema { $SOAP::Constants::DEFAULT_XML_SCHEMA }
1;';
# TEST 1-4
{
print "Server handler test(s)...\n";
my $server = SOAP::Server->dispatch_to('Calculator');
foreach (keys %tests) {
my $result = SOAP::Deserializer->deserialize($server->handle($tests{$_}));
if ($_ =~ /XML/ || $is_mimetools_installed) {
ok( ($result->faultstring || '') =~ /Failed to access class \(Calculator\)/ );
} else {
skip($reason => undef);
}
}
eval $package or die;
foreach (keys %tests) {
my $result = SOAP::Deserializer->deserialize($server->handle($tests{$_}));
if ($_ =~ /XML/ || $is_mimetools_installed) {
ok(($result->result || 0) == 7);
} else {
skip($reason => undef);
}
}
}
{
print "Server handler with complex dispatches test(s)...\n";
foreach my $server (
# dispatch to class
SOAP::Server->dispatch_to('Calculator'),
# dispatch to object
SOAP::Server->dispatch_to(Calculator->new),
# dispatch to regexp
SOAP::Server->dispatch_to('Calc\w+'),
# dispatch URI to class
SOAP::Server->dispatch_with({'http://www.soaplite.com/Calculator' => 'Calculator'}),
# dispatch URI to object
SOAP::Server->dispatch_with({'http://www.soaplite.com/Calculator' => Calculator->new}),
# dispatch quoted SOAPAction to class
SOAP::Server->action('"http://action/#method"')
->dispatch_with({'http://action/#method' => 'Calculator'}),
# dispatch non-quoted SOAPAction to class
SOAP::Server->action('http://action/#method')
->dispatch_with({'http://action/#method' => 'Calculator'}),
# dispatch to class and BAD regexp.
SOAP::Server->dispatch_to('\protocols', 'Calculator')
) { # end for
my $result = SOAP::Deserializer->deserialize($server->handle($tests{'XML only'}));
ok(($result->result || 0) == 7);
}
}
{
print "Error handling in server test(s)...\n";
$a = SOAP::Server->handle('<a></a>');
ok($a =~ /Can't find root/);
$a = SOAP::Server->handle('<Envelope></Envelope>');
ok($a =~ /Can't find method/);
$a = SOAP::Server->handle('<Envelope><Body><Add><a>1</a><b>1</b></Add></Body></Envelope>');
ok($a =~ /Denied access to method/);
$a = SOAP::Server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/1999/XMLSchema">
<soap:Body></soap:Body></soap:Envelope>');
ok($a =~ /Can't find method/);
}
{
print "Envelope with no namespaces test(s)...\n";
eval 'sub add { $_[1] + $_[2] }; 1' or die;
my $result = SOAP::Deserializer->deserialize(SOAP::Server->dispatch_to('add')->handle('<Envelope><Body><add><a>3</a><b>4</b></add></Body></Envelope>'));
ok(($result->result || 0) == 7);
}
{
print "Different XML Schemas test(s)...\n";
my $server = SOAP::Server->dispatch_to('Calculator');
$a = $server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/1999/XMLSchema">
<soap:Body>
<namesp1:schema xmlns:namesp1="http://www.soaplite.com/Calculator"/>
</soap:Body></soap:Envelope>');
ok($a =~ m!xsi="http://www.w3.org/2001/XMLSchema-instance"!);
ok($a =~ m!xsd="http://www.w3.org/2001/XMLSchema"!);
ok($a =~ m!>http://www.w3.org/2001/XMLSchema<!);
$a = $server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<soap:Body>
<namesp1:schema xmlns:namesp1="http://www.soaplite.com/Calculator">
<c-gensym5 xsi:type="xsd:int">2</c-gensym5>
</namesp1:schema>
</soap:Body></soap:Envelope>');
ok($a =~ m!xsi="http://www.w3.org/2001/XMLSchema-instance"!);
ok($a =~ m!xsd="http://www.w3.org/2001/XMLSchema"!);
ok($a =~ m!>http://www.w3.org/2001/XMLSchema<!);
$a = $server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<soap:Body>
<namesp1:schema xmlns:namesp1="http://www.soaplite.com/Calculator">
<c-gensym5 xsi:type="xsd:int">2</c-gensym5>
</namesp1:schema>
</soap:Body></soap:Envelope>');
ok($a =~ m!xsi="http://www.w3.org/2001/XMLSchema-instance"!);
ok($a =~ m!xsd="http://www.w3.org/2001/XMLSchema"!);
ok($a =~ m!>http://www.w3.org/2001/XMLSchema<!);
}