import SOAP-WSDL 2.00_32 from CPAN

git-cpan-module: SOAP-WSDL git-cpan-version: 2.00_32 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_32.tar.gz
2009-12-12 19:48:24 -08:00
parent f0b3bdc201
commit 51db446428
36 changed files with 376 additions and 106 deletions
@@ -25,17 +25,33 @@ sub _process :PROTECTED {
    my ($self, $template, $arg_ref, $output) = @_;
    my $ident = ident $self;

-    $tt_of{$ident} = Template->new(
+    # always create a new Template object to
+    # force re-loading of plugins.
+    my $tt = Template->new(
        DEBUG => 1,
        EVAL_PERL => $EVAL_PERL_of{ $ident },
        RECURSION => $RECURSION_of{ $ident },
        INCLUDE_PATH => $INCLUDE_PATH_of{ $ident },
        OUTPUT_PATH => $OUTPUT_PATH_of{ $ident },
-    )
-        if (not $tt_of{ $ident });
+        PLUGIN_BASE => 'SOAP::WSDL::Generator::Template::Plugin',
+    );

-    $tt_of{ $ident }->process( $template,
+    $tt->process( $template,
    {
+        context => {
+            namespace_prefix_map => {
+                'http://www.w3.org/2001/XMLSchema' => 'SOAP::WSDL::XSD::Typelib::Builtin',
+            },
+            namespace_map => {
+            },
+            prefix => {
+                interface => $self->get_interface_prefix,
+                element => $self->get_element_prefix,
+                server => $self->get_server_prefix,
+                type => $self->get_type_prefix,
+                typemap => $self->get_typemap_prefix,
+            }
+        },
        definitions => $self->get_definitions,
        interface_prefix => $self->get_interface_prefix,
        server_prefix => $self->get_server_prefix,
@@ -47,7 +63,7 @@ sub _process :PROTECTED {
        %{ $arg_ref }
    },
    $output)
-        or die $INCLUDE_PATH_of{ $ident }, '\\', $template, ' ', $tt_of{ $ident }->error();
+        or die $INCLUDE_PATH_of{ $ident }, '\\', $template, ' ', $tt->error();
 }

 1;
@@ -0,0 +1,61 @@
+package SOAP::WSDL::Generator::Template::Plugin::XSD;
+use strict;
+use warnings;
+
+use Class::Std::Fast::Storable constructor => 'none';
+
+my %namespace_prefix_map_of    :ATTR(:name<namespace_prefix_map>  :default<{}>);
+my %namespace_map_of            :ATTR(:name<namespace_map>  :default<{}>);
+my %prefix_of                   :ATTR(:name<prefix> :default<()>);
+
+# create a singleton
+sub load {               # called as MyPlugin->load($context)
+    my ($class, $context, @arg_from) = @_;
+    my $stash = $context->stash();
+    my $self = bless \do { my $o = Class::Std::Fast::ID() }, $class;
+    use Data::Dumper;
+    # die Data::Dumper::Dumper $stash->{ context };
+    $self->set_namespace_map( $stash->{ context }->{ namespace_map });
+    $self->set_namespace_prefix_map( $stash->{ context }->{ namespace_prefix_map });
+    $self->set_prefix( $stash->{ context }->{ prefix });
+    return $self;       # returns 'MyPlugin'
+}
+
+sub new {
+    return shift;
+}
+
+sub _get_prefix {
+    my ($self, $type, $namespace) = @_;
+    return $namespace_prefix_map_of{ $$self }->{ $namespace }
+        || ( ($namespace_map_of{ $$self }->{ $namespace })
+            ? join ('::', $prefix_of{ $$self }->{ $type }, $namespace_map_of{ $$self }->{ $namespace })
+            : $prefix_of{ $$self }->{ $type }
+        )
+        || $prefix_of{ $$self }->{ $type };
+}
+
+sub get_element_prefix {
+    shift->_get_prefix( 'element', shift );
+}
+
+sub get_interface_prefix {
+    shift->_get_prefix( 'interface', shift );
+}
+
+sub get_server_prefix {
+    shift->_get_prefix( 'server', shift );
+}
+
+sub get_type_prefix {
+    # die "WIX";
+    shift->_get_prefix( 'type', shift );
+}
+
+sub get_typemap_prefix {
+    shift->_get_prefix( 'typemap', shift );
+}
+
+sub error {}
+1;
+
@@ -1,3 +1,4 @@
+[% USE XSD -%]
 [% interface_name = interface_prefix _ '::'
    _ service.get_name.replace('\.', '::') _ '::'
    _ port.get_name.replace('^.+\.','');
@@ -48,12 +49,12 @@ __END__

 use [% interface_name %];
 my $interface = [% interface_name %]->new();
- 
+
 my $response;
 [%      FOREACH operation = binding.get_operation;
 %] $response = $interface->[% operation.get_name %]();
 [%      END %]
- 
+

 [% head1 %] DESCRIPTION

@@ -1,3 +1,4 @@
+[% USE XSD(context) -%]
 package [% type_prefix %]::[% complexType.get_name.replace('\.','::').replace('-','_') %];
 use strict;
 use warnings;
@@ -6,8 +7,6 @@ use warnings;
 # Don't include any perl source here - there may be sub-packages...
 #-%]

-package [% type_prefix %]::[% complexType.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
-use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
 [% INCLUDE complexType/attributeSet.tt %]
 1;

@@ -1,5 +1,5 @@
 [% indent %]{
-[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% END %]
+[%- IF complexType.get_name %] # [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %][% END %]
 [%- indent = indent _ '  ';
 FOREACH element = complexType.get_element %]
 [% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
@@ -1,5 +1,5 @@
 [% indent %]{
-[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% END %]
+[%- IF complexType.get_name %] # [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %][% END %]
 [%- indent = indent _ '  ' %]
 [% indent %]# One of the following elements.
 [% indent %]# No occurance checks yet, so be sure to pass just one...
@@ -1,7 +1,10 @@
 [% IF (complexType.get_variety == 'restriction');
    INCLUDE complexType/POD/restriction.tt(complexType = complexType);
-ELSIF (complexType.get_variety == 'sequence');
-    THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
+ELSIF (complexType.get_variety == 'extension');
+    #THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
+%]
+ # No documentation generated for complexContent / extension yet
+[%
 ELSE;
    THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
 END;
@@ -1,5 +1,5 @@
 [% indent %]{
-[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% END %]
+[%- IF complexType.get_name %] # [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %][% END %]
 [%- indent = indent _ '  ';
 FOREACH element = complexType.get_element %]
 [% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
@@ -0,0 +1,12 @@
+[% IF (complexType.get_variety == 'restriction');
+    INCLUDE complexType/POD/restriction.tt(complexType = complexType);
+ELSIF (complexType.get_variety == 'extension');
+    #THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
+%]
+ # No documentation generated for complexContent / extension yet
+[%
+ELSE;
+    THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
+END;
+
+%]
@@ -7,7 +7,7 @@ ELSIF (complexType.get_variety == 'group');
 ELSIF (complexType.get_variety == 'choice');
    INCLUDE complexType/POD/choice.tt(complexType = complexType);
 ELSIF (complexType.get_contentModel == 'simpleContent');
-    THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType simpleContent not implemented yet";
+    INCLUDE complexType/POD/simpleContent.tt(complexType = complexType);
 ELSIF (complexType.get_contentModel == 'complexContent');
    INCLUDE complexType/POD/complexContent.tt(complexType = complexType);
 END %],
@@ -24,13 +24,9 @@ __PACKAGE__->_factory(
    {
 [% FOREACH element = complexType.get_element;
    IF (type = element.get_type);
-        element_type = complexType.expand( type );
-        IF (element_type.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
-        [% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% element_type.1 %]',
-[%      ELSE -%]
-        [% element.get_name %] => '[% type_prefix %]::[% element_type.1 %]',
-[%      END;
-    ELSE;
+        element_type = complexType.expand( type ); -%]
+        [% element.get_name %] => '[% XSD.get_type_prefix(element_type.0) %]::[% element_type.1 %]',
+[%    ELSE;
        IF (element.first_simpleType);
            atomic_types.${ element.get_name } = element.first_simpleType;
        ELSIF (element.first_complexType);
@@ -38,7 +34,7 @@ __PACKAGE__->_factory(
        ELSE;
            THROW NOT_IMPLEMENTED , "Neither simple nor complex atomic type - don't know what to do with it";
        END; %]
-    [% element.get_name %] => '[% type_prefix %]::[% complexType.get_name %]::_[% element.get_name %]',
+    [% element.get_name %] => '[% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %]::_[% element.get_name %]',
 [%  END;
 END -%]
    }
@@ -1,7 +1,7 @@

 [% FOREACH type IN atomic_types; %]

-package [% type_prefix %]::[% complexType.get_name %]::_[% type.key %];
+package [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %]::_[% type.key %];
 use strict;
 use warnings;
 {
@@ -1,3 +1,7 @@
+[% IF (complexType.get_attribute.size) %]
+package [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
+use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
+
 { # BLOCK to scope variables
 [%

@@ -19,11 +23,9 @@ __PACKAGE__->_factory(
 [% FOREACH element = complexType.get_attribute;
    IF (type = element.get_type);
        element_type = complexType.expand( type );
-        IF (element_type.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
-        [% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% element_type.1 %]',
-[%      ELSE -%]
-        [% element.get_name %] => '[% type_prefix %]::[% element_type.1 %]',
-[%      END;
+-%]
+        [% element.get_name %] => '[% XSD.get_type_prefix(element_type.0) %]::[% element_type.1 %]',
+[%
    ELSE;
        IF (element.first_simpleType);
            THROW NOT_IMPLEMENTED , "Attributes with atomic simpleType definition are not implemented yet";
@@ -31,10 +33,12 @@ __PACKAGE__->_factory(
        ELSE;
            THROW NOT_IMPLEMENTED , "Neither simple nor complex atomic type - don't know what to do with it";
        END; %]
-        [% element.get_name %] => '[% type_prefix %]::[% complexType.get_name %]::_[% element.get_name %]',
+        [% element.get_name %] => '[% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %]::_[% element.get_name %]',
 [%  END;
 END -%]
    }
 );

 } # end BLOCK
+
+[% END %]
@@ -2,6 +2,8 @@
    INCLUDE complexType/restriction.tt(complexType = complexType);
 ELSIF (complexType.get_variety == 'sequence');
    INCLUDE complexType/extension.tt(complexType = complexType);
+ELSIF (complexType.get_variety == 'all');
+    INCLUDE complexType/extension.tt(complexType = complexType);
 ELSE;
    THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
 END;
@@ -1,5 +1,5 @@
 [% IF (complexType.get_contentModel == 'simpleContent');
-    THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType simpleContent not implemented yet";
+    INCLUDE complexType/simpleContent.tt(complexType = complexType);
 ELSIF (complexType.get_contentModel == 'complexContent');
    INCLUDE complexType/complexContent.tt(complexType = complexType);
 ELSE;
@@ -20,7 +20,7 @@ END;
 complexType.set_element( element_list );

 -%]
-use base qw([% type_prefix %]::[% base_name.1.replace('\.', '::') %]);
+use base qw([% XSD.get_type_prefix(base_name.0) %]::[% base_name.1.replace('\.', '::') %]);
 [%

 INCLUDE complexType/variety.tt(complexType = complexType);
@@ -1,7 +1,7 @@
 [% IF (base=complexType.get_base);
    base_name=complexType.expand(base);
 -%]
-use base qw([% type_prefix %]::[% base_name.1.replace('\.', '::') %]);
+use base qw([% XSD.get_type_prefix(base_name.0) %]::[% base_name.1.replace('\.', '::') %]);
 [%
 ELSE;
    THROW NOT_IMPLEMENTED, "restriction without base not supported";
@@ -0,0 +1,8 @@
+[% IF (complexType.get_variety == 'restriction');
+    INCLUDE complexType/restriction.tt(complexType = complexType);
+ELSIF (complexType.get_variety == 'extension');
+    THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType simpleContent extension not implemented yet";
+ELSE;
+    THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
+END;
+%]
@@ -1,4 +1,5 @@
-package [% element_prefix %]::[% element.get_name.replace('\.','::') %];
+[% USE XSD(context) %]
+package [% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name.replace('\.','::') %];
 use strict;
 use warnings;

@@ -44,7 +45,7 @@ use base qw(

 }

-package [% element_prefix %]::[% element.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
+package [% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
 use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
 [% INCLUDE complexType/attributeSet.tt %]

@@ -66,7 +67,7 @@ use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);

 [% head1 %] NAME

-[% element_prefix %]::[% element.get_name %]
+[% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name %]

 [% head1 %] DESCRIPTION

@@ -77,7 +78,7 @@ Perl data type class for the XML Schema defined element

 [% head2 %] new

- my $element = [% element_prefix %]::[% element.get_name %]->new($data);
+ my $element = [% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name %]->new($data);

 Constructor. The following data structure may be passed to new():

@@ -1,4 +1,5 @@
-package [% type_prefix %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %];
+[% USE XSD(context) -%]
+package [% XSD.get_type_prefix(simpleType.get_targetNamespace) %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %];
 use strict;
 use warnings;

@@ -20,7 +21,7 @@ __END__

 [% pod %]

-[% head1 %] [% type_prefix %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %]
+[% head1 %] [% XSD.get_type_prefix(simpleType.get_targetNamespace) %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %]

 [% head1 %] DESCRIPTION