Martin KutterandMichael G. Schwern
bfc3247583
git-cpan-module: SOAP-WSDL git-cpan-version: 2.00.07 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.07.tar.gz
128 lines
3.6 KiB
Perl
128 lines
3.6 KiB
Perl
package MyTypemap;
|
|
sub get_typemap { return {} }
|
|
|
|
package main;
|
|
use Test::More;
|
|
use CGI;
|
|
|
|
plan tests => 8;
|
|
|
|
use_ok(SOAP::WSDL::Server);
|
|
use_ok(SOAP::WSDL::Server::Simple);
|
|
|
|
my $server = SOAP::WSDL::Server::Simple->new( {class_resolver => 'MyTypemap',} );
|
|
$server->set_action_map_ref( {'testaction' => 'testmethod',} );
|
|
|
|
test_fault_output();
|
|
test_deserializer_fault();
|
|
test_simple_fault();
|
|
test_success();
|
|
|
|
#
|
|
# test _output by forcing a fault (passing a empty CGI object)
|
|
# IO::Scalar required
|
|
#
|
|
|
|
sub test_fault_output {
|
|
no warnings qw(once);
|
|
SKIP: {
|
|
eval "require IO::Scalar"
|
|
or skip 'IO::Scalar required for testing...', 1;
|
|
|
|
# set up a IO::Scalar handle as STDOUT
|
|
local *IO::Scalar::BINMODE = sub { };
|
|
my $output = q{};
|
|
my $fh = IO::Scalar->new( \$output );
|
|
{
|
|
local *STDOUT = $fh;
|
|
# don't try to print() anything from here on - it gehts caught in $output,
|
|
#and does not make it to STDOUT...
|
|
|
|
$server->handle( CGI->new() );
|
|
}
|
|
like $output, qr{no \s element \s found}xms;
|
|
|
|
}
|
|
}
|
|
|
|
sub test_deserializer_fault {
|
|
*SOAP::WSDL::Server::Simple::_output = sub {
|
|
like $_[1]->content(), qr{Error \s deserializing \s message}xms,
|
|
'Fault on (wrong) content';
|
|
};
|
|
|
|
local $ENV{REQUEST_METHOD} = 'POST';
|
|
local $ENV{HTTP_SOAPACTION} = 'testaction';
|
|
|
|
$server->handle(
|
|
CGI->new( {
|
|
POSTDATA => q{<SOAP-ENV:Envelope
|
|
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
|
|
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
|
|
><SOAP-ENV:Body>
|
|
<TestOperation xmlns="http://www.example.org/example/">
|
|
<Name>Kutter</Name>
|
|
<Vorname>Martin</Vorname>
|
|
<Anrede>Herr</Anrede>
|
|
</TestOperation>
|
|
</SOAP-ENV:Body>
|
|
</SOAP-ENV:Envelope>}
|
|
} ) );
|
|
}
|
|
|
|
sub test_simple_fault {
|
|
*SOAP::WSDL::Server::Simple::_output = sub {
|
|
is $_[1]->code, 500;
|
|
like $_[1]->content(), qr{Something \s is \s rotten}xms,
|
|
'Fault on (wrong) content';
|
|
};
|
|
|
|
local $ENV{REQUEST_METHOD} = 'POST';
|
|
local $ENV{HTTP_SOAPAction} = 'testaction';
|
|
|
|
local *SOAP::WSDL::Server::handle = sub { die 'Something is rotten' };
|
|
|
|
$server->handle(
|
|
CGI->new( {
|
|
POSTDATA => q{<SOAP-ENV:Envelope
|
|
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
|
|
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
|
|
><SOAP-ENV:Body>
|
|
<TestOperation xmlns="http://www.example.org/example/">
|
|
<Name>Kutter</Name>
|
|
<Vorname>Martin</Vorname>
|
|
<Anrede>Herr</Anrede>
|
|
</TestOperation>
|
|
</SOAP-ENV:Body>
|
|
</SOAP-ENV:Envelope>}
|
|
} ) );
|
|
}
|
|
|
|
sub test_success {
|
|
*SOAP::WSDL::Server::Simple::_output = sub {
|
|
is $_[1]->code(), 200;
|
|
like $_[1]->content(), qr{Everything \s OK}xms,
|
|
'Status 200 on OK content';
|
|
};
|
|
|
|
local $ENV{REQUEST_METHOD} = 'POST';
|
|
local $ENV{HTTP_SOAPAction} = 'testaction';
|
|
|
|
local *SOAP::WSDL::Server::handle = sub { 'Everything OK' };
|
|
|
|
$server->handle(
|
|
CGI->new( {
|
|
POSTDATA => q{<SOAP-ENV:Envelope
|
|
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
|
|
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
|
|
><SOAP-ENV:Body>
|
|
<TestOperation xmlns="http://www.example.org/example/">
|
|
<Name>Kutter</Name>
|
|
<Vorname>Martin</Vorname>
|
|
<Anrede>Herr</Anrede>
|
|
</TestOperation>
|
|
</SOAP-ENV:Body>
|
|
</SOAP-ENV:Envelope>}
|
|
} ) );
|
|
}
|