import SOAP-WSDL 2.00_06 from CPAN

git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_06
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_06.tar.gz
This commit is contained in:
Martin Kutter authored and Michael G. Schwern committed 2009-12-12 19:47:44 -08:00
1 parent a78d6d15b5
commit 25548e6296
45 files changed
+2227 -844

No files matched your search

+50 -66
View File
@@ -8,45 +8,44 @@ my %operation_of :ATTR(:name<operation> :default<()>);
my %type_of :ATTR(:name<type> :default<()>);
my %transport_of :ATTR(:name<transport> :default<()>);
my %style_of :ATTR(:name<style> :default<()>);
sub explain {
my $self = shift;
my $opt = shift;
sub explain {
my $self = shift;
my $opt = shift;
my $name = $self->get_name();
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
my ($prefix, $localname) = split /:/ , $self->get_type();
die 'required atribute wsdl missing' if not $opt->{ wsdl };
my $portType = $opt->{ wsdl }->find_portType(
$ns_map{ $prefix }, $localname
) or die "portType $prefix:$localname not found !";
$opt->{ wsdl }->_expand( $self->get_type() )
) or die 'portType not found: ' . $self->get_type();
my $txt = <<"EOT";
Transport: $transport_of{ ident $self }
=head2 METHODS
my $txt = <<"EOT";
B<Note:>
=head2 Binding name: $name
=over
=item * Style $style_of{ ident $self }
=item * Transport $transport_of{ ident $self }
=back
=head3 Operations
Input, output and fault messages are stated as perl hash refs.
These are only for informational purposes - the actual implementation
may be object trees, not hash refs, though the input messages may be passed
to the respective methods as hash refs and will be converted to object trees
automatically.
EOT
foreach my $operation (@{ $self->get_operation() })
{
foreach my $operation (@{ $self->get_operation() }) {
my $operation_name = $operation->get_name();
my $operation_style = $operation->get_style() || q{};
my $port_operation = $portType->find_operation( $ns_map{ $prefix },
$operation->get_name() )
or die "operation not found:" . $operation->get_name();
my ($port_operation) = grep { $_->get_name eq $operation_name }
@{ $portType->get_operation() }
or die "operation not found:" . $operation->get_name();
# TODO rename lexical $input to "message"
my $input_message = do {
my $input = $port_operation->first_input();
@@ -60,70 +59,55 @@ EOT
my $input = $port_operation->first_fault();
$input ? $input->explain($opt) : q{};
};
$txt .= <<"EOT";
=over
=item * $operation_name
=head3 $operation_name
=over 8
=item * Style: $operation_style
=item * Input Message:
B<Input Message:>
$input_message
=item * Output Message:
B<Output Message:>
$output_message
=item * Fault:
B<Fault:>
$fault_message
=back
=back
EOT
}
}
return $txt;
return $txt;
}
sub to_typemap {
my ($self, $opt) = @_;
my $name = $self->get_name();
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
my ($prefix, $localname) = split /:/ , $self->get_type();
my $portType = $opt->{ wsdl }->find_portType(
$ns_map{ $prefix }, $localname
) or die "portType $prefix:$localname not found !";
$opt->{ wsdl }->_expand( $self->get_type )
) or die 'portType not found: ' . $self->get_type;
my $txt = q{};
foreach my $operation (@{ $self->get_operation() })
{
my $operation_name = $operation->get_name();
my $operation_style = $operation->get_style() || q{};
my $port_operation = $portType->find_operation( $ns_map{ $prefix },
$operation->get_name() )
or die "operation not found:" . $operation->get_name();
# TODO rename lexical $input to "message"
$txt .= do {
my $input = $port_operation->first_input();
$input ? $input->to_typemap($opt) : q{};
};
$txt .= do {
my $input = $port_operation->first_output();
$input ? $input->to_typemap($opt) : q{};
};
$txt .= do {
my $input = $port_operation->first_fault();
$input ? $input->to_typemap($opt) : q{};
};
my ($port_operation) = grep { $_->get_name eq $operation_name }
@{ $portType->get_operation() }
or die "operation not found:" . $operation->get_name();
no strict qw(refs);
$txt .= join q{},
map {
my $message = $port_operation->$_;
$message
? $message->to_typemap($opt)
: q{}
} qw(first_input first_output first_fault);
}
return $txt;
}