import SOAP-WSDL 2.00_33 from CPAN

git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_33
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_33.tar.gz

t/lib/MyElement.pm

@@ -66,8 +66,8 @@ my %test2_of :ATTR(:get<test2>);
 
 sub get_xmlns { 'urn:Test' };
 
-__PACKAGE__->_factory( 
-    [ qw(test test2) ], 
+__PACKAGE__->_factory(
+    [ qw(test test2) ],
     {
         test => \%test_of,
         test2 => \%test2_of,
@@ -99,11 +99,11 @@ use base (
 {
     my %test_of :ATTR(:get<test>);
     my %test2_of :ATTR(:get<test2>);
-    
+
     sub get_xmlns { 'urn:Test' };
-    
-    __PACKAGE__->_factory( 
-        [ qw(test test2) ], 
+
+    __PACKAGE__->_factory(
+        [ qw(test test2) ],
         {
             test => \%test_of,
             test2 => \%test2_of,
@@ -117,6 +117,8 @@ use base (
 }
 __PACKAGE__->__set_name('MyElementAttrs');
 
+sub __get_attr_class { 'MyElementAttrs::_ATTR' };
+
 package MyElementAttrs::_ATTR;
 
 use strict;
@@ -128,11 +130,11 @@ use base qw(
 {
     my %test_of :ATTR(:get<test>);
     my %test2_of :ATTR(:get<test2>);
-    
+
     sub get_xmlns { 'urn:Test' };
-    
-    __PACKAGE__->_factory( 
-        [ qw(test test2) ], 
+
+    __PACKAGE__->_factory(
+        [ qw(test test2) ],
         {
             test => \%test_of,
             test2 => \%test2_of,

t/lib/Test/SOAP/WSDL/Expat/WSDLParser.pm

@@ -0,0 +1,74 @@
+#!perl
+package Test::SOAP::WSDL::Expat::WSDLParser;
+use strict;
+use warnings;
+use Test::More;
+use Test::SOAP::WSDL::Tester;
+use base qw(Test::SOAP::WSDL::Tester);
+
+# It's a modulinho - it runs when executed...
+if (! caller() ) {
+    __PACKAGE__->runtests();
+}
+
+sub parse_t_uri {
+    my $self = shift;
+    my $parser = SOAP::WSDL::Expat::WSDLParser->new();
+    return $parser->parse_uri($self->t_url() . '/'. shift);
+}
+
+sub parse_wsdl_schema :Test(1) {
+    my $self = shift;
+    ok my $wsdl = $self->parse_t_uri( "../imported/schema/wsdl11/wsdl.xsd");
+}
+
+sub parse_soap_binding :Test(1) {
+    my $self = shift;
+    ok my $wsdl = $self->parse_t_uri( "../imported/schema/wsdl11/soap_binding.xsd");
+}
+
+sub parse_http_binding :Test(1) {
+    my $self = shift;
+    ok my $wsdl = $self->parse_t_uri( "../imported/schema/wsdl11/http_binding.xsd");
+}
+
+sub parse_wsdl :Test(3) {
+    my $self = shift;
+    ok my $wsdl = $self->parse_t_uri( "acceptance/wsdl/WSDLParser.wsdl");
+    my $schema = $wsdl->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');
+
+}
+
+sub parse_wsdl_with_import :Test(8) {
+    my $self = shift;
+    ok my $wsdl = $self->parse_t_uri( "acceptance/wsdl/WSDLParser-import.wsdl");
+
+    # Content checks
+    is $wsdl->get_service()->[0]->get_name(),   'Service1',     'found service name';
+    is $wsdl->get_portType->[0]->get_name(),    'Service1Soap', 'found portType name';
+    is $wsdl->get_types()->[0]
+        ->get_schema()->[1]
+            ->get_element()->[0]->get_name(),   'sayHello',     'found element name';
+    ok my $schema_from_ref = $wsdl->get_types()
+        ->[0]->get_schema(), 'found schema';
+    is @{ $schema_from_ref },                   2,              'got builtin and imported schema';
+    ok @{ $schema_from_ref->[1]->get_element } > 0,             'found mi element in second schema';
+    is $schema_from_ref->[1]
+        ->get_element->[0]->get_name(),          'sayHello',     'found element name';
+}
+
+sub parse_wsdl_with_import_loop :Test(1) {
+    my $self = shift;
+    SKIP: {
+        skip 'cannot test without Test::Warn', 1 if not $self->has_test_warn();
+        my $wsdl;
+        Test::Warn::warning_like
+             { $wsdl = $self->parse_t_uri( "acceptance/wsdl/WSDLParser_import_loop.wsdl") }
+            qr{file:///home/martin/workspace/SOAP-WSDL/t/acceptance/wsdl/import_loop.xsd \s already \s imported. \s Ignoring \s it}x,
+            'warn about duplicate import';
+    }
+}
+1;

t/lib/Test/SOAP/WSDL/Generator/Iterator/WSDL11.pm

@@ -0,0 +1,42 @@
+#!perl
+package Test::SOAP::WSDL::Generator::Iterator::WSDL11;
+use strict;
+use warnings;
+use Test::More;
+use SOAP::WSDL::Expat::WSDLParser;
+use base qw(Test::SOAP::WSDL::Tester);
+
+# It's a modulinho - it runs when executed...
+if (! caller() ) {
+    __PACKAGE__->runtests();
+}
+sub parse_t_uri {
+    my $self = shift;
+    my $parser = SOAP::WSDL::Expat::WSDLParser->new();
+    return $parser->parse_uri($self->t_url() . '/'. shift);
+}
+
+sub iterate :Test() {
+    my $self = shift;
+    my $iter = SOAP::WSDL::Generator::Iterator::WSDL11->new();
+    $iter->set_definitions($self->parse_t_uri( "acceptance/wsdl/WSDLParser.wsdl"));
+    $iter->init();
+
+    while (my $node = $iter->get_next()) {
+        print $node, "\n";
+    }
+}
+
+sub iterate_init :Test() {
+    my $self = shift;
+    my $iter = SOAP::WSDL::Generator::Iterator::WSDL11->new();
+    $iter->set_definitions($self->parse_t_uri( "acceptance/wsdl/WSDLParser.wsdl"));
+    $iter->init();
+
+    for my $service (@{ $iter->get_definitions()->get_service() }) {
+        while (my $node = $iter->get_next()) {
+            print $node, "\n";
+        }
+    }
+}
+

t/lib/Test/SOAP/WSDL/Generator/Visitor/Typemap.pm

@@ -0,0 +1,16 @@
+#!perl
+package Test::SOAP::WSDL::Generator::Visitor::Typemap;
+use strict; use warnings;
+use Test::More;
+use base qw(Test::SOAP::WSDL::Tester);
+
+# It's a modulinho - it runs when executed...
+if (! caller() ) {
+    __PACKAGE__->runtests();
+}
+
+sub a_constructor : Test( 1 ) {
+    my $self = shift;
+    ok my $obj = $self->get_class->new() ;
+    $self->set_object( $self->get_class->new() );
+}

t/lib/Test/SOAP/WSDL/Tester.pm

@@ -0,0 +1,56 @@
+package Test::SOAP::WSDL::Tester;
+use strict;
+use warnings;
+use Test::Class;
+use base qw(Test::Class);
+
+use File::Basename;
+use File::Spec;
+
+use Test::More;
+
+use Scalar::Util qw(blessed);
+
+our $HAS_TEST_WARN;
+
+BEGIN {
+    $HAS_TEST_WARN = eval { require Test::Warn; import Test::Warn; 1 };
+}
+
+sub has_test_warn {
+    return $HAS_TEST_WARN;
+}
+
+# object accessors
+sub set_object { $_[0]->{ object } = $_[1] }
+sub get_object { return shift->{ object } };
+# class accessors
+sub set_class { $_[0]->{ class } = $_[1] }
+sub get_class { return shift->{ class } };
+
+
+sub startup :Test(startup => 1) {
+    my $self = shift;
+    my $class = ref $self;
+    if ($class eq __PACKAGE__) {
+        ok __PACKAGE__;
+        return;
+    };
+    $class =~s{^Test::}{};
+    $self->set_class( $class );
+    use_ok $class;
+}
+
+sub t_url {
+    my $path = File::Spec->rel2abs( dirname __FILE__ );
+    my ($volume, $dir) = File::Spec->splitpath($path, 1);
+    my @dir_from = File::Spec->splitdir($dir);
+    unshift @dir_from, $volume if $volume;
+
+    my $url = 'file://' . join '/', @dir_from[0..$#dir_from - 4];
+    # die $url;
+    return $url;
+
+}
+
+1;

t/lib/Test/SOAPMessage.pm

@@ -1,64 +0,0 @@
-package Test::SOAPMessage;
-
-use strict;
-
-use SOAP::Lite;
-use Test::Differences;
-use Tie::IxHash;
-
-use base qw/Exporter/;
-
-our @EXPORT = qw/soap_eq_or_diff/;
-
-sub soap_eq_or_diff
-{
-	my $got = shift;
-	my $expected = shift;
-	my $message = shift;
-	my $soapGot = SOAP::Deserializer->deserialize( $got );
-	my $soapExpected = SOAP::Deserializer->deserialize( $expected );
-
-	return eq_or_diff(
-		unlather( $soapGot ), 
-		unlather( $soapExpected ),
-		$message
-	);
-}
-
-sub unlather
-{
-        my $som = shift;
-        my $path = shift || '/Envelope/Body/[1]';
-        my $data = shift;
-        
-        unless ( $data )
-        {
-        	my %hashData = ();
-        	tie (%hashData, q/Tie::IxHash/);
-        	$data = \%hashData;
-        }
-        
-        my $value;
-        my $tag;
-        my $i = 1;
-        while( $som->match("$path/[$i]") )
-        {
-                $tag = $som->dataof->name();
-                $data ||= {};
-                $value = unlather($som,$path.'/'. '[' . $i . ']' ) || $som->valueof("$path/[$i]");
-                if ($data->{ $tag })
-                {
-                        $data->{ $tag } = [ $data->{ $tag } ] unless ( ref ( $data->{ $tag } ) eq 'ARRAY' );
-                        push @{ $data->{ $tag } }, $value;
-                }
-                else
-                {
-                        $data->{ $tag } = $value;
-                }
-                $i++;
-        }
-        $data ||= $som->valueof($path);
-        return $data;
-}
-
-1;