File Coverage

blib/lib/SOAP/WSDL/Generator/Iterator/WSDL11.pm

Criterion	Covered	Total	%
statement	9	26	34.6
branch	0	10	0.0
condition			n/a
subroutine	3	6	50.0
pod	0	3	0.0
total	12	45	26.6

package SOAP::WSDL::Generator::Iterator::WSDL11;
use strict; use warnings;
use Class::Std::Fast;

our $VERSION = 3.003;

my %definitions_of  :ATTR(:name    :default<[]>);
my %nodes_of        :ATTR(:name          :default<[]>);

# memoization attributes
my %portType_of     :ATTR();
my %types_of        :ATTR();

my %METHOD_OF = (
    'SOAP::WSDL::Definitions'   => 'get_service',
    'SOAP::WSDL::Service'       => 'get_port',
    'SOAP::WSDL::Port'          => sub {
        my ($self, $node) = @_;
        return if ! $node->first_address()
            or ! $node->first_address()->isa('SOAP::WSDL::SOAP::Address');

        return [ $self->get_definitions()
            ->find_binding( $node->expand( $node->get_binding() ) ) || () ];
    },

    'SOAP::WSDL::Binding'       => sub {
        my ($self, $node) = @_;

        # remember referenced portType
        $portType_of{ ident $self } = $self->get_definitions()
            ->find_portType( $node->expand( $node->get_type ) )
            or return [];

        return $node->get_operation();
    },

    'SOAP::WSDL::Operation'     => sub {
        my ($self, $node) = @_;

        my $name = $node->get_name();

        # get the equally named operation from the portType
        my ($op) = grep { $_->get_name() eq $name }
            @{ $portType_of{ ident $self }->get_operation() }
            or return [];

        return [ @{ $op->get_input }, @{ $op->get_output }, @{ $op->get_fault } ]
    },

    'SOAP::WSDL::OpMessage' => sub {
        my ($self, $node) = @_;
        return if ( ref $node->get_parent() eq 'SOAP::WSDL::Binding' );    # we're in binding

        # TODO maybe allow more messages && overloading by specifying name

        return [ $self->get_definitions()->find_message(
            $node->expand( $node->get_message() )
        ) || () ];
    },

    'SOAP::WSDL::Message'       => 'get_part',

    'SOAP::WSDL::Part'          => sub {
        my ($self, $node) = @_;
        my $ident = ident $self;
        my $types = $types_of{ $ident } = $definitions_of{ $ident }->get_types()->[0]
            or return [];
        return [
            # If we have a type, this type is to be used in document/literal
            # as global type. However this is forbidden, at least by WS-I.
            # We should store the style/encoding somewhere, and regard it.
            # TODO: auto-generate element for RPC bindings
            $node->get_type()
                ? do {
                    die "unsupported global type <"
                        . $node->get_type . "> found in part <". $node->get_name() . ">\n"
                        . "Looks like a rpc/literal WSDL, which is not supported by SOAP::WSDL\n";
                    ## use this once we can auto-generate an element for RPC bindings
                    # $types->find_type( $node->expand($node->get_type) )
                }
                : (),
            $node->get_element()
                ? $types->find_element( $node->expand($node->get_element) )
                : (),
        ];
    },
);

sub init {
    my ($self, $arg_of) = @_;
    my $ident = ident $self;
    undef $portType_of{ $ident };
    undef $types_of{ $ident };
    $nodes_of{ $ident } = [
        exists($arg_of->{ node })
            ? $arg_of->{ node }
            : $definitions_of{ ident $self }
        ];
}

sub get_next {
    my $self = shift;
    my $ident = ident $self;

    my $node = shift @{ $nodes_of{ $ident }};
    return if ! defined $node;

    unshift @{ $nodes_of{ $ident }}, @{ $self->get_nextNodes( $node ) || [] };

    return $node;
}

sub get_nextNodes {
    my ($self, $node) = @_;

    my $method = $METHOD_OF{ ref $node }
        or return [];

    return (ref($method) eq 'CODE')
        ? $method->( $self, $node )
        : $node->can($method)->( $node );
}

1;

__END__