view release on metacpan or  search on metacpan

lib/SOAP/WSDL.pm  view on Meta::CPAN

    my $wsdl = $definitions_of{ $ident };
    my $port = $self->_wsdl_get_port();
    $binding_of{ $ident } = $wsdl->find_binding( $port->expand( $port->get_binding() ) )
        or croak "no binding found for ", $port->get_binding();
    return $binding_of{ $ident };
}

sub _wsdl_get_portType :PRIVATE {
    my $self    = shift;
    my $ident   = ident $self;
    my $wsdl    = $definitions_of{ $ident };
    my $binding = $self->_wsdl_get_binding();
    $porttype_of{ $ident } = $wsdl->find_portType( $binding->expand( $binding->get_type() ) )
        or croak "cannot find portType for " . $binding->get_type();
    return $porttype_of{ $ident };
}

sub _wsdl_init_methods :PRIVATE {
    my $self = shift;
    my $ident = ident $self;
    my $wsdl = $definitions_of{ $ident };
    my $ns   = $wsdl->get_targetNamespace();

    # get bindings, portType, message, part(s) - use private methods for clear separation...
    $self->_wsdl_get_service();
    $self->_wsdl_get_portType();

    $method_info_of{ $ident } = {};

    foreach my $binding_operation (@{ $binding_of{ $ident }->get_operation() })
    {
        my $method = {};

        # get SOAP Action
        # SOAP-Action is a required HTTP Header, so we need to look it up...
        # There must be a soapAction uri - or the WSDL is invalid (and
        # it's not us to prove that...)
        my $soap_binding_operation = $binding_operation->get_operation()->[0];
        $method->{ soap_action } = $soap_binding_operation->get_soapAction();

        # get parts
        # 1. get operation from port
        my $operation = $porttype_of{ $ident }->find_operation( $ns,
            $binding_operation->get_name() );

        # 2. get input message name
        my ( $prefix, $localname ) = split /:/xm,
          $operation->first_input()->get_message();

        # 3. get input message
        my $message = $wsdl->find_message( $ns, $localname )
          or croak "Message {$ns}$localname not found in WSDL definition";

        # Is body not required? So there must be one? Do we need the "if"?
        # if (
        my $body=$binding_operation->first_input()->first_body();
        # {
            if ($body->get_parts()) {
                $method->{ parts } = [];        # make sure it's empty
                my $message_part_ref = $message->get_part();
                for my $name ( split m{\s}xm , $body->get_parts() ) {
                    $name =~s{ \A [^:]+: }{}xm;  # throw away ns prefix
                    # could probably made more efficient, but our lists are
                    # usually quite short
                    push @{ $method->{ parts } },
                        grep { $_->get_name() eq $name } @{ $message_part_ref };
                }
            }
        # }
        # A body does not need to specify the parts of a messages.
        # Use all of the message's parts if it does not.
        $method->{ parts } ||= $message->get_part();

        # rpc / encoded methods may have a namespace specified.
        # look it up and set it...
        $method->{ namespace } = $binding_operation
            ? do {
                my $input = $binding_operation->first_input();
                $input ? $input->first_body()->get_namespace() : undef;
            }
            : undef;

        $method_info_of{ $ident }->{ $binding_operation->get_name() } = $method;
    }

    return $method_info_of{ $ident };
}

# on_action is a no-op and just here for compatibility reasons.
# It returns the first parameter to allow method chaining.
sub on_action { return shift }

sub call {
    my ($self, $method, @data_from) = @_;
    my $ident = ${ $self };

    my ($data, $header) = ref $data_from[0]
      ? ($data_from[0], $data_from[1] )
      : (@data_from>1)
          ? ( { @data_from }, undef )
          : ( $data_from[0], undef );

    $self->wsdlinit() if not ($definitions_of{ $ident });
    $self->_wsdl_init_methods() if not ($method_info_of{ $ident });

    my $client = $client_of{ $ident };

    $client->set_no_dispatch( $no_dispatch_of{ $ident } );
    $client->set_outputxml( $outputxml_of{ $ident } ? 1 : 0 );

    # only load ::Deserializer::SOM if we really need to deserialize to SOM.
    # maybe we should introduce something like $output{ $ident } with a fixed
    # set of values - m{^(TREE|HASH|XML|SOM)$}xms ?
    if ( ( ! $outputtree_of{ $ident } )
      && ( ! $outputhash_of{ $ident } )
      && ( ! $outputxml_of{ $ident } )
      && ( ! $no_dispatch_of{ $ident } ) ) {
        require SOAP::WSDL::Deserializer::SOM;
        $client->set_deserializer( SOAP::WSDL::Deserializer::SOM->new() );
    }