XML-Compile-WSDL11-3.08/ 0000755 0001750 0000144 00000000000 14112100572 015112 5 ustar 00markov users 0000000 0000000 XML-Compile-WSDL11-3.08/lib/ 0000755 0001750 0000144 00000000000 14112100572 015660 5 ustar 00markov users 0000000 0000000 XML-Compile-WSDL11-3.08/lib/XML/ 0000755 0001750 0000144 00000000000 14112100572 016320 5 ustar 00markov users 0000000 0000000 XML-Compile-WSDL11-3.08/lib/XML/Compile/ 0000755 0001750 0000144 00000000000 14112100572 017710 5 ustar 00markov users 0000000 0000000 XML-Compile-WSDL11-3.08/lib/XML/Compile/WSDL11/ 0000755 0001750 0000144 00000000000 14112100572 020623 5 ustar 00markov users 0000000 0000000 XML-Compile-WSDL11-3.08/lib/XML/Compile/WSDL11/xsd/ 0000755 0001750 0000144 00000000000 14112100572 021421 5 ustar 00markov users 0000000 0000000 XML-Compile-WSDL11-3.08/lib/XML/Compile/WSDL11/xsd/wsdl.xsd 0000644 0001750 0000144 00000026054 14112100555 023122 0 ustar 00markov users 0000000 0000000
This type is extended by component types to allow them to be documented
This type is extended by component types to allow attributes from other namespaces to be added.
This type is extended by component types to allow elements from other namespaces to be added.
Any top level optional element allowed to appear more then once - any child of definitions element except wsdl:types. Any extensibility element is allowed in any place.
XML-Compile-WSDL11-3.08/lib/XML/Compile/WSDL11/xsd/wsdl-http.xsd 0000644 0001750 0000144 00000005022 14112100555 024067 0 ustar 00markov users 0000000 0000000
XML-Compile-WSDL11-3.08/lib/XML/Compile/WSDL11/xsd/wsdl-mime.xsd 0000644 0001750 0000144 00000005304 14112100555 024042 0 ustar 00markov users 0000000 0000000
XML-Compile-WSDL11-3.08/lib/XML/Compile/WSDL11.pod 0000644 0001750 0000144 00000055437 14112100570 021343 0 ustar 00markov users 0000000 0000000 =encoding utf8
=head1 NAME
XML::Compile::WSDL11 - create SOAP messages defined by WSDL 1.1
=head1 INHERITANCE
XML::Compile::WSDL11
is a XML::Compile::Cache
is a XML::Compile::Schema
is a XML::Compile
=head1 SYNOPSIS
# preparation
use XML::Compile::WSDL11; # use WSDL version 1.1
use XML::Compile::SOAP11; # use SOAP version 1.1
use XML::Compile::Transport::SOAPHTTP;
# you want some trace?
use Log::Report mode => 'DEBUG'; # or 'VERBOSE'
# collect one or more wsdls and xsds in one object
my $wsdl = XML::Compile::WSDL11->new($wsdlfile
, server_type => 'BEA'
);
$wsdl->addWSDL(...more WSDL files...);
$wsdl->importDefinitions(...more schemas...);
# during initiation, for each used call
my $call = $wsdl->compileClient('GetStockPrice', ...);
# at "run-time", call as often as you want (fast)
my $answer = $call->(%request);
# capture useful trace information
my ($answer, $trace) = $call->(%request);
if($trace->errors)
{ $trace->printError;
}
# no need to administer the operations by hand: alternative
$wsdl->compileCalls; # at initiation
my $answer = $wsdl->call(GetStockPrice => %request);
# investigate the %request structure (server input)
print $wsdl->explain('GetStockPrice', PERL => 'INPUT', recurse => 1);
# investigate the $answer structure (server output)
print $wsdl->explain('GetStockPrice', PERL => 'OUTPUT');
# when you like, get all operation definitions
my @all_ops = $wsdl->operations;
# Install XML::Compile::SOAP::Daemon
my $server = XML::Compile::SOAP::HTTPDaemon->new;
$server->operationsFromWSDL($wsdl);
undef $wsdl; # not needed any further
# For debug info, start your script with:
use Log::Report mode => 'DEBUG';
=head1 DESCRIPTION
This module understands WSDL version 1.1. An WSDL file defines a set of
messages to be send and received over (SOAP) connections. This involves
encoding of the message to be send into XML, sending the message to the
server, collect the answer, and finally decoding the XML to Perl.
As end-user, you do not have to worry about the complex details of the
messages and the way to exchange them: it's all simple Perl for you.
Also, faults are handled automatically. The only complication you have
to worry about is to shape a nested HASH structure to the sending
message structure. L may help you.
When the definitions are spread over multiple files you will need to
use L (wsdl) or L (additional schema's)
explicitly. Usually, interreferences between those files are broken.
Often they reference over networks (you should never trust). So, on
purpose you B the files you need from local disk!
(of course, it is simple to find one-liners as work-arounds, but I will
not tell you how! See L)
Extends L<"DESCRIPTION" in XML::Compile::Cache|XML::Compile::Cache/"DESCRIPTION">.
=head1 METHODS
Extends L<"METHODS" in XML::Compile::Cache|XML::Compile::Cache/"METHODS">.
=head2 Constructors
Extends L<"Constructors" in XML::Compile::Cache|XML::Compile::Cache/"Constructors">.
=over 4
=item XML::Compile::WSDL11-EB( [$xml], %options )
The $xml is the WSDL file, which is anything accepted by
L.
-Option --Defined in --Default
allow_undeclared XML::Compile::Cache
any_element XML::Compile::Cache 'ATTEMPT'
block_namespace XML::Compile::Schema []
hook XML::Compile::Schema undef
hooks XML::Compile::Schema []
ignore_unused_tags XML::Compile::Schema
key_rewrite XML::Compile::Schema []
opts_readers XML::Compile::Cache []
opts_rw XML::Compile::Cache []
opts_writers XML::Compile::Cache []
parser_options XML::Compile
prefixes XML::Compile::Cache
schema_dirs XML::Compile undef
server_type undef
typemap XML::Compile::Cache {}
xsi_type XML::Compile::Cache {}
=over 2
=item allow_undeclared => BOOLEAN
=item any_element => CODE|'TAKE_ALL'|'SKIP_ALL'|'ATTEMPT'|'SLOPPY'
=item block_namespace => NAMESPACE|TYPE|HASH|CODE|ARRAY
=item hook => $hook|ARRAY
=item hooks => ARRAY
=item ignore_unused_tags => BOOLEAN|REGEXP
=item key_rewrite => HASH|CODE|ARRAY
=item opts_readers => HASH|ARRAY-of-PAIRS
=item opts_rw => HASH|ARRAY-of-PAIRS
=item opts_writers => HASH|ARRAY-of-PAIRS
=item parser_options => HASH|ARRAY
=item prefixes => HASH|ARRAY-of-PAIRS
=item schema_dirs => $directory|ARRAY-OF-directories
=item server_type => NAME
[3.01] When you specify the implementation of the server, we can work
around some of the known bugs and limitation.
Read L section "Supported servers" for supported
servers.
=item typemap => HASH|ARRAY
=item xsi_type => HASH|ARRAY
=back
=back
=head2 Accessors
Extends L<"Accessors" in XML::Compile::Cache|XML::Compile::Cache/"Accessors">.
=over 4
=item $obj-EB($hook|LIST|undef)
Inherited, see L
=item $obj-EB( $hook, [$hook, ...] )
Inherited, see L
=item $obj-EB($predef|CODE|HASH, ...)
Inherited, see L
=item $obj-EB(@directories|$filename)
=item XML::Compile::WSDL11-EB(@directories|$filename)
Inherited, see L
=item $obj-EB($xml, %options)
Inherited, see L
=item $obj-EB(PAIR)
Inherited, see L
=item $obj-EB(PAIRS)
Inherited, see L
=item $obj-EB( [HASH|ARRAY|LIST] )
Inherited, see L
=item $obj-EB( [BOOLEAN] )
Inherited, see L
=item $obj-EB('ATTEMPT'|'SLOPPY'|'SKIP_ALL'|'TAKE_ALL'|CODE)
Inherited, see L
=item $obj-EB($ns|$type|HASH|CODE|ARRAY)
Inherited, see L
=item $obj-EB( [<'READER'|'WRITER'>] )
Inherited, see L
=item $obj-EB( [HASH|ARRAY|PAIRS] )
Inherited, see L
=item $obj-EB( $schema, [$schema, ...] )
Inherited, see L
=back
=head2 Prefix management
Extends L<"Prefix management" in XML::Compile::Cache|XML::Compile::Cache/"Prefix management">.
=over 4
=item $obj-EB(BASE, NAMESPACE)
Inherited, see L
=item $obj-EB( [PAIRS|ARRAY|HASH] )
Inherited, see L
=item $obj-EB($node)
Inherited, see L
=item $obj-EB($prefix)
Inherited, see L
=item $obj-EB($uri)
Inherited, see L
=item $obj-EB( $type|<$ns,$local> )
Inherited, see L
=item $obj-EB( [$params] )
Inherited, see L
=back
=head2 Compilers
Extends L<"Compilers" in XML::Compile::Cache|XML::Compile::Cache/"Compilers">.
=over 4
=item $obj-EB( ['READERS'|'WRITERS'|'RW'], %options )
Inherited, see L
=item $obj-EB($opname, $data)
[2.20] Call the $opname (operation name) with $data (HASH or LIST of parameters).
This only works when you have called L beforehand,
always during the initiation phase of the program.
example:
# at initiation time (compile once)
$wsdl->compileCalls;
# at runtime (run often)
my $answer = $wsdl->call($operation, $request);
=item $obj-EB( <'READER'|'WRITER'>, $type, %options )
Inherited, see L
=item $obj-EB( [ <'READERS'|'WRITERS'|'RW'|'CALLS'>, [$ns] ] )
[2.20] With explicit C or without any parameter, it will call
L. Otherwise, see L.
=item $obj-EB($operation|$opname, %options)
[2.37] The call to the $operation object (which extends
L) gets compiled and cached so it can
be used with L.
[2.38] Alteratively to an $operation object, you may also specify an
operation by name.
-Option--Default
alias undef
=over 2
=item alias => NAME
[3.03] When defined, the compiled operation will be stored with the
alias name in stead of the operation name. This may make your code
more readible or solve naming conflicts.
=back
example:
my $op = $wsdl->operation(name => 'getInfo');
$wsdl->compileCall($op);
# as often as you need it
my ($answer, $trace) = $wsdl->call('getInfo')->(%request);
=item $obj-EB(%options)
[2.20] Compile a handler for each of the available operations. The %options are
passed to each call of L, but will be overruled by more
specific declared options.
Additionally, %options can contain C, C, and C
to limit the set of involved calls. See L for details on
these options.
You may declare additional specific compilation options with the
L method.
-Option --Default
long_names false
=over 2
=item long_names => BOOLEAN
[3.03] Prepend the service name to the operation name to produce an alias
(see L) for the compiled call. If the service name is
'X' and the operation name is 'Y', then the alias becomes 'X#Y'.
You will need this if you have multiple operations with the same name
in your WSDL (-collection).
=back
example:
my $trans = XML::Compile::Transport::SOAPHTTP
->new(timeout => 500, address => $wsdl->endPoint);
$wsdl->compileCalls(transport => $trans);
# alternatives for simple cases
$wsdl->compileAll('CALLS');
$wsdl->compileAll;
my $answer = $wsdl->call($myop, $request);
=item $obj-EB( <'READER'|'WRITER'>, $type, %options )
Inherited, see L
=item $obj-EB($node|REF-XML|XML-STRING|$filename|$fh|$known)
=item XML::Compile::WSDL11-EB($node|REF-XML|XML-STRING|$filename|$fh|$known)
Inherited, see L
=item $obj-EB(%options)
=item XML::Compile::WSDL11-EB(%options)
Inherited, see L
=item $obj-EB($type|$name, %options)
Inherited, see L
=item $obj-EB( <'XML'|'PERL'|'TREE'>, $element, %options )
Inherited, see L
=item $obj-EB($type|$name)
Inherited, see L
=back
=head2 Extension
=over 4
=item $obj-EB($xmldata|\@xmldata, %options)
The $xmldata must be acceptable to L and
should represent the top-level of a (partial) WSDL document.
The specification can be spread over multiple files, each of
which must have a C root element.
=item $obj-EB( [$name], %options )
Creates an L temporary object using
L, and then calls C on that. This
results in a code reference which will handle all client-server
SOAP exchange.
The %options available include all of the options for:
=over 4
=item *
L (i.e. C and C), and all of
=item *
L (there are many of
these, for instance C and C)
=back
You B pass options for L, like
C< 0>>, hooks or typemaps this way. Use L
and friends to declare those.
When you use L, the compiled code references get cached
for you. In that case, you can use L to use them.
example:
my $call = $wsdl->compileClient
( operation => 'HelloWorld'
, port => 'PrefillSoap' # only required when multiple ports
);
my ($answer, $trace) = $call->($request);
# 'operation' keyword optional
my $call = $wsdl->compileClient('HelloWorld');
=item $obj-EB($class)
Returns the list of names available for a certain definition $class in
the WSDL. See L for a way to determine the available $class
information.
=item $obj-EB( [$name], %options )
Collect all information for a certain operation. Returned is an
L object.
An operation is defined by a service name, a port, some bindings,
and an operation name, which can be specified explicitly and is often
left-out: in the many configurations where there are no alternative
choices. In case there are alternatives, you will be requested to
pick an option.
-Option --Default
action
operation
port
server_type undef
service
=over 2
=item action => STRING
Overrule the soapAction from the WSDL.
=item operation => NAME
Ignored when the parameter list starts with a $name (which is an
alternative for this option). Optional when there is only
one operation defined within the portType.
=item port => NAME
Required when more than one port is defined.
=item server_type => NAME
Overrules L.
=item service => QNAME|PREFIXED
Required when more than one service is defined.
=back
=back
=head2 Administration
Extends L<"Administration" in XML::Compile::Cache|XML::Compile::Cache/"Administration">.
=over 4
=item $obj-EB($group, $component|ARRAY, %options)
Register specific compile %options for the specific $component. See also
L. The $group is either C,
C, C (both reader and writer), or C. As $component,
you specify the element name (for readers and writers) or operation name
(for operations). %options are specified as LIST, ARRAY or HASH.
example:
$wsdl->declare(OPERATION => 'GetStockPrice', @extra_opts);
$wsdl->compileCalls;
my $answer = $wsdl->call(GetStockPrice => %request);
=item $obj-EB($exttype, $basetype)
Inherited, see L
=item $obj-EB()
Inherited, see L
=item $obj-EB($name)
Inherited, see L
=item $obj-EB($filename)
=item XML::Compile::WSDL11-EB($filename)
Inherited, see L
=item $obj-EB($xmldata, %options)
Inherited, see L
=item $obj-EB($ns|PAIRS)
=item XML::Compile::WSDL11-EB($ns|PAIRS)
Inherited, see L
=item $obj-EB()
Inherited, see L
=item $obj-EB()
Inherited, see L
=item $obj-EB($node, CODE)
Inherited, see L
=back
=head2 Introspection
All of the following methods are usually NOT meant for end-users. End-users
should stick to the L and L methods.
=over 4
=item $obj-EB(%options)
[2.20] Returns the address of the server, as specified by the WSDL. When
there are no alternatives for service or port, you not not need to
specify those parameters.
The endpoint in the WSDL is often wrong. All compile functions accept
the C and C parameters to overrule the value. With
C, only the hostname:port is being replaced. With C,
everything is replaced.
-Option --Default
port
service
=over 2
=item port => NAME
=item service => QNAME|PREFIXED
=back
example:
my $devel = URI->new($wsdl->endPoint);
$devel->path('/sdk');
my $call = $wsdl->compileCall($opname, endpoint => $devel);
=item $obj-EB($operation, $format, $direction, %options)
[2.13]
Produce templates (see L which detail
the use of the $operation. Currently, only the C template $format
is available.
The $direction of operation is either C (from the server,
received by the client).
The actual work is done by L. The
%options passed to that method include C and C.
example:
print $wsdl->explain('CheckStatus', PERL => 'INPUT');
print $wsdl->explain('CheckStatus', PERL => 'OUTPUT'
, recurse => 1 # explain options
, port => 'Soap12PortName' # operation options
);
foreach my $op ($wsdl->operations)
{ print $op->explain($wsdl, PERL => 'INPUT');
}
=item $obj-EB( $class, <$qname|$prefixed|$name> )
With a $qname, the HASH which contains the parsed XML information
from the WSDL template for that $class-$name combination is returned.
You may also have a $prefixed name, using one of the predefined namespace
abbreviations. Otherwise, $name is considered to be the localName in
that class. When the $name is not found, an error is produced.
Without $qname in SCALAR context, there may only be one such name
defined otherwise an error is produced. In LIST context, all definitions
in $class are returned.
example:
$service = $obj->findDef(service => 'http://xyz');
@services = $obj->findDef('service');
=item $obj-EB( [$class, [$qname]] )
With a $class and $qname, it returns one WSDL definition HASH or undef.
Returns the index for the $class group of names as HASH. When no $class is
specified, a HASH of HASHes is returned with the CLASSes on the top-level.
$class includes C, C, C, and C.
=item $obj-EB(%options)
Return a list with all operations defined in the WSDL.
-Option --Default
binding
port
server_type undef
service
=over 2
=item binding => NAME
Only return operations which use the binding with the specified NAME.
By default, all bindings are accepted.
=item port => NAME
Return only operations related to the specified port NAME.
By default operations from all ports.
=item server_type => STRING
[3.06]
=item service => NAME
Only return operations related to the NAMEd service, by default all services.
=back
=item $obj-EB( [$fh], %options )
For available %options, see L. This method is useful to
understand the structure of your WSDL: it shows a nested list of
services, bindings, ports and portTypes.
-Option --Defined in --Default
show_declared XML::Compile::Cache
=over 2
=item show_declared => BOOLEAN
=back
=back
=head1 DETAILS
Extends L<"DETAILS" in XML::Compile::Cache|XML::Compile::Cache/"DETAILS">.
=head2 Distribution collection overview
Extends L<"Distribution collection overview" in XML::Compile::Cache|XML::Compile::Cache/"Distribution collection overview">.
=head2 Comparison
Extends L<"Comparison" in XML::Compile::Cache|XML::Compile::Cache/"Comparison">.
=head2 Collecting definitions
Extends L<"Collecting definitions" in XML::Compile::Cache|XML::Compile::Cache/"Collecting definitions">.
=head2 Addressing components
Extends L<"Addressing components" in XML::Compile::Cache|XML::Compile::Cache/"Addressing components">.
=head2 Representing data-structures
Extends L<"Representing data-structures" in XML::Compile::Cache|XML::Compile::Cache/"Representing data-structures">.
=head2 Schema hooks
Extends L<"Schema hooks" in XML::Compile::Cache|XML::Compile::Cache/"Schema hooks">.
=head2 Typemaps
Extends L<"Typemaps" in XML::Compile::Cache|XML::Compile::Cache/"Typemaps">.
=head2 Handling xsi:type
Extends L<"Handling xsi:type" in XML::Compile::Cache|XML::Compile::Cache/"Handling xsi:type">.
=head2 Key rewrite
Extends L<"Key rewrite" in XML::Compile::Cache|XML::Compile::Cache/"Key rewrite">.
=head2 Initializing SOAP operations via WSDL
When you have a WSDL file, then SOAP is simple. If there is no such file
at hand, then it is still possible to use SOAP. See the DETAILS chapter
in L.
The WSDL file contains operations which can be addressed by name.
In the WSDL file you need to find the name of the port to be used.
In most cases, the WSDL has only one service, one port, one binding,
and one portType and those names can therefore be omitted. If there is
a choice, then you must explicitly select one.
use XML::Compile::WSDL11 ();
# once in your program
my $wsdl = XML::Compile::WSDL11->new('def.wsdl');
# XML::Compile::Schema refuses to follow "include" and
# "import" commands, so you need to invoke them explicitly.
# $wsdl->addWSDL('file2.wsdl'); # optional
# $wsdl->importDefinitions('schema1.xsd'); # optional
# once for each of the defined operations
my $call = $wsdl->compileClient('GetStockPrice');
# see XML::Compile::SOAP chapter DETAILS about call params
my $answer = $call->(%request);
=head1 DESCRIPTIONS
Extends L<"DESCRIPTIONS" in XML::Compile::Cache|XML::Compile::Cache/"DESCRIPTIONS">.
=head1 SEE ALSO
This module is part of XML-Compile-WSDL11 distribution version 3.08,
built on August 27, 2021. Website: F]. For other contributors see ChangeLog.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See F].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution XML-Compile-WSDL11. Meta-POD processed
# with OODoc into POD and HTML manual-pages. See README.md
# Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
package XML::Compile::WSDL11;
use vars '$VERSION';
$VERSION = '3.08';
use base 'XML::Compile::Cache';
use warnings;
use strict;
use Log::Report 'xml-compile-soap';
use XML::Compile ();
use XML::Compile::Util qw/pack_type unpack_type/;
use XML::Compile::SOAP ();
use XML::Compile::SOAP::Util qw/:wsdl11/;
use XML::Compile::SOAP::Extension;
use XML::Compile::SOAP::Operation ();
use XML::Compile::Transport ();
use File::Spec ();
use List::Util qw/first/;
use Scalar::Util qw/blessed/;
use File::Basename qw/dirname/;
sub init($)
{ my ($self, $args) = @_;
$args->{schemas} and panic "new(schemas) option removed in 0.78";
my $wsdl = delete $args->{top};
local $args->{any_element} = 'ATTEMPT';
local $args->{any_attribute} = 'ATTEMPT'; # not implemented
local $args->{allow_undeclared} = 1;
$self->SUPER::init($args);
$self->{index} = {};
$self->addPrefixes(wsdl => WSDL11, soap => WSDL11SOAP, http => WSDL11HTTP);
# next modules should change into an extension as well...
$_->can('_initWSDL11') && $_->_initWSDL11($self)
for XML::Compile::SOAP->registered;
XML::Compile::SOAP::Extension->wsdl11Init($self, $args);
$self->declare
( READER => 'wsdl:definitions'
, key_rewrite => 'PREFIXED(wsdl,soap,http)'
, hook => {type => 'wsdl:tOperation', after => 'ELEMENT_ORDER'}
);
$self->{XCW_dcopts} = {};
$self->{XCW_server} = $args->{server_type};
my @xsds = map File::Spec->catdir(dirname(__FILE__), 'WSDL11', 'xsd', $_)
, qw(wsdl.xsd wsdl-mime.xsd wsdl-http.xsd);
$self->importDefinitions(\@xsds, element_form_default => 'qualified');
$self->addWSDL($_) for ref $wsdl eq 'ARRAY' ? @$wsdl : $wsdl;
$self;
}
sub schemas(@) { panic "schemas() removed in v2.00, not needed anymore" }
#--------------------------
sub compileAll(;$$)
{ my ($self, $need, $usens) = @_;
$self->SUPER::compileAll($need, $usens)
if !$need || $need ne 'CALLS';
$self->compileCalls
if !$need || $need eq 'CALLS';
$self;
}
sub compileCalls(@)
{ my ($self, %args) = @_;
my $long = $args{long_names};
my @ops = $self->operations
( service => delete $args{service}
, port => delete $args{port}
, binding => delete $args{binding}
);
foreach my $op (@ops)
{ my $alias = $long ? $op->longName : undef;
$self->compileCall($op, alias => $alias, %args);
}
$self;
}
sub compileCall($@)
{ my ($self, $oper, %opts) = @_;
my $alias = delete $opts{alias};
my $op = blessed $oper ? $oper : $self->operation($oper, %opts);
my $name = $alias || $op->name;
error __x"a compiled call for {name} already exists", name => $name
if $self->{XCW_ccode}{$name};
my $dopts = $self->{XCW_dcopts} || {};
my @opts = %opts;
push @opts, ref $dopts eq 'ARRAY' ? @$dopts : %$dopts;
trace "compiling call `$name'";
$self->{XCW_ccode}{$name} = $op->compileClient(@opts);
}
sub call($@)
{ my ($self, $name) = (shift, shift);
my $codes = $self->{XCW_ccode}
or error __x"you can only use call() after compileCalls()";
my $call = $codes->{$name}
or error __x"operation `{name}' is not known", name => $name;
$call->(@_);
}
#--------------------------
sub addWSDL($%)
{ my ($self, $data, %args) = @_;
defined $data or return ();
if(ref $data eq 'ARRAY')
{ $self->addWSDL($_) for @$data;
return $self;
}
my ($node, %details) = $self->dataToXML($data);
defined $node or return $self;
$node->localName eq 'definitions' && $node->namespaceURI eq WSDL11
or error __x"root element for WSDL is not 'wsdl:definitions'";
$self->importDefinitions($node, details => \%details);
$self->learnPrefixes($node);
my $spec = $self->reader('wsdl:definitions')->($node);
my $tns = $spec->{targetNamespace}
or error __x"WSDL sets no targetNamespace";
# WSDL 1.1 par 2.1.1 says: WSDL def types each in own name-space
my $index = $self->{index};
# silly WSDL structure
my $toplevels = $spec->{gr_wsdl_anyTopLevelOptionalElement} || [];
foreach my $toplevel (@$toplevels)
{ my ($which, $def) = %$toplevel; # always only one
$which =~ s/^wsdl_(service|message|binding|portType)$/$1/
or next;
$index->{$which}{pack_type $tns, $def->{name}} = $def;
if($which eq 'service')
{ foreach my $port ( @{$def->{wsdl_port} || []} )
{ my $addr_label = first { /address$/ } keys %$port
or error __x"no address in port {port}"
, port => $port->{name};
my $first_addr = $port->{$addr_label};
$first_addr = $first_addr->[0] if ref $first_addr eq 'ARRAY';
# Is XML::Compile::SOAP loaded?
ref $first_addr eq 'HASH'
or error __x"wsdl namespace {ns} not loaded"
, ns => $first_addr->namespaceURI;
$index->{port}{pack_type $tns, $port->{name}} = $port;
}
}
}
# no service block when only one port
unless($index->{service})
{ # only from this WSDL, cannot use collective $index
my @portTypes = map $_->{wsdl_portType}||(), @$toplevels;
@portTypes==1
or error __x"no service definition so needs 1 portType, found {nr}"
, nr => scalar @portTypes;
my @bindings = map $_->{wsdl_binding}||(), @$toplevels;
@bindings==1
or error __x"no service definition so needs 1 binding, found {nr}"
, nr => scalar @bindings;
my $binding = pack_type $tns, $bindings[0]->{name};
my $portname = $portTypes[0]->{name};
my $servname = $portname;
$servname =~ s/Service$|(?:Service)?Port(?:Type)?$/Service/i
or $servname .= 'Service';
my $addr
= $bindings[0]->{soap_binding} ? 'soap_address'
: $bindings[0]->{soap12_binding} ? 'soap12_address'
: error __x"unrecognized binding type for wsdl without service block";
my %port = (name => $portname, binding => $binding
, $addr => {location => 'http://localhost'} );
$index->{service}{pack_type $tns, $servname}
= { name => $servname, wsdl_port => [ \%port ] };
$index->{port}{pack_type $tns, $portname} = \%port;
}
#warn "INDEX: ",Dumper $index;
$self;
}
sub namesFor($)
{ my ($self, $class) = @_;
keys %{shift->index($class) || {}};
}
# new options, then also add them to the list in compileClient()
sub operation(@)
{ my $self = shift;
my $name = @_ % 2 ? shift : undef;
my %args = (name => $name, @_);
#
## Service structure
#
my $service = $self->findDef(service => delete $args{service});
my $port;
my @ports = @{$service->{wsdl_port} || []};
if(my $not = first {blessed $_} @ports)
{ error __x"not all name-spaces loaded, {ns} not parsed in port"
, ns => $not->namespaceURI;
}
my @portnames = map $_->{name}, @ports;
if(my $portname = delete $args{port})
{ $port = first {$_->{name} eq $portname} @ports;
error __x"cannot find port `{portname}', pick from {ports}"
, portname => $portname, ports => join("\n ", '', @portnames)
unless $port;
}
elsif(@ports==1)
{ $port = shift @ports;
}
else
{ error __x"specify port explicitly, pick from {portnames}"
, portnames => join("\n ", '', @portnames);
}
# get plugin for operation
my $address = first { /address$/ && $port->{$_}{location}} keys %$port
or error __x"no address provided in service {service} port {port}"
, service => $service->{name}, port => $port->{name};
if($address =~ m/^{/) # }
{ my ($ns) = unpack_type $address;
warning __"Since v2.00 you have to require XML::Compile::SOAP11 explicitly"
if $ns eq WSDL11SOAP;
error __x"ports of type {ns} not supported (not loaded?)", ns => $ns;
}
#use Data::Dumper;
#warn Dumper $port, $self->prefixes;
my ($prefix) = $address =~ m/(\w+)_address$/;
$prefix
or error __x"port address not prefixed; probably need to add a plugin XML::Compile::SOAP12";
my $opns = $self->findName("$prefix:");
my $protocol = XML::Compile::SOAP->plugin($opns);
unless($protocol)
{ my $pkg = $opns eq WSDL11SOAP ? 'SOAP11'
: $opns eq WSDL11SOAP12 ? 'SOAP12'
: undef;
if($pkg)
{ error __x"add 'use XML::Compile::{pkg}' to your script", pkg=>$pkg;
}
else
{ notice __x"ignoring unsupported namespace {ns}", ns => $opns;
return;
}
}
my $opclass = $protocol.'::Operation';
$opclass->can('_fromWSDL11')
or error __x"WSDL11 not supported by {class}", class => $opclass;
#
## Binding
#
my $bindtype = $port->{binding}
or error __x"no binding defined in port '{name}'"
, name => $port->{name};
my $binding = $self->findDef(binding => $bindtype);
my $type = $binding->{type} # get portTypeType
or error __x"no type defined with binding `{name}'"
, name => $bindtype;
my $portType = $self->findDef(portType => $type);
my $types = $portType->{wsdl_operation}
or error __x"no operations defined for portType `{name}'"
, name => $type;
my @port_ops = map $_->{name}, @$types;
$name ||= delete $args{operation};
my $port_op;
if(defined $name)
{ $port_op = first {$_->{name} eq $name} @$types;
error __x"no operation `{op}' for portType {pt}, pick from{ops}"
, op => $name, pt => $type, ops => join("\n ", '', @port_ops)
unless $port_op;
}
elsif(@port_ops==1)
{ $port_op = shift @$types;
$name = $port_op->{name};
}
else
{ error __x"multiple operations in portType `{pt}', pick from {ops}"
, pt => $type, ops => join("\n ", '', @port_ops)
}
my @bindops = @{$binding->{wsdl_operation} || []};
my $bind_op = first {$_->{name} eq $name} @bindops;
$bind_op
or error __x"cannot find bind operation for {name}", name => $name;
# This should be detected while parsing the WSDL because the order of
# input and output is significant (and lost), but WSDL 1.1 simplifies
# our life by saying that only 2 out-of 4 predefined types can actually
# be used at present.
my @order = map +(unpack_type $_)[1], @{$port_op->{_ELEMENT_ORDER}};
my ($first_in, $first_out);
for(my $i = 0; $i<@order; $i++)
{ $first_in = $i if !defined $first_in && $order[$i] eq 'input';
$first_out = $i if !defined $first_out && $order[$i] eq 'output';
}
my $kind
= !defined $first_in ? 'notification-operation'
: !defined $first_out ? 'one-way'
: $first_in < $first_out ? 'request-response'
: 'solicit-response';
#
### message components
#
my $operation = $opclass->_fromWSDL11
( name => $name,
, kind => $kind
, service => $service
, serv_port => $port
, binding => $binding
, bind_op => $bind_op
, portType => $portType
, port_op => $port_op
, wsdl => $self
, action => $args{action}
, server_type => $args{server_type} || $self->{XCW_server}
);
$operation;
}
sub compileClient(@)
{ my $self = shift;
unshift @_, 'operation' if @_ % 2;
my $op = $self->operation(@_) or return ();
my $dopts = $self->{XCW_dcopts} || {};
$op->compileClient(@_, (ref $dopts eq 'ARRAY' ? @$dopts : %$dopts));
}
#---------------------
sub declare($$@)
{ my ($self, $need, $names, @opts) = @_;
my $opts = @opts==1 ? shift @opts : \@opts;
$opts = [ %$opts ] if ref $opts eq 'HASH';
$need eq 'OPERATION'
or $self->SUPER::declare($need, $names, @opts);
foreach my $name (ref $names eq 'ARRAY' ? @$names : $names)
{ # checking existence of opname is expensive here
# and may be problematic with multiple bindings.
$self->{XCW_dcopts}{$name} = $opts;
}
$self;
}
#--------------------------
sub index(;$$)
{ my $index = shift->{index};
@_ or return $index;
my $class = $index->{ (shift) }
or return ();
@_ ? $class->{ (shift) } : $class;
}
sub findDef($;$)
{ my ($self, $class, $name) = @_;
my $group = $self->index($class)
or error __x"no definitions for `{class}' found", class => $class;
if(defined $name)
{ return $group->{$name} if exists $group->{$name}; # QNAME
if($name =~ m/\:/) # PREFIXED
{ my $qname = $self->findName($name);
return $group->{$qname} if exists $group->{$qname};
}
if(my $q = first { (unpack_type $_)[1] eq $name } keys %$group)
{ return $group->{$q};
}
error __x"no definition for `{name}' as {class}, pick from:{groups}"
, name => $name, class => $class
, groups => join("\n ", '', sort keys %$group);
}
return values %$group
if wantarray;
return (values %$group)[0]
if keys %$group==1;
my @alts = map $self->prefixed($_), sort keys %$group;
error __x"explicit selection required: pick one {class} from {alts}"
, class => $class, alts => join("\n ", '', @alts);
}
sub operations(@)
{ my ($self, %args) = @_;
$args{produce} and die "produce option removed in 0.81";
my @ops;
my @services = $self->findDef('service');
foreach my $service (@services)
{ my $sname = $service->{name};
next if $args{service} && $args{service} ne $sname;
my @ports = @{$service->{wsdl_port} || []};
foreach my $port (@ports)
{
next if $args{port} && $args{port} ne $port->{name};
my $bindtype = $port->{binding}
or error __x"no binding defined in port '{name}'"
, name => $port->{name};
my $binding = $self->findDef(binding => $bindtype);
next if $args{binding} && $args{binding} ne $binding->{name};
my $type = $binding->{type}
or error __x"no type defined with binding `{name}'"
, name => $bindtype;
my %all_ops;
foreach my $operation ( @{$binding->{wsdl_operation}||[]} )
{ my $opname = $operation->{name};
if(my $has = $all_ops{$opname})
{ error __x"operation {name} found again; choose service {has} or {also}"
, name => $opname, has => $has->serviceName
, also => $sname
if @services > 1 && !$args{service};
error __x"need one set of operations, pick port from {ports}"
, ports => [ map $_->{name}, @ports ], _join => ', ';
}
my $op = $all_ops{$opname} = $self->operation
( service => $sname
, port => $port->{name}
, binding => $bindtype
, operation => $opname
, portType => $type
, server_type => $args{server_type}
);
push @ops, $op;
}
}
}
@ops;
}
sub endPoint(@)
{ my ($self, %args) = @_;
my $service = $self->findDef(service => delete $args{service});
my $port;
my @ports = @{$service->{wsdl_port} || []};
my @portnames = map $_->{name}, @ports;
if(my $portname = delete $args{port})
{ $port = first {$_->{name} eq $portname} @ports;
error __x"cannot find port `{portname}', pick from {ports}"
, portname => $portname, ports => join("\n ", '', @portnames)
unless $port;
}
elsif(@ports==1)
{ $port = shift @ports;
}
else
{ error __x"specify port explicitly, pick from {portnames}"
, portnames => join("\n ", '', @portnames);
}
foreach my $k (keys %$port)
{ return $port->{$k}{location} if $k =~ m/address$/;
}
();
}
sub printIndex(@)
{ my $self = shift;
my $fh = @_ % 2 ? shift : select;
my @args = @_;
my %tree;
foreach my $op ($self->operations(@args))
{ my $port = $op->version.' port '.$op->portName;
my $bind = '(binding '.$op->bindingName.')';
$tree{'service '.$op->serviceName}{"$port $bind"}{$op->name} = $_;
}
foreach my $service (sort keys %tree)
{ $fh->print("$service\n");
foreach my $port (sort keys %{$tree{$service}})
{ $fh->print(" $port\n");
foreach my $op (sort keys %{$tree{$service}{$port}})
{ $fh->print(" $op\n");
}
}
}
}
sub explain($$$@)
{ my ($self, $opname, $format, $direction, @opts) = @_;
my $op = $self->operation($opname, @opts)
or error __x"explain operation {name} not found", name => $opname;
$op->explain($self, $format, $direction, @opts);
}
#--------------------------------
1;
XML-Compile-WSDL11-3.08/t/ 0000755 0001750 0000144 00000000000 14112100572 015355 5 ustar 00markov users 0000000 0000000 XML-Compile-WSDL11-3.08/t/50wsdl.t 0000644 0001750 0000144 00000020031 14112100555 016655 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
# Test interpretation of WSDL.
# The definitions are copied frm the the WSDL 1.1 technical report,
# available from http://www.w3.org/TR/wsdl/
# with bugfix:
# -
# +
use warnings;
use strict;
use lib 'lib','t';
use TestTools;
use Data::Dumper;
$Data::Dumper::Indent = 1;
use XML::Compile::WSDL11;
use XML::Compile::Transport::SOAPHTTP;
use XML::Compile::SOAP::Util qw/WSDL11 SOAP11HTTP/;
use XML::Compile::Tester;
use XML::Compile::SOAP11;
use Test::More tests => 41;
use Test::Deep;
use Log::Report 'try';
my $xml_xsd = <<__STOCKQUOTE_XSD;
__STOCKQUOTE_XSD
my $xml_wsdl = <<'__STOCKQUOTE_WSDL';
__STOCKQUOTE_WSDL
my $servns = 'http://example.com/stockquote/service';
my $servlocal = 'StockQuoteService';
my $servname = "{$servns}$servlocal";
my $servaddr = 'http://example.com/stockquote';
my $xml_service = <<'__STOCKQUOTESERVICE_WSDL';
My first service
__STOCKQUOTESERVICE_WSDL
###
### BEGIN OF TESTS
###
my $wsdl = XML::Compile::WSDL11->new($xml_service);
ok(defined $wsdl, "created object");
isa_ok($wsdl, 'XML::Compile::WSDL11');
is($wsdl->findName('wsdl:'), WSDL11);
my @services = $wsdl->findDef('service');
cmp_ok(scalar(@services), '==', 1, 'find service list context');
is($services[0]->{name}, $servlocal);
my $s = try { $wsdl->findDef(service => 'aap') };
my $err = $@->wasFatal->toString; $err =~ s! at t/80.*\n$!!;
ok(!defined $s, 'find non-existing service');
is($err, <<'__ERR');
error: no definition for `aap' as service, pick from:
{http://example.com/stockquote/service}StockQuoteService
__ERR
$s = try { $wsdl->findDef(service => $servname) };
$err = $@->wasFatal;
ok(defined $s, "request existing service $servlocal");
is("$@", '', 'no errors');
ok(UNIVERSAL::isa($s, 'HASH'));
my $s2 = try { $wsdl->findDef('service') };
$err = $@->wasFatal;
ok(defined $s, "request only service, not by name");
is("$@", '', 'no errors');
cmp_ok($s, '==', $s2, 'twice same definition');
#warn Dumper $s;
is($wsdl->endPoint, $servaddr);
is($wsdl->endPoint(service => $servname), $servaddr);
$wsdl->importDefinitions($xml_xsd);
$wsdl->addWSDL($xml_wsdl);
my $op = try { $wsdl->operation('noot') };
$err = $@->wasFatal->toString; $err =~ s!\sat t/80.*\n$!\n!;
ok(!defined $op, "non-existing operation");
is($err, <<'__ERR');
error: no operation `noot' for portType {http://example.com/stockquote/definitions}StockQuotePortType, pick from
GetLastTradePrice
__ERR
$op = try { $wsdl->operation('GetLastTradePrice') };
$err = $@->wasFatal || '';
ok(defined $op, 'existing operation');
is("$@", '', 'no errors');
isa_ok($op, 'XML::Compile::SOAP11::Operation');
is($op->kind, 'request-response');
#delete $op->{schemas}; # far too much to dump
#warn Dumper $op; exit 1;
#
# collect some basic facts
#
my @addrs = $op->endPoints;
cmp_ok(scalar @addrs, '==', 1, 'get endpoint address');
is($addrs[0], 'http://example.com/stockquote');
my $http1 = 'http://schemas.xmlsoap.org/soap/http';
is($op->action, 'http://example.com/GetLastTradePrice', 'action');
is($op->style, 'document');
is($op->transport, SOAP11HTTP);
#
# test $wsdl->operations
#
my @ops = $wsdl->operations; #(server_type => 'BEA');
cmp_ok(scalar @ops, '==', 1, 'one op hash listed');
$op = shift @ops;
isa_ok($op, 'XML::Compile::SOAP::Operation');
isa_ok($op, 'XML::Compile::SOAP11::Operation');
is($op->name, 'GetLastTradePrice', 'got name');
is($op->action, 'http://example.com/GetLastTradePrice', 'got action');
is($op->serviceName, 'StockQuoteService');
is($op->bindingName, 'StockQuoteSoapBinding');
is($op->portName, 'StockQuotePort');
is($op->portTypeName, 'StockQuotePortType');
#
# test $wsdl->printIndex
#
my $x = '';
open my($out), '>', \$x;
$wsdl->printIndex($out);
close $out;
is($x, <<_INDEX);
service StockQuoteService
SOAP11 port StockQuotePort (binding StockQuoteSoapBinding)
GetLastTradePrice
_INDEX
### HELPER
my ($server_expects, $server_answers);
sub fake_server($$)
{ my ($request, $trace) = @_;
my $content = $request->decoded_content;
compare_xml($content, $server_expects, 'fake server received');
HTTP::Response->new(200, 'answer manually created'
, [ 'Content-Type' => 'text/xml' ], $server_answers);
}
#
# create client
#
my $client = $op->compileClient
( transport_hook => \&fake_server
, sloppy_floats => 1
);
ok(defined $client, 'compiled client');
isa_ok($client, 'CODE');
$server_expects = <<__EXPECTED;
IBM
__EXPECTED
$server_answers = <<__ANSWER;
3.14
__ANSWER
my $answer = $client->(tickerSymbol => 'IBM');
ok(defined $answer, 'got answer');
cmp_deeply($answer, {body => {price => 3.14}}); # body is the name of the part
#
### check parsedWSDL
#
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Quotekeys = 0;
#print Dumper $op->parsedWSDL;
XML-Compile-WSDL11-3.08/t/52wsdlfault.t 0000644 0001750 0000144 00000011066 14112100555 017723 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
# Test interpretation of WSDL faults.
use warnings;
use strict;
use lib 'lib','t';
use TestTools;
use Data::Dumper;
$Data::Dumper::Indent = 1;
use XML::Compile::WSDL11;
use XML::Compile::Transport::SOAPHTTP;
use XML::Compile::Util qw/SCHEMA2001 pack_type/;
use XML::Compile::SOAP::Util qw/:wsdl11 :soap11/;
use XML::Compile::Tester;
use XML::Compile::SOAP11;
use Test::More tests => 14;
use Test::Deep;
#use Log::Report mode => 'DEBUG';
my $testNS = 'http://any-ns';
my $schema2001 = SCHEMA2001;
my $wsdl11 = WSDL11;
my $wsdl11soap = WSDL11SOAP;
my $soap11http = SOAP11HTTP;
my $xml_wsdl = <<"__WSDL";
My two-way service
__WSDL
###
### BEGIN OF TESTS
###
my $wsdl = XML::Compile::WSDL11->new($xml_wsdl);
ok(defined $wsdl, "created object");
isa_ok($wsdl, 'XML::Compile::WSDL11');
# Get operation
my $op = eval { $wsdl->operation('doSend') };
my $err = $@ || '';
ok(defined $op, 'existing operation');
is($@, '', 'no errors');
isa_ok($op, 'XML::Compile::SOAP::Operation');
isa_ok($op, 'XML::Compile::SOAP11::Operation');
is($op->kind, 'request-response');
my $server = $op->compileHandler
( callback => \&return_fault
, selector => sub {1}
);
# Test client side
my $client = $op->compileClient(transport_hook => \&fake_server);
ok(defined $client, 'compiled client');
isa_ok($client, 'CODE');
my ($answer, $trace) = $client->(body => 999);
ok(defined $answer, 'got answer');
#use Data::Dumper;
#warn Dumper $answer, $trace;
is($answer->{Fault}->{faultstring}, 'any-ns.WentWrong', 'got fault string');
is($answer->{WentWrong}{message}, 'Oh noes', 'parsed response XML');
can_ok $trace, 'responseDOM';
isa_ok $trace->responseDOM, 'XML::LibXML::Document';
# Test server side
sub return_fault(@)
{
+{ WentWrong =>
{ faultcode => pack_type(SOAP11ENV, 'Server')
, faultstring => 'any-ns.WentWrong'
, detail => { message => 'Oh noes' }
}
};
}
sub fake_server($$)
{ my ($request, $trace) = @_;
my $content = $request->decoded_content;
$content =~ m!]*>999!
or return HTTP::Response->new(202, 'accepted'
, [ 'Content-Type' => 'text/plain' ], 'there is no body');
my ($code, $msg, $xml) = $server->();
HTTP::Response->new($code, $msg
, [ 'Content-Type' => 'text/xml;charset=utf-8' ]
, $xml->toString(1)
);
=pod
, [ 'Content-Type' => 'text/xml;charset=utf-8' ], <<__RESPONSE);
env:Server
any-ns.WentWrong
Oh noes
__RESPONSE
=cut
}
XML-Compile-WSDL11-3.08/t/53wsdlrpclit.t 0000644 0001750 0000144 00000014634 14112100555 020112 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
# Test SOAP
use warnings;
use strict;
use lib 'lib','t';
use TestTools;
use Test::Deep qw/cmp_deeply/;
#use Log::Report mode => 3; # debugging
use Data::Dumper;
$Data::Dumper::Indent = 1;
use XML::Compile::WSDL11;
use XML::Compile::Tester;
use Test::More tests => 24;
use XML::LibXML;
use XML::Compile::SOAP::Util ':soap11';
use XML::Compile::SOAP11;
use XML::Compile::Transport::SOAPHTTP;
my $NS = 'urn:example:wsdl';
my $NSEXP = 'urn:sonae:elegibilidade:exp';
my $soapenv = SOAP11ENV;
my $schema = <<_SCHEMA;
_SCHEMA
### HELPER
my ($server_expects, $server_answers);
sub fake_server($$)
{ my ($request, $trace) = @_;
my $content = $request->decoded_content;
compare_xml($content, $server_expects, 'fake server received');
#warn "CONTENT=$content###";
HTTP::Response->new(200, 'answer manually created'
, [ 'Content-Type' => 'text/xml' ], $server_answers);
}
#
# Create and interpret a message
#
my $soap = XML::Compile::SOAP11::Client->new;
isa_ok($soap, 'XML::Compile::SOAP11::Client');
isa_ok($soap, 'XML::Compile::SOAP11');
my $wsdl = XML::Compile::WSDL11->new($schema);
ok(defined $wsdl, "created object");
isa_ok($wsdl, 'XML::Compile::WSDL11');
$wsdl->prefixes(sonae => $NSEXP);
#
# Element part
#
ok(1, "** using element");
my $eop = $wsdl->operation('usingElement');
isa_ok($eop, 'XML::Compile::SOAP11::Operation');
is($eop->name, 'usingElement');
is($eop->style, 'rpc');
my $er = $eop->compileClient(transport_hook => \&fake_server);
isa_ok($er, 'CODE');
$server_expects = <<_EXPECTS;
1 aap 2 noot 3 mies
_EXPECTS
$server_answers = <<_ANSWER;
3
_ANSWER
my %data = ( item =>
[ { id => 1, name => 'aap' }
, { id => 2, name => 'noot' }
, { id => 3, name => 'mies' } ] );
my $ea = $er->(\%data);
ok(defined $ea, 'got element answer');
my $u = $ea->{usingElementResponse};
isa_ok($u, 'HASH');
cmp_ok(keys %$u, '==', 1);
is($u->{result}, '3');
#
# Type part
#
ok(1, "** using type");
my $top = $wsdl->operation('usingType');
isa_ok($top, 'XML::Compile::SOAP11::Operation', 'using type');
is($top->name, 'usingType');
is($top->style, 'rpc');
my $tr = $top->compileClient(transport_hook => \&fake_server);
isa_ok($tr, 'CODE');
$server_expects = <<_REQUEST;
1 aap 2 noot 3 mies
_REQUEST
$server_answers = <<_ANSWER;
5
_ANSWER
my $ta = $tr->(%data);
ok(defined $ta, 'got type answer');
my $r = $ta->{usingTypeResponse};
isa_ok($r, 'HASH');
cmp_ok(keys %$r, '==', 1);
is($r->{result}, '5');
XML-Compile-WSDL11-3.08/t/51wsdloneway.t 0000644 0001750 0000144 00000005360 14112100555 020111 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
# Test interpretation of WSDL one-way.
use warnings;
use strict;
use lib 'lib','t';
use TestTools;
#use Data::Dumper;
#$Data::Dumper::Indent = 1;
use XML::Compile::WSDL11;
use XML::Compile::Transport::SOAPHTTP;
use XML::Compile::Util qw/SCHEMA2001/;
use XML::Compile::SOAP::Util qw/WSDL11 WSDL11SOAP SOAP11HTTP/;
use XML::Compile::Tester;
use XML::Compile::SOAP11;
use Test::More tests => 11;
use Test::Deep;
my $testNS = 'http://any-ns';
my $schema2001 = SCHEMA2001;
my $wsdl11 = WSDL11;
my $wsdl11soap = WSDL11SOAP;
my $soap11http = SOAP11HTTP;
my $xml_wsdl = <<"__WSDL";
My second service
__WSDL
###
### BEGIN OF TESTS
###
my $wsdl = XML::Compile::WSDL11->new($xml_wsdl);
ok(defined $wsdl, "created object");
isa_ok($wsdl, 'XML::Compile::WSDL11');
my $op = eval { $wsdl->operation('doSend') };
my $err = $@ || '';
ok(defined $op, 'existing operation');
is($@, '', 'no errors');
isa_ok($op, 'XML::Compile::SOAP11::Operation');
is($op->kind, 'one-way');
sub fake_server($$)
{ my ($request, $trace) = @_;
my $content = $request->decoded_content;
compare_xml($content, <<__EXPECTED, 'fake server received');
42
__EXPECTED
HTTP::Response->new(202, 'accepted'
, [ 'Content-Type' => 'text/plain' ], 'there is no body');
}
my $client = $op->compileClient(transport_hook => \&fake_server);
ok(defined $client, 'compiled client');
isa_ok($client, 'CODE');
my ($answer, $trace) = $client->(body => 42);
ok(defined $answer, 'got answer');
cmp_deeply($answer, {});
XML-Compile-WSDL11-3.08/t/54wsdlrpclit.t 0000644 0001750 0000144 00000010663 14112100555 020111 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
# Test Literal RPC
# Example contributed by Daniel Ruoso
use warnings;
use strict;
use lib 'lib','t';
use TestTools;
use Test::Deep qw/cmp_deeply/;
#use Log::Report mode => 3; # debugging
use Data::Dumper;
$Data::Dumper::Indent = 1;
use XML::Compile::WSDL11;
use XML::Compile::Tester;
use Test::More tests => 14;
use XML::LibXML;
use XML::Compile::SOAP::Util ':soap11';
use XML::Compile::SOAP11;
use XML::Compile::Transport::SOAPHTTP;
my $NS = 'http://example.com/hello';
my $soapenv = SOAP11ENV;
my $schema = <<_SCHEMA;
_SCHEMA
### HELPER
my ($server_expects, $server_answers);
sub fake_server($$)
{ my ($request, $trace) = @_;
my $content = $request->decoded_content;
compare_xml($content, $server_expects, 'fake server received');
HTTP::Response->new(200, 'answer manually created'
, [ 'Content-Type' => 'text/xml' ], $server_answers);
}
#
# Create and interpret a message
#
my $soap = XML::Compile::SOAP11::Client->new;
isa_ok($soap, 'XML::Compile::SOAP11::Client');
isa_ok($soap, 'XML::Compile::SOAP11');
my $wsdl = XML::Compile::WSDL11->new($schema);
ok(defined $wsdl, "created object");
isa_ok($wsdl, 'XML::Compile::WSDL11');
#
# Element part
#
ok(1, "** using element");
my $eop = $wsdl->operation('Greet');
isa_ok($eop, 'XML::Compile::SOAP11::Operation');
is($eop->name, 'Greet');
is($eop->style, 'rpc');
my $er = $eop->compileClient(transport_hook => \&fake_server);
isa_ok($er, 'CODE');
$server_expects = <<_EXPECTS;
World
Hello
_EXPECTS
$server_answers = <<_ANSWER;
Hello, World!
_ANSWER
my %data = ( who => 'World', greeting => 'Hello' );
my $ea = $er->(\%data);
ok(defined $ea, 'got element answer');
my $g = $ea->{GreetResponse};
isa_ok($g, 'HASH');
cmp_ok(keys %$g, '==', 1);
is($g->{greeting}, 'Hello, World!');
XML-Compile-WSDL11-3.08/t/TestTools.pm 0000644 0001750 0000144 00000004657 14112100555 017670 0 ustar 00markov users 0000000 0000000 # Copyrights 2014-2021 by [Mark Overmeer ].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
use warnings;
use strict;
package TestTools;
use vars '$VERSION';
$VERSION = '3.08';
use base 'Exporter';
use XML::LibXML;
use XML::Compile::Util ':constants';
use XML::Compile::Tester;
use Test::More;
use Test::Deep qw/cmp_deeply eq_deeply/;
use Log::Report;
use Data::Dumper qw/Dumper/;
our @EXPORT = qw/
$TestNS
$SchemaNS
$SchemaNSi
$dump_pkg
test_rw
error_r
error_w
/;
sub duplicate($);
our $TestNS = 'http://test-types';
our $SchemaNS = SCHEMA2001;
our $SchemaNSi = SCHEMA2001i;
our $dump_pkg = 't::dump';
sub test_rw($$$$;$$)
{ my ($schema, $test, $xml, $hash, $expect, $h2) = @_;
my $type = $test =~ m/\{/ ? $test : "{$TestNS}$test";
# reader
my $r = reader_create $schema, $test, $type;
defined $r or return;
my $h = $r->($xml);
#warn "READ OUTPUT: ",Dumper $h;
unless(defined $h) # avoid crash of is_deeply
{ if(defined $expect && length($expect))
{ ok(0, "failure: nothing read from XML");
}
else
{ ok(1, "empty result");
}
return;
}
#warn "COMPARE READ: ", Dumper($h, $hash);
cmp_deeply($h, $hash, "from xml");
# Writer
my $writer = writer_create $schema, $test, $type;
defined $writer or return;
my $msg = defined $h2 ? $h2 : $h;
my $dupl;
{ no strict; $dupl = eval Dumper $msg }
my $tree = writer_test $writer, $dupl;
my $untouched = eq_deeply $msg, $dupl;
ok($untouched, 'not tempered with written structure');
$untouched or warn Dumper $msg, $dupl;
compare_xml($tree, $expect || $xml);
}
# Duplicate a complex data-structure, be sure libxml object will get
# created again.
sub duplicate($)
{ my $e = shift;
!ref $e ? $e
: ref $e eq 'ARRAY' ? [ map duplicate($_), @$e ]
: ref $e eq 'HASH' ? { map +($_ => duplicate($e->{$_})), keys %$e }
: $e->isa('XML::LibXML::Node') ? $e->cloneNode(1)
: $e; # may break with some XS objects
}
sub error_r($$$)
{ my ($schema, $test, $xml) = @_;
my $type = $test =~ m/\{/ ? $test : "{$TestNS}$test";
reader_error($schema, $type, $xml);
}
sub error_w($$$)
{ my ($schema, $test, $data) = @_;
my $type = $test =~ m/\{/ ? $test : "{$TestNS}$test";
writer_error($schema, $type, $data);
}
1;
XML-Compile-WSDL11-3.08/MANIFEST 0000644 0001750 0000144 00000001022 14112100572 016236 0 ustar 00markov users 0000000 0000000 ChangeLog
MANIFEST
Makefile.PL
README
README.md
bin/wsdl-explain.pl
bin/xsd-explain.pl
lib/XML/Compile/WSDL11.pm
lib/XML/Compile/WSDL11.pod
lib/XML/Compile/WSDL11/xsd/wsdl-http.xsd
lib/XML/Compile/WSDL11/xsd/wsdl-mime.xsd
lib/XML/Compile/WSDL11/xsd/wsdl.xsd
t/50wsdl.t
t/51wsdloneway.t
t/52wsdlfault.t
t/53wsdlrpclit.t
t/54wsdlrpclit.t
t/TestTools.pm
xt/99pod.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
XML-Compile-WSDL11-3.08/bin/ 0000755 0001750 0000144 00000000000 14112100572 015662 5 ustar 00markov users 0000000 0000000 XML-Compile-WSDL11-3.08/bin/xsd-explain.pl 0000644 0001750 0000144 00000003236 14112100555 020460 0 ustar 00markov users 0000000 0000000 #!/usr/bin/perl
# This example was contribute by Wesley Schwengle, MintLab NL 2015-08-22
# It has the same license as XML::Compile::WSDL11, where it is included
# in the bin/ directory of the distribution.
use warnings;
use strict;
use XML::Compile::Schema;
use Getopt::Long;
use Pod::Usage;
my %opt = (
help => 0,
);
GetOptions(
\%opt, qw(
help
xsd=s@
element=s@
print_index
list_namespace
xml
)
) or pod2usage(1);
pod2usage(0) if ($opt{help});
unless (defined $opt{xsd}) {
warn "Missing option: xsd";
pod2usage(1);
}
my $schema = XML::Compile::Schema->new($opt{xsd});
if ($opt{element}) {
my $type = $opt{xml} ? 'XML' : 'PERL';
foreach (@{$opt{element}}) {
print "\n" . $schema->template($type, $_, skip_header => 1) . "\n";
}
}
elsif ($opt{print_index}) {
$schema->printIndex;
}
elsif ($opt{list_namespace}) {
print join("\n", $schema->namespaces()->list, '');
}
else {
print join("\n", $schema->elements(), '');
}
1;
__END__
=head1 NAME
xsd-explain.pl - Explain XSD files
=head1 SYNOPSIS
xsd-explain.pl OPTIONS
List all the elements
xsd-explain.pl \
--xsd buildservice.xsd \
--xsd dev.java.net.array.xsd
=head1 OPTIONS
=over
=item * xsd
The path to the XSD you want to check, required. Multiples are allowed.
=item * element
The element you want to know more about, optional. Multiples are allowed.
=item * xml
If you have supplied an element, you can choose a Perl or an XML data structure.
When not enabled we display a perl data structure
=item * print_index
Prints the index of the schema
=item * list_namespace
List the namespaces
=back
XML-Compile-WSDL11-3.08/bin/wsdl-explain.pl 0000644 0001750 0000144 00000005717 14112100555 020641 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
# This example was contribute by Wesley Schwengle, MintLab NL 2015-08-22
# It has the same license as XML::Compile::WSDL11, where it is included
# in the bin/ directory of the distribution.
use warnings;
use strict;
use Getopt::Long;
use Pod::Usage;
use Data::Dumper;
use XML::Compile::WSDL11;
use XML::Compile::SOAP11;
use XML::Compile::SOAP11::Encoding;
use XML::Compile::Transport::SOAPHTTP;
my %opt = (
help => 0,
recurse => 0,
output => 1,
);
GetOptions(
\%opt, qw(
help
wsdl=s@
xsd=s@
list_namespace
xml
element=s@
print_types
call=s@
recurse
compile
output!
)
) or pod2usage(1);
pod2usage(verbose => 1) if $opt{help};
unless (defined $opt{wsdl}) {
warn "Missing option: wsdl";
pod2usage(1);
}
my $wsdl = XML::Compile::WSDL11->new();
$wsdl->addWSDL($opt{wsdl});
$wsdl->importDefinitions($opt{xsd});
if ($opt{compile}) {
$wsdl->compileAll;
}
elsif ($opt{print_types}) {
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Sortkeys = 1;
foreach my $t (qw(message portType binding service)) {
print Dumper { $t => [$wsdl->findDef($t)] };
}
}
elsif ($opt{list_namespace}) {
print join("\n", $wsdl->namespaces->list, "");
}
elsif ($opt{list_elements}) {
print join("\n", $wsdl->elements, "");
}
elsif ($opt{element}) {
my $type = $opt{xml} ? 'XML' : 'PERL';
foreach (@{$opt{element}}) {
print "\n" . $wsdl->template($type, $_, skip_header => 1) . "\n";
}
}
elsif ($opt{call}) {
my @opts = (
$opt{xml} ? 'XML' : 'PERL' => $opt{output} ? 'OUTPUT' : 'INPUT',
skip_header => 1
);
foreach my $c ( @{$opt{call}} ) {
print $wsdl->explain($c, @opts);
}
}
else {
print join("\n", (map { $_->name } $wsdl->operations), '');
}
1;
__END__
=head1 NAME
wsdl-explain.pl - Explain WSDL files
=head1 SYNOPSIS
wsdl-explain.pl OPTIONS
List all the actions:
./dev-bin/wsdl-explain.pl --wsdl buildservice.wsdl
Tell me more about a build call:
./dev-bin/wsdl-explain.pl --wsdl buildservice.wsdl --call build
Only tell me something about the input:
./dev-bin/wsdl-explain.pl --wsdl buildservice.wsdl \
--call build --no-output
=head1 OPTIONS
=over 4
=item * wsdl
The path to the WSDL you want to check, required. Multiples are allowed.
=item * xsd
The path to the XSD to where the XML types are defined, optional. Multiples are allowed.
=item * compile
Try to compile the WSDL calls
=item * list_namespace
List all the namespaces
=item * element
Describe an element, consider using L
=item * call
Explain a particular WSDL call, defaults to OUTPUT.
=item * xml
Explain the call in XML. Currently not supported by L and friends.
=item * recurse
Get more information about the underlying structures of the call.
=item * no-output
Do not display the OUTPUT of the call.
=back
XML-Compile-WSDL11-3.08/xt/ 0000755 0001750 0000144 00000000000 14112100572 015545 5 ustar 00markov users 0000000 0000000 XML-Compile-WSDL11-3.08/xt/99pod.t 0000644 0001750 0000144 00000000412 14112100555 016674 0 ustar 00markov users 0000000 0000000 #!/usr/bin/perl
use warnings;
use strict;
use Test::More;
BEGIN
{ eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
plan skip_all => "devel home uses OODoc"
if $ENV{MARKOV_DEVEL};
}
all_pod_files_ok();
XML-Compile-WSDL11-3.08/README.md 0000644 0001750 0000144 00000004075 14112100555 016400 0 ustar 00markov users 0000000 0000000 # distribution XML-Compile-WSDL11
* My extended documentation:
* Download from CPAN:
The XML-Compile suite is a large set of modules for various XML related
standards. This optional component implements the 1.1 specification of
WSDL files..
## Development → Release
Important to know, is that I use an extension on POD to write the manuals.
The "raw" unprocessed version is visible on GitHub. It will run without
problems, but does not contain manual-pages.
Releases to CPAN are different: "raw" documentation gets removed from
the code and translated into real POD and clean HTML. This reformatting
is implemented with the OODoc distribution (A name I chose before OpenOffice
existed, sorry for the confusion)
Clone from github for the "raw" version. For instance, when you want
to contribute a new feature.
On github, you can find the processed version for each release. But the
better source is CPAN; to get it installed simply run:
```sh
cpan -i XML::Compile::WSDL11
```
## Contributing
When you want to contribute to this module, you do not need to provide
a perfect patch... actually: it is nearly impossible to create a patch
which I will merge without modification. Usually, I need to adapt the
style of code and documentation to my own strict rules.
When you submit an extension, please contribute a set with
1. code
2. code documentation
3. regression tests in t/
**Please note:**
When you contribute in any way, you agree to transfer the copyrights to
Mark Overmeer (you will get the honors in the code and/or ChangeLog).
You also automatically agree that your contribution is released under
the same license as this project: licensed as perl itself.
## Copyright and License
This project is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See and soap 1.2 binding [Sandro MagrÃ]
- regression tests failed due to XML::Compile::SOAP output change
[Theo van Hoesel]
version 3.04: Thu 15 Oct 09:11:04 CEST 2015
Fixes:
- better warning about missing modules, to be loaded
rt.cpan.org#105270 [Ian Mitchell]
Improvements:
- ::WSDL11::addWSDL() now accepts an array of resources
- add bin/wsdl-explain.pl and bin/xsd-explain.pl, contributed
by Wesley Schwengle of MintLab NL
version 3.03: Mon Dec 22 08:58:55 CET 2014
Fixes:
- ::WSDL11 should load ::SOAP [Michel Jansen]
Improvements:
- add compileCall() options 'alias' and 'long_names'
- enabled rpc-decoded style
version 3.02: Thu Feb 6 17:09:29 CET 2014
Improvements:
- change documentation style
version 3.01: Fri Jan 10 15:41:39 CET 2014
Fixes:
- documentation needs info from XML::Compile, ~::Cache, and ~::SOAP
Improvements:
- support for the server_type option.
- load wsdl-http and wsdl-mime schema's by default
version 3.00: Mon Jan 6 00:56:39 CET 2014
Split-off from XML::Compile:SOAP
XML-Compile-WSDL11-3.08/README 0000644 0001750 0000144 00000001504 14112100570 015770 0 ustar 00markov users 0000000 0000000 === README for XML-Compile-WSDL11 version 3.08
= Generated on Fri Aug 27 08:08:56 2021 by OODoc 2.02
There are various ways to install this module:
(1) if you have a command-line, you can do:
perl -MCPAN -e 'install '
(2) if you use Windows, have a look at http://ppm.activestate.com/
(3) if you have downloaded this module manually (as root/administrator)
gzip -d XML-Compile-WSDL11-3.08.tar.gz
tar -xf XML-Compile-WSDL11-3.08.tar
cd XML-Compile-WSDL11-3.08
perl Makefile.PL
make # optional
make test # optional
make install
For usage, see the included manual-pages or
http://search.cpan.org/dist/XML-Compile-WSDL11-3.08/
Please report problems to
http://rt.cpan.org/Dist/Display.html?Queue=XML-Compile-WSDL11
XML-Compile-WSDL11-3.08/Makefile.PL 0000644 0001750 0000144 00000002612 14112100555 017066 0 ustar 00markov users 0000000 0000000 use ExtUtils::MakeMaker;
use 5.010;
my $version = '3.08';
my $prereq =
{ XML::Compile => 1.48
, XML::Compile::SOAP11 => 3.23
, XML::Compile::Cache => 1.03
, XML::Compile::Tester => 0
, Log::Report => 1.05
, Test::More => 0.54
};
WriteMakefile
( NAME => 'XML::Compile::WSDL11'
, VERSION => $version
, PREREQ_PM => $prereq
, AUTHOR => 'Mark Overmeer '
, ABSTRACT => 'WSDL version 1.1'
, LICENSE => 'perl_5'
, META_MERGE =>
{ 'meta-spec' => { version => 2 }
, resources =>
{ repository =>
{ type => 'git'
, url => 'https://github.com/markov2/perl5-XML-Compile-WSDL11.git'
, web => 'https://github.com/markov2/perl5-XML-Compile-WSDL11'
}
, homepage => 'http://perl.overmeer.net/CPAN/'
, license => [ 'http://dev.perl.org/licenses/' ]
}
}
);
### used by oodist during production of distribution
sub MY::postamble { <<'__POSTAMBLE' }
# for DIST
EXTENDS = ../XML-Compile-Cache:../XML-Compile-SOAP:../XML-Compile-SOAP12:../XML-Compile
RAWDIR = ../public_html/xml-compile-wsdl11/raw
DISTDIR = ../public_html/xml-compile-wsdl11/source
SKIP_LINKS = XML::LibXML
# for POD
FIRST_YEAR = 2014
EMAIL = perl@overmeer.net
WEBSITE = http://perl.overmeer.net/CPAN/
__POSTAMBLE
XML-Compile-WSDL11-3.08/META.yml 0000644 0001750 0000144 00000001522 14112100572 016363 0 ustar 00markov users 0000000 0000000 ---
abstract: 'WSDL version 1.1'
author:
- 'Mark Overmeer '
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: XML-Compile-WSDL11
no_index:
directory:
- t
- inc
requires:
Log::Report: '1.05'
Test::More: '0.54'
XML::Compile: '1.48'
XML::Compile::Cache: '1.03'
XML::Compile::SOAP11: '3.23'
XML::Compile::Tester: '0'
resources:
homepage: http://perl.overmeer.net/CPAN/
license: http://dev.perl.org/licenses/
repository: https://github.com/markov2/perl5-XML-Compile-WSDL11.git
version: '3.08'
x_serialization_backend: 'CPAN::Meta::YAML version 0.011'
XML-Compile-WSDL11-3.08/META.json 0000644 0001750 0000144 00000002710 14112100572 016533 0 ustar 00markov users 0000000 0000000 {
"abstract" : "WSDL version 1.1",
"author" : [
"Mark Overmeer "
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "XML-Compile-WSDL11",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Log::Report" : "1.05",
"Test::More" : "0.54",
"XML::Compile" : "1.48",
"XML::Compile::Cache" : "1.03",
"XML::Compile::SOAP11" : "3.23",
"XML::Compile::Tester" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"homepage" : "http://perl.overmeer.net/CPAN/",
"license" : [
"http://dev.perl.org/licenses/"
],
"repository" : {
"type" : "git",
"url" : "https://github.com/markov2/perl5-XML-Compile-WSDL11.git",
"web" : "https://github.com/markov2/perl5-XML-Compile-WSDL11"
}
},
"version" : "3.08",
"x_serialization_backend" : "JSON::PP version 2.94"
}