foreach ($_->operation) { my $opername = $_->name; my $soapaction = $_->operation->soapAction; my $namespace = $_->input->body->namespace; my (@parts, @headers); foreach ($s->portType) { next unless $_->name eq $porttype; foreach ($_->operation) { next unless $_->name eq $opername; my $inputmessage = SOAP::Utils::disqualify($_->input->message); my $inputheader = $_->input->header ? SOAP::Utils::disqualify($_->input->header) : ''; foreach ($s->message) { if ($_->name eq $inputmessage) { @parts = $_->part; } elsif ($_->name eq $inputheader) { @headers = $_->part; } } } } $services{$opername} = {}; for ($services{$opername}) { $_->{endpoint} = $endpoint; $_->{soapaction} = $soapaction; $_->{uri} = $namespace; $_->{parameters} = [@parts]; $_->{header} = [@headers] if @headers; . } . } #### join("\n", "package $package;\n", "# -- generated by SOAP::Lite (v$SOAP::Lite::VERSION) for Perl -- soaplite.com -- Copyright (C) 2000-2001 Paul Kulchenko --",
($schema ? "# -- generated from $schema [@{[scalar localtime]}]\n" : "\n"), 'my %methods = (', (map { my $service = $_; join("\n", " $_ => {", map(" $_ => '$services->{$service}{$_}',", qw/endpoint soapaction uri/), " header => [", map(" SOAP::Header->new(name => '" . $_->name . "', type => '" . $_->type . "', attr => {" . do{ my %attr = %{$_->attr}; join ‘, ', map {"'$_' => '$attr{$_}'"} grep {/^xmlns:(?!-)/} keys %attr} . "}),", @{$services->{$service}{header}}), " ],", " parameters => [", map(" SOAP::Data->new(name => '" . $_->name . "', type => '" . $_->type . "', attr => {" . do{ my %attr = %{$_->attr}; join ', ', map {"'$_' => '$attr{$_}'"} grep {/^xmlns:(?!-)/} keys %attr} . "}),", @{$services->{$service}{parameters}}), " ],\n },", ), } keys %$services), ");", <<'EOP'); . . . my @templates = (@{$method{header}}, @{$method{parameters}}); my $som = $self -> endpoint($method{endpoint}) -> uri($method{uri}) -> on_action(sub{qq!"$method{soapaction}"!}) -> call($method => map {@templates ? shift(@templates)->value($_) : $_} @_); UNIVERSAL::isa($som => 'SOAP::SOM') ? wantarray ? $som->paramsall : $som->result : $som;