dinislage/SOAP-WSDL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

import SOAP-WSDL 2.00.02 from CPAN

Browse Source 
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
2009-12-12 19:48:35 -08:00
committed by Michael G. Schwern
parent 745ce925c1
commit 915ee03cbe
153 changed files with 3289 additions and 2513 deletions
Download Patch File Download Diff File Expand all files Collapse all files
t/SOAP/WSDL/01_use.t
-7
View File
@@ -1,7 +0,0 @@
use Test::More tests => 3;
use lib '../lib';
use_ok(qw/SOAP::WSDL/);
ok( SOAP::WSDL->new(), 'Instantiated object' );
eval { SOAP::WSDL->new( grzlmpfh => 'unknown')};
ok $@, 'die on illegal parameter';
t/SOAP/WSDL/03_complexType-element-ref.t
+2 -2
View File
@@ -33,9 +33,9 @@ $soap->outputxml(1);
ok ($xml = $soap->call('test',
testAll => {
Test2 => 'Test2',
TestRef => 'TestRef'
TestElement => 'TestRef'
}
), 'Serialized complexType' );
like $xml, qr{<SOAP-ENV:Body><testAll><TestRef>TestRef</TestRef><Test2>Test2</Test2></testAll></SOAP-ENV:Body>}
like $xml, qr{<SOAP-ENV:Body><testAll><TestElement>TestRef</TestElement><Test2>Test2</Test2></testAll></SOAP-ENV:Body>}
, 'element ref="" serialization';
t/SOAP/WSDL/Client.t
-2
View File
@@ -1,7 +1,6 @@
use strict;
use warnings;
use Test::More tests => 8; #qw(no_plan);
use_ok qw(SOAP::WSDL::Client);
ok my $client = SOAP::WSDL::Client->new();
@@ -30,7 +29,6 @@ is $serialize->{ body }->{ foo }, 'bar';
$serialize = $client->call('testMethod', foo => 'bar');
is $serialize->{ body }->{ foo }, 'bar';
sub serialize {
my $self = shift;
return shift;
t/SOAP/WSDL/Expat/WSDLParser.t
+42 -22
View File
@@ -1,10 +1,12 @@
use strict;
use warnings;
use Test::More tests => 11; #qw(no_plan);
use Test::More tests => 14; #qw(no_plan);
use File::Spec;
use File::Basename;
my $path = File::Spec->rel2abs( dirname __FILE__ );
$path =~s{\\}{/}xg; # stupid windows workaround: $path works with /, but not
# with \
use_ok qw( SOAP::WSDL::Expat::WSDLParser);
@@ -17,18 +19,18 @@ my $definitions = $parser->parse_file(
use Data::Dumper;
my $schema = $definitions->first_types()->get_schema()->[1];
my $attr = $schema->get_element()->[0]->first_complexType->first_attribute();
ok $attr->get_name('testAttribute');
ok $attr->get_type('xs:string');
ok $attr->get_name('testAttribute'), 'attribute name';
ok $attr->get_type('xs:string'), 'attribute type';
use SOAP::WSDL::Generator::Template::XSD;
my $generator = SOAP::WSDL::Generator::Template::XSD->new({
definitions => $definitions,
type_prefix => 'Foo',
element_prefix => 'Foo',
typemap_prefix => 'Foo',
OUTPUT_PATH => "$path/testlib",
});
#use SOAP::WSDL::Generator::Template::XSD;
#my $generator = SOAP::WSDL::Generator::Template::XSD->new({
# definitions => $definitions,
# type_prefix => 'Foo',
# element_prefix => 'Foo',
# typemap_prefix => 'Foo',
# OUTPUT_PATH => "$path/testlib",
#});
$definitions = $parser->parse_uri(
"file://$path/../../../acceptance/wsdl/WSDLParser-import.wsdl"
@@ -43,6 +45,35 @@ is @{ $schema_from_ref }, 2, 'got builtin and imported schema';
ok @{ $schema_from_ref->[1]->get_element } > 0;
is $schema_from_ref->[1]->get_element->[0]->get_name(), 'sayHello';
{
my $warn_parser = SOAP::WSDL::Expat::WSDLParser->new();
my $warning;
local $SIG{__WARN__} = sub { $warning = join(q{}, @_ )};
$definitions = $warn_parser->parse_file(
"$path/../../../acceptance/wsdl/WSDLParser/import_no_location.wsdl"
);
like $warning, qr{cannot \s import \s document \s for \s namespace \s >urn:Test< \s without \slocation}x
, 'warn on import without location';
$definitions = $warn_parser->parse_uri(
"file://$path/../../../acceptance/wsdl/WSDLParser/xsd_import_no_location.wsdl"
);
like $warning, qr{cannot \s import \s document \s for \s namespace \s >urn:Test< \s without \slocation}x
, 'warn on import without location';
};
eval {
my $warn_parser = SOAP::WSDL::Expat::WSDLParser->new();
$definitions = $warn_parser->parse_file(
"$path/../../../acceptance/wsdl/WSDLParser/import_xsd_cascade.wsdl"
);
};
like $@, qr{\A cannot \s import \s document \s from \s namespace \s
>urn:Test< \s without \s base \s uri\. \s
Use \s >parse_uri< \s or \s >set_uri< \s to \s set \s one\.}x;
# Alarm is just to be sure - may loop infinitely if broken
$SIG{ALRM} = sub { die 'looped'};
alarm 1;
@@ -52,14 +83,3 @@ $definitions = $parser->parse_file(
alarm 0;
pass 'import loop';
__END__
$generator->set_type_prefix('MyTypes');
$generator->set_element_prefix('MyElements');
$generator->set_typemap_prefix('MyTypemaps');
$generator->set_interface_prefix('MyInterfaces');
$generator->set_output(undef);
$generator->generate();
t/SOAP/WSDL/Generator/Template.t
-28
View File
@@ -39,31 +39,3 @@ $generator->generate_interface({
ok eval $output;
print $@ if $@;
# print $output;
__END__
my $tt = Template->new(
DEBUG => 1,
EVAL_PERL => 1,
RECURSION => 1,
INCLUDE_PATH => "$path/../../../../lib/SOAP/WSDL/Template",
);
foreach my $service (@{ $definitions->get_service }) {
my $output;
$tt->process( 'Interface.tt', {
definitions => $definitions,
service => $service,
interface_prefix => 'MyInterface',
type_prefix => 'MyTypes',
TYPE_PREFIX => 'MyTypes',
element_prefix => 'MyElement',
}, \$output);
die $tt->error if $tt->error();
ok eval $output, 'eval output';
print $output;
};
t/SOAP/WSDL/Generator/XSD.t
+17 -1
View File
@@ -1,4 +1,4 @@
use Test::More tests => 51;
use Test::More tests => 61;
use File::Basename qw(dirname);
use File::Spec;
use File::Path;
@@ -16,6 +16,9 @@ my $definitions = $parser->parse_file(
"$path/../../../acceptance/wsdl/generator_test.wsdl"
);
#my $type = $definitions->first_types()->find_type('urn:Test', 'elementRefComplexType');
#die $type->get_element()->[0]->_DUMP;
my $generator = SOAP::WSDL::Generator::Template::XSD->new({
definitions => $definitions,
type_prefix => 'Foo',
@@ -127,6 +130,12 @@ is $complexExtension->get_Test1(), 'test1';
is $complexExtension->get_Test2(), 'test2';
is $complexExtension->get_Test3(), 'test3';
ok eval { require MyTypes::testComplexNestedExtension };
my $nestedExtension = MyTypes::testComplexNestedExtension->new();
ok $nestedExtension->can('get_Test1');
ok $nestedExtension->can('get_Test2');
ok $nestedExtension->can('get_Test3');
ok $nestedExtension->can('get_Test4');
ok eval { require MyTypes::testComplexTypeElementAtomicSimpleType; };
my $ct_east = MyTypes::testComplexTypeElementAtomicSimpleType->new({
@@ -193,4 +202,11 @@ SKIP: {
'Attribute POD');
}
ok $typemap = MyTypemaps::testService->get_typemap();
ok $typemap->{'testElementNestedExtension/Test1'};
ok $typemap->{'testElementNestedExtension/Test2'};
ok $typemap->{'testElementNestedExtension/Test3'};
ok $typemap->{'testElementNestedExtension/Test4'};
rmtree "$path/testlib";
t/SOAP/WSDL/Generator/XSD_custom_resolver.t
+131
View File
@@ -0,0 +1,131 @@
package TestResolver;
use strict; use warnings;
use Class::Std::Fast;
use base qw(SOAP::WSDL::Generator::PrefixResolver);
sub resolve_prefix {
my ($self, $type, $namespace, $node) = @_;
my $name = defined($node) ? $node->get_name() : ();
if (($type eq 'interface') && $name =~m{\.}x) {
return "MySpacialPrufax::";
}
if ($type eq 'type') {
return 'MySpatialTaipeeProfix::'
if $namespace ne 'http://www.w3.org/2001/XMLSchema'
}
return $self->SUPER::resolve_prefix($type, $namespace, $node);
}
package main;
use Test::More tests => 15;
use File::Basename qw(dirname);
use File::Spec;
use File::Path;
my $path = File::Spec->rel2abs( dirname __FILE__ );
use_ok qw(SOAP::WSDL::Generator::Visitor::Typelib);
use_ok qw(SOAP::WSDL::Generator::Template::XSD);
use SOAP::WSDL::Expat::WSDLParser;
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
my $definitions = $parser->parse_file(
"$path/../../../acceptance/wsdl/generator_test_dot_names.wsdl"
#"$path/../../../acceptance/wsdl/elementAtomicComplexType.xml"
);
my $generator = SOAP::WSDL::Generator::Template::XSD->new({
definitions => $definitions,
type_prefix => 'Foo',
element_prefix => 'Foo',
typemap_prefix => 'Foo',
OUTPUT_PATH => "$path/testlib",
prefix_resolver_class => 'TestResolver',
});
my $code = "";
$generator->set_output(\$code);
$generator->generate_typelib();
{
eval $code;
ok !$@;
print $@ if $@;
}
# print $code;
$generator->set_type_prefix('MySpatialTaipeeProfix');
$generator->set_element_prefix('MyElements');
$generator->set_typemap_prefix('MyTypemaps');
$generator->set_interface_prefix('MyInterfaces');
$generator->set_output(undef);
$generator->generate();
#$generator->generate_typelib();
#$generator->generate_typemap();
if (eval { require Test::Warn; }) {
Test::Warn::warning_like( sub { $generator->generate_interface() },
qr{\A Multiple \s parts \s detected \s in \s message \s testMultiPartWarning}xms);
}
else {
$generator->generate_interface();
SKIP: { skip 'Cannot test warnings without Test::Warn', 1 };
}
$generator->generate_server();
eval "use lib '$path/testlib'";
use_ok qw(MySpacialPrufax::My::SOAP::testService::testPort);
use_ok qw(MyServer::My::SOAP::testService::testPort);
use_ok qw(MySpatialTaipeeProfix::testComplexTypeRestriction);
use_ok qw(MySpatialTaipeeProfix::testComplexTypeAll);
SKIP: {
eval { require Test::Pod::Content; }
or skip 'Cannot test pod content without Test::Pod::Content', 6;
Test::Pod::Content::pod_section_like(
'MySpacialPrufax::My::SOAP::testService::testPort',
'NAME',
qr{^MySpacialPrufax::My::SOAP::testService::testPort \s - \s}xms,
'Pod NAME section');
Test::Pod::Content::pod_section_like(
'MySpacialPrufax::My::SOAP::testService::testPort',
'SYNOPSIS',
qr{use \s MySpacialPrufax::My::SOAP::testService::testPort}xms,
'Pod SYNOPSIS section');
Test::Pod::Content::pod_section_like(
'MySpacialPrufax::My::SOAP::testService::testPort',
'SYNOPSIS',
qr{\s MySpacialPrufax::My::SOAP::testService::testPort->new\(}xms,
'Pod SYNOPSIS section');
Test::Pod::Content::pod_section_like(
'MyServer::My::SOAP::testService::testPort',
'NAME',
qr{^MyServer::My::SOAP::testService::testPort \s - \s}xms,
'Pod NAME section');
Test::Pod::Content::pod_section_like(
'MyServer::My::SOAP::testService::testPort',
'SYNOPSIS',
qr{use \s MyServer::My::SOAP::testService::testPort}xms,
'Pod SYNOPSIS section');
Test::Pod::Content::pod_section_like(
'MyServer::My::SOAP::testService::testPort',
'SYNOPSIS',
qr{\s MyServer::My::SOAP::testService::testPort->new\(}xms,
'Pod SYNOPSIS section');
}
my $obj = MySpatialTaipeeProfix::testComplexTypeAll->new({
Test_1 => 'Test1',
Test_2 => 'Test2',
});
like $obj->serialize(), qr{<Test-1>Test1</Test-1>}xm, 'serialize altered name with original name';
rmtree "$path/testlib";
t/SOAP/WSDL/Generator/XSD_dot_names.t
+8 -1
View File
@@ -1,4 +1,4 @@
use Test::More tests => 14;
use Test::More tests => 15;
use File::Basename qw(dirname);
use File::Spec;
use File::Path;
@@ -99,4 +99,11 @@ SKIP: {
'Pod SYNOPSIS section');
}
my $obj = MyTypes::testComplexTypeAll->new({
Test_1 => 'Test1',
Test_2 => 'Test2',
});
like $obj->serialize(), qr{<Test-1>Test1</Test-1>}xm, 'serialize altered name with original name';
rmtree "$path/testlib";
t/SOAP/WSDL/Generator/XSD_nested_complextype.t
+2 -1
View File
@@ -90,7 +90,6 @@ SKIP: {
'Pod NAME section');
}
#rmtree "$path/testlib";
require FooMap::Service1;
my $message_parser = SOAP::WSDL::Expat::MessageParser->new({
class_resolver => 'FooMap::Service1',
@@ -115,3 +114,5 @@ sub xml {
</sayHello>
</SOAP-ENV:Body></SOAP-ENV:Envelope>};
}
rmtree "$path/testlib";
t/SOAP/WSDL/Generator/XSD_unsupported.t
+5 -2
View File
@@ -1,4 +1,4 @@
use Test::More tests => 3;
use Test::More tests => 2;
use File::Basename qw(dirname);
use File::Spec;
@@ -19,6 +19,9 @@ my $generator = SOAP::WSDL::Generator::Template::XSD->new({
});
{
# currently, there is no completely unsupported XML schema
# idiom (at least none which is detected properly)
# TODO update WSDL and add some (there sure are)
eval { $generator->generate_typelib() };
}
ok $@, $@;
# ok $@, $@;
t/SOAP/WSDL/Generator/attr.pl
-23
View File
@@ -1,23 +0,0 @@
use Test::More qw(no_plan);
use lib 'testlib';
#ok eval { require MyTypes::testComplexTypeSequenceWithAttribute; }
# , 'load MyTypes::testComplexTypeSequenceWithAttribute';
#
#my $obj = MyTypes::testComplexTypeSequenceWithAttribute->new({
# Test1 => 'foo',
# Test2 => 'bar',
#});
#$obj->attr({ testAttr => 'foobar' });
#
#print $obj->attr();
#
use_ok qw(MyElements::testElementComplexTypeSequenceWithAttribute);
my $obj = MyElements::testElementComplexTypeSequenceWithAttribute->new({
Test1 => 'foo',
Test2 => 'bar',
});
$obj->attr({ testAttr => 'foobar' });
print $obj;
t/SOAP/WSDL/Serializer/XSD.t
+14 -3
View File
@@ -1,3 +1,9 @@
package FOO;
use strict; use warnings;
use Class::Std::Fast;
sub serialize_qualified { 'FOO' };
package main;
use strict;
use warnings;
use Test::More qw(no_plan);
@@ -9,12 +15,17 @@ my $serializer = SOAP::WSDL::Serializer::XSD->new();
like $serializer->serialize(), qr{<SOAP-ENV:Body></SOAP-ENV:Body>}, 'empty body';
like $serializer->serialize({ body => {} }), qr{<SOAP-ENV:Body></SOAP-ENV:Body>}, 'empty body';
like $serializer->serialize({ body => [] }), qr{<SOAP-ENV:Body></SOAP-ENV:Body>}, 'empty body';
like $serializer->serialize({ header => {}, body => [] }),
like $serializer->serialize({ header => {}, body => [] }),
qr{<SOAP-ENV:Header></SOAP-ENV:Header><SOAP-ENV:Body></SOAP-ENV:Body>}, 'empty header and body';
like $serializer->serialize({ header => {}, body => [] , options => {
namespace => {
'http://schemas.xmlsoap.org/soap/envelope/' => 'SOAP',
'http://www.w3.org/2001/XMLSchema-instance' => 'xsi',
}
} }),
qr{<SOAP:Header></SOAP:Header><SOAP:Body></SOAP:Body>}, 'empty header and body';
} }),
qr{<SOAP:Header></SOAP:Header><SOAP:Body></SOAP:Body>}, 'empty header and body';
like $serializer->serialize({ header => {}, body => [ undef ] }),
qr{<SOAP-ENV:Header></SOAP-ENV:Header><SOAP-ENV:Body></SOAP-ENV:Body>}, 'empty header and body';
like $serializer->serialize({ header => {}, body => [ undef, FOO->new() ] }),
qr{<SOAP-ENV:Header></SOAP-ENV:Header><SOAP-ENV:Body>FOO</SOAP-ENV:Body>}, 'empty header and body';
t/SOAP/WSDL/Server/Mod_Perl2.t
+173
View File
@@ -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';
}
t/SOAP/WSDL/Transport/02_HTTP.t → t/SOAP/WSDL/Transport/HTTP.t
+6 -2
View File
@@ -1,4 +1,4 @@
use Test::More tests => 6;
use Test::More tests => 7;
use strict;
use utf8;
@@ -15,6 +15,10 @@ my $result = $transport->send_receive(envelope => 'Test', action => 'foo');
ok ! $transport->is_success();
$result = $transport->send_receive(encoding => 'utf8', envelope => 'ÄÖÜ',
$result = $transport->send_receive(encoding => 'utf8', envelope => 'ÄÖÜ',
action => 'foo');
ok ! $transport->is_success();
$result = $transport->send_receive(encoding => 'utf8', envelope => 'ÄÖÜ',
action => 'foo', content_type => 'application/xml');
ok ! $transport->is_success();
t/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.t
+3 -1
View File
@@ -1,6 +1,6 @@
use strict;
use warnings;
use Test::More tests => 23;
use Test::More tests => 24;
use Scalar::Util qw(blessed);
use lib '../../../../../../lib';
use_ok qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
@@ -30,6 +30,8 @@ is $obj->end_tag({ name => 'test' }), '</test>', 'end_tag';
ok $obj->set_value('test'), 'set_value';
is $obj->get_value(), 'test', 'get_value';
ok ! $obj->attr(), 'attr';
is "$obj", q{test}, 'stringification overloading';
is $obj->serialize, q{test}, 'stringification overloading';
t/SOAP/WSDL/XSD/Typelib/ComplexType.t
+15 -9
View File
@@ -82,7 +82,7 @@ __PACKAGE__->__set_name( 'MyElementSimpleContent' );
sub __get_attr_class { 'MyElement::_ATTR' };
package main;
use Test::More tests => 111;
use Test::More tests => 115;
use Storable;
my $have_warn = eval { require Test::Warn; import Test::Warn; 1; };
@@ -131,6 +131,7 @@ is $obj->get_test, 'Test2', 'element content';
$hash_of_ref = $obj->as_hash_ref();
is $hash_of_ref->{ test }, 'Test2';
ok ! ref $hash_of_ref->{ test };
$obj = MyType->new({
test => [
@@ -151,6 +152,7 @@ is $obj->get_test()->[1], 'Test2', 'element content (list content [1])';
$hash_of_ref = $obj->as_hash_ref();
is $hash_of_ref->{ test }->[0], 'Test';
ok ! ref $hash_of_ref->{ test }->[0];
is $hash_of_ref->{ test }->[1], 'Test2';
my $nested = MyType2->new({
@@ -277,12 +279,12 @@ for my $count (1..5) {
for my $index (0..$count-1) {
is $obj->get_test->[$index], "TestString$index";
}
is $obj->serialize(), $serialized[$count -1];
is $obj->serialize(), $serialized[$count -1], "serialized $serialized[$count -1]";
}
my $clone = Storable::thaw( Storable::freeze( $obj ));
is $clone->get_test()->[0], 'TestString0';
is $clone->get_test()->[0], 'TestString0', 'clone via freeze/thaw';
## failure tests
@@ -297,14 +299,14 @@ eval {
],
});
};
like $@, qr{cannot \s use \s CODE}xms;
like $@, qr{cannot \s use \s CODE}xms, 'error passing a code reference as list value to new()';
eval {
$obj = MyType->new({
test => \&CORE::die,
test => \&CORE::die,
});
};
like $@, qr{cannot \s use \s CODE}xms;
like $@, qr{cannot \s use \s CODE}xms, 'error passing a code reference to new()';
# TODO ignore XMLNS (for now)
$obj = MyType->new({ xmlns => 'fubar'});
@@ -323,13 +325,17 @@ like $@, qr{unknown \s field \s foobar \s in \s MyType }xms;
eval { $obj->set_FOO(42) };
like $@, qr{Can't \s locate \s object \s method}x;
like $@, qr{Can't \s locate \s object \s method}x, 'error on calling unknown object method';
eval { MyType->set_FOO(42) };
like $@, qr{Can't \s locate \s object \s method}x;
like $@, qr{Can't \s locate \s object \s method}x, 'error on calling unknown class method';
ok ! MyType->can('set_FOO'), 'MyType->can("setFOO")';
ok ! UNIVERSAL::can('MyType', 'set_FOO'), 'UNIVERSAL::can("MyTypes", "set_FOO")';
eval { MyType->new({ FOO => 42 }) };
like $@, qr{unknown \s field \s}xm;
like $@, qr{unknown \s field \s}xm, 'error passing unknown field to constructor';
eval { SOAP::WSDL::XSD::Typelib::ComplexType::AUTOMETHOD() };
like $@, qr{Cannot \s call}xm;