import SOAP-WSDL 2.00.02 from CPAN
git-cpan-module: SOAP-WSDL git-cpan-version: 2.00.02 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.02.tar.gz
This commit is contained in:
Martin Kutter
committed by
Michael G. Schwern
Michael G. Schwern
parent
745ce925c1
commit
915ee03cbe
@@ -0,0 +1,173 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
# ugly use lib to let it run from everywhere
|
||||
use lib '../../../../example/lib';
|
||||
use lib '../example/lib';
|
||||
use lib 'example/lib';
|
||||
use lib 'lib';
|
||||
use lib 't/lib';
|
||||
use warnings;
|
||||
use Test::More; #qw(no_plan);
|
||||
|
||||
use MyElements::sayHello;
|
||||
|
||||
eval { require Test::MockObject }
|
||||
or plan skip_all => 'Test::MockObject required for faking mod_perl';
|
||||
plan tests => 13;
|
||||
|
||||
my @ERROR_FROM = ();
|
||||
my $REQUEST = 'Foo',
|
||||
my $RESPONSE;
|
||||
my %DIR_CONFIG_OF = (
|
||||
dispatch_to => 'Mod_Perl2Test',
|
||||
soap_service => 'MyServer::HelloWorld::HelloWorldSoap',
|
||||
|
||||
);
|
||||
|
||||
my $mock = Test::MockObject->new();
|
||||
$mock->fake_module('APR::Table');
|
||||
$mock->fake_module('Apache2::Log' =>
|
||||
new => sub { return bless {}, 'Apache2::Log' },
|
||||
error => sub { shift; push @ERROR_FROM, @_ },
|
||||
warn => sub { shift; push @ERROR_FROM, @_ },
|
||||
);
|
||||
$mock->fake_module('Apache2::Headers' =>
|
||||
new => sub { my $class = shift; return bless { @_ }, $class },
|
||||
get => sub { return $_[0]->{ $_[1] } },
|
||||
);
|
||||
$mock->fake_module('Apache2::RequestRec' =>
|
||||
new => sub { return bless {}, 'Apache2::RequestRec' },
|
||||
log => sub { return Apache2::Log->new() },
|
||||
dir_config => sub { return $DIR_CONFIG_OF{$_[1]}},
|
||||
headers_in => sub { return Apache2::Headers->new(
|
||||
'content-length' => length($REQUEST),
|
||||
'SOAPAction' => 'urn:HelloWorld#sayHello',
|
||||
)
|
||||
},
|
||||
'read' => sub { $_[1] = $REQUEST; my $length = length($REQUEST); $REQUEST = q{}; return $length; },
|
||||
method => sub { 'POST' },
|
||||
uri => sub { 'http://example.org/soap-wsdl/helloWorld/' },
|
||||
content_type => sub {},
|
||||
'print' => sub { shift; $RESPONSE .= join(q{}, @_) },
|
||||
);
|
||||
|
||||
|
||||
use_ok qw(SOAP::WSDL::Server::Mod_Perl2);
|
||||
|
||||
ok my $obj = SOAP::WSDL::Server::Mod_Perl2->new(), 'instantiate object';
|
||||
|
||||
my $r = Apache2::RequestRec->new();
|
||||
|
||||
# block for scoping local
|
||||
{
|
||||
# dirty but useful...
|
||||
local $DIR_CONFIG_OF{dispatch_to} = undef;
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{\A No \s 'dispatch_to' \s variable \s set \s in \s httpd.conf }x
|
||||
, 'error on bad dispatch_to';
|
||||
@ERROR_FROM = ();
|
||||
}
|
||||
|
||||
# block for scoping local
|
||||
{
|
||||
# dirty but useful...
|
||||
local $DIR_CONFIG_OF{dispatch_to} = 'main';
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{\A Failed \s to \s require \s \[main\] }x, 'error on bad dispatch_to';
|
||||
@ERROR_FROM = ();
|
||||
}
|
||||
|
||||
# block for scoping local
|
||||
{
|
||||
# dirty but useful...
|
||||
local $DIR_CONFIG_OF{soap_service} = undef;
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{\A No \s 'soap_service' \s variable \s set \s in \s httpd.conf }x
|
||||
, 'error on bad dispatch_to';
|
||||
@ERROR_FROM = ();
|
||||
}
|
||||
|
||||
# block for scoping local
|
||||
{
|
||||
# dirty but useful...
|
||||
local $DIR_CONFIG_OF{soap_service} = 'soap_service';
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{\A Failed \s to \s require \s \[soap_service\] }x, 'error on bad dispatch_to';
|
||||
@ERROR_FROM = ();
|
||||
}
|
||||
|
||||
|
||||
# block for scoping local
|
||||
{
|
||||
# dirty but useful...
|
||||
local $DIR_CONFIG_OF{transport_class} = 'transport_class';
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{\A Failed \s to \s require \s \[transport_class\] }x, 'error on bad transport_class';
|
||||
@ERROR_FROM = ();
|
||||
}
|
||||
|
||||
# block for scoping local
|
||||
{
|
||||
# dirty but useful...
|
||||
local $DIR_CONFIG_OF{transport_class} = 'SOAP::WSDL::Server::Mod_Perl2';
|
||||
$REQUEST = q{Foobar};
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{\A Failed \s to \s handle \s request }x, 'error on bad request';
|
||||
@ERROR_FROM = ();
|
||||
}
|
||||
|
||||
# just a block - got used to it.
|
||||
{
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{\A No \s content-length \s provided }x, 'error on missing content-length';
|
||||
@ERROR_FROM = ();
|
||||
}
|
||||
|
||||
{
|
||||
|
||||
my $hello = MyElements::sayHello->new({ name => 'Kutter', givenName => 'Martin' });
|
||||
$REQUEST = '<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||
<SOAP-ENV:Body >'
|
||||
. $hello->serialize_qualified()
|
||||
. '</SOAP-ENV:Body></SOAP-ENV:Envelope>';
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $RESPONSE, qr{Hello \s Martin \sKutter}x, 'SOAP response';
|
||||
@ERROR_FROM = ();
|
||||
}
|
||||
|
||||
{
|
||||
my $hello = MyElements::sayHello->new({ name => '__DIE__', });
|
||||
$REQUEST = '<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||
<SOAP-ENV:Body >'
|
||||
. $hello->serialize_qualified()
|
||||
. '</SOAP-ENV:Body></SOAP-ENV:Envelope>';
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{Failed \s to \s handle \s request: \s FOO}x, 'SOAP response';
|
||||
}
|
||||
|
||||
{
|
||||
my $hello = MyElements::sayHello->new({ name => '__DIE__', });
|
||||
$REQUEST = '<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||
<SOAP-ENV:Body >'
|
||||
. $hello->serialize_qualified()
|
||||
. '<FOOBAR/>'
|
||||
. '</SOAP-ENV:Body></SOAP-ENV:Envelope>';
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{Failed \s to \s handle \s request: \s FOO}x, 'SOAP response';
|
||||
}
|
||||
|
||||
|
||||
# This test breaks the read() method. Be sure to add tests needing it above.
|
||||
{
|
||||
no warnings qw(redefine once);
|
||||
$REQUEST = 'FOOBAR';
|
||||
*Apache2::RequestRec::read = sub { $_[1] = "BA"; $REQUEST = q{}; return length($REQUEST) };
|
||||
my $hello = MyElements::sayHello->new({ name => 'Kutter', });
|
||||
$REQUEST = '<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||
<SOAP-ENV:Body >'
|
||||
. $hello->serialize_qualified()
|
||||
. '</SOAP-ENV:Body></SOAP-ENV:Envelope>';
|
||||
SOAP::WSDL::Server::Mod_Perl2::handler($r);
|
||||
like $ERROR_FROM[0], qr{Failed \s to \s handle \s request: \s FOO}x, 'SOAP response';
|
||||
}
|
||||
Reference in New Issue
Block a user