Pod-WSDL-0.062 000755 000765 000024 0 12266317307 12053 5 ustar 00bat staff 000000 000000 README 100644 000765 000024 30761 12266317307 13043 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062 NAME
Pod::WSDL - Creates WSDL documents from (extended) pod
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
SYNOPSIS
use Pod::WSDL;
my $pod = new Pod::WSDL(source => 'My::Server',
location => 'http://localhost/My/Server',
pretty => 1,
withDocumentation => 1);
print $pod->WSDL;
DESCRIPTION - How to use Pod::WSDL
Parsing the pod
How does Pod::WSDL work? If you instantiate a Pod::WSDL object with the
name of the module (or the path of the file, or an open filehandle)
providing the web service like this
my $pwsdl = new Pod::WSDL(source => 'My::Module',
location => 'http://my.services.location/on/the/web');
Pod::WSDL will try to find "My::Module" in @INC, open the file, parse it
for WSDL directives and prepare the information for WSDL output. By
calling
$pwsdl->WSDL;
Pod::WSDL will output the WSDL document. That's it.
When using Pod::WSDL, the parser expects you to do the following:
* Put the pod directly above the subroutines which the web service's
client is going to call. There may be whitespace between the pod and
the sub declaration but nothing else.
* Use the "=begin"/"=end" respectively the "=for" directives according
to standard pod: anything between "=begin WSDL" and "=end" will be
treated as pod. Anything composing a paragraph together with "=for
WSDL" will be treated as pod.
Any subroutine not preceeded by WSDL pod will be left unmentioned. Any
standard pod will be ignored (though, for an exception to this, see the
section on own complex types below).
The individual instructions for Pod::WSDL always begin with a keyword,
like "_RETURN" or "_DOC" or "_FAULT". After this different things may
follow, according to the specific type of instruction. The instruction
may take one or more lines - everything up to the next line beginning
with a keyword or the end of the pod is belonging to the current
instruction.
Describing Methods
How do we use Pod::WSDL? In describing a web service's method we have to
say something about parameters, return values and faults. In addition
you might want to add some documentation to these items and to the
method itself.
Parameters
WSDL differentiates between in-, out- and inout-parameters, so we do
that, too. A different matter is the question, if the client can do this
too, but now we are talking about possibilities, not actualities.
The pod string describing a parameter has the structure
(_IN|_OUT|_INOUT) NAME ($|@)TYPE DESCRIPTION
like
_IN foo $string This is a foo
or
_INOUT bar @bar An array of bars
You will easily guess what "_IN", "_OUT" and "_INOUT" stand for so we
can move on. "NAME" is the name of your parameter. It does not have any
real function (the order of the parameters being the only important
thing) but it is nice to have it since in a WSDL document the parameters
need to have names. So instead of having Pod::WSDL automatically
generate cryptic names (it cannot do that right now) be nice to the
client and use some sensible name. The "TYPE" of the parameters can be
any of the xsd (schema) standard types (see [5]) or a type of your own
creation. The "$" resp. "@" symbols tell Pod::WSDL and your client if it
is a scalar or array parameter. Everything following the type up to the
next instruction is treated as the parameter's documentation. If you
call the constructor of Pod::WSDL with the argument "withDocumentation
=> 1", it will be added to the WSDL.
Return Values
Return values work like parameters but since in WSDL there is provision
for only one return value (you have (in)out parameters, or can return
arrays if that isn't enough), you do not need to give them a name.
Pod::WSDL will automatically call them 'Return' in the WSDL document.
So, the structure of "_RETURN" instructions is
_RETURN ($|@)TYPE DESCRIPTION
as in
_RETURN $string Returns a string
The pod for one method may only have one "_RETURN" instruction. If you
don't specify a "_RETURN" instruction, Pod::WSDL will assume that you
return void. Of course the perl subroutine still will return something,
but your web service won't. To make this clear Pod::WSDL generates an
empty response message for this.
If you want some method to be a one way operation (see [4], ch. 2.4.1),
say so by using the instruction "_ONEWAY" in the pod. In this case no
response message will be generated and a "_RETURN" instruction will be
ignored.
Faults
SOAP faults are usually translated into exceptions in languages like
Java. If you set up a web service using SOAP::Lite, SOAP will trap your
dying program and generate a generic fault using the message of "die".
It is also possible to access SOAP::Lite's SOAP::Fault directly if you
want more control - but this is not our issue. If you want to use
custom-made fault messages of your own, define them in "_FAULT"
instructions, which look like this:
_FAULT TYPE DESCRIPTION
An example could be the following:
_FAULT My::Fault If anything goes wrong
Since you probably won't return an array of fault objects, you do not
need to use the "($|@)" tokens. Just say that you return a fault,
declare it's type and add an optional description.
As with parameters (but in contrary to "_RETURN" instructions) you can
declare as many "_FAULT" instructions as you like, providing for
different exception types your method might throw.
Method Documentation
Method documentation is easily explained. It's structure is
_DOC Here comes my documentation ...
That's it. Use several lines of documentation if you like. If you
instantiate the Pod::WSDL object with the parameter "withDocumentation
=> 1", it will be written into the WSDL document.
Describing Modules - Using Own Complex Types
Quite often it will be the case that you have to use complex types as
parameters or return values. One example of this we saw when talking
about faults: you might want to create custom fault types (exceptions)
of your own to fullfill special needs in the communication between web
service and client. But of course you also might simply want to pass a
complex parameter like a address object containing customer data to your
application. WSDL provides the means to describe complex types borrowing
the xsd schema syntax. Pod::WSDL makes use of this by allowing you to
add WSDL pod to your own types. Assuming you have some own type like
package My::Type;
sub new {
bless {
foo => 'foo',
bar => -1
}, $_[0];
}
1;
simply describe the keys of your blessed hash like this.
=begin WSDL
_ATTR foo $string A foo
_ATTR bar $integer And a bar
=end WSDL
Put this pod anywhere within the package My::Type. Pod::WSDL will find
it (if it is in @INC), parse it and integrate it into the WSDL document.
The "_ATTR" instruction works exactly as the "_IN", "_OUT" and "_INOUT"
instructions for methods (see above).
If you initialize the Pod::WSDL object using "withDocumentation => 1",
Pod::WSDL will look for standard pod in the module, parse it using
Pod::Text and put it into the WSDL document.
METHODS
new
Instantiates a new Pod::WSDL.
Parameters
* source - Name of the source file, package of the source module or
file handle on source file for which the WSDL shall be generated.
This source must contain specialized Pod tags. So, if your source is
'/some/directory/modules/Foo/Bar.pm' with package declaration
'Foo::Bar', source may be '/some/directory/modules/Foo/Bar.pm' or
'Foo::Bar' (in which case '/some/directory/modules' has to be in
@INC) or an open file handle on the file. Right?
* location - Target namespace for the WSDL, usually the full URL of
your webservice's proxy.
* pretty - Pretty print WSDL, if true. Otherwise the WSDL will come
out in one line. The software generating the client stubs might not
mind, but a person reading the WSDL will!
* withDocumentation - If true, put available documentation in the WSDL
(see "Pod Syntax" above). For used own complex types ('modules')
this will be the output of Pod::Text on these modules. The software
generating the client stubs might give a damn, but a person reading
the WSDL won't!
WSDL
Returns WSDL as string.
Parameters
* pretty - Pretty print WSDL, if true. Otherwise the WSDL will come
out in one line. The software generating the client stubs might not
mind, but a person reading the WSDL will!
* withDocumentation - If true, put available documentation in the WSDL
(see "Pod Syntax" above). For used own complex types ('modules')
this will be the output of Pod::Text on these modules. The software
generating the client stubs might give a damn, but a person reading
the WSDL won't!
addNamespace
Adds a namespace. Will be taken up in WSDL's definitions element.
Parameters
1 URI of the namespace
2 Declarator of the namespace
EXTERNAL DEPENDENCIES
Carp
XML::Writer
IO::Scalar
Pod::Text
The test scripts use
XML::XPath
EXAMPLES
see the *.t files in the distribution
BUGS
Please send me any bug reports, I will fix them or mention the bugs here
:-)
TODO
Describe Several Signatures for one Method
Of course, one subroutine declaration might take a lot of different sets
of parameters. In Java or C++ you would have to have several methods
with different signatures. In perl you fix this within the method. So
why not put several WSDL pod blocks above the method so the web
service's client can handle that.
Implement a Better Parsing of the pod
Right know, the pod is found using some rather complex regular
expressions. This is evil and will certainly fail in some situations.
So, an issue on top of the fixme list is to switch to regular parsing.
I'm not sure if I can use Pod::Parser since I need the sub declaration
outside the pod, too.
Handle Several Package Declarations in One File
So far, Pod::WSDL assumes a one to one relation between packages and
files. If it meets several package declarations in one file, it will
fail some way or the other. For most uses, one package in one file will
presumably suffice, but it would be nice to be able to handle the other
cases, too.
Handle Array based blessed References
Array based blessed references used for complex types are something of a
problem.
Get Information on Complex Types from Somewhere Else
If you use complex types for parameters that are not your own (we
assume, that the module containing the web service always is your own),
you might not be able to put the WSDL pod into the module files. So why
not fetch it from somewhere else like a configuration file?
Integrate Pod::WSDL with SOAP::Lite
With Axis, you simply call the web service's URL with the parameter
'?wsdl' and you get the WSDL document. It would be nice to be able to do
this with SOAP::Lite, too.
Implement Non RPC Style Messages
Pod::WSDL writes WSDL documents in encoded RPC style. It should be able
to generate literal RPC and document styles, too.
REFERENCES
[1]
[2]
[3]
[4]
[5]
SEE ALSO
http://ws.apache.org/axis/
http://search.cpan.org/~kbrown/SOAP-0.28/
http://search.cpan.org/~byrne/SOAP-Lite-0.65_5/
http://www.w3.org/TR/wsdl
WSDL::Generator (a different way to do it)
SOAP::WSDL (the client side)
SOAP::Clean::WSDL (I have not tried this)
AUTHOR
Tarek Ahmed,
COPYRIGHT AND LICENSE
Copyright (C) 2010 by Tarek Ahmed
This library is alpha software and comes with no warranty whatsoever. It
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself, either Perl version 5.8.5 or, at your option,
any later version of Perl 5 you may have available.
Changes 100755 000765 000024 4271 12266317307 13436 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062 Revision history for Perl extension Pod::WSDL.
0.01 Mon May 23 20:36:37 2005
- original version; created by h2xs 1.23 with options
-A -X Pod::WSDL
0.03 Tue Jul 20 00:06:00 2005
- Packed everything in one distribution
0.04
- Fixed bug: warnings issued by XML::Writer, when using Pod for methods
without parameters
- Fixed unnecessary requirement for Perl version 5.8.5
- Fixed bug in the generated WSDL for certain cases where complex types were
used
- Fixed error in documentation
- Fixed error which led to failure if wrong parameters were being used
0.05
- AHICOX: Fixed Bug: definitions for arrays of standard types not generated
when included in complex type class as an ATTR.
- TAREKA: Changed email address
- TAREKA: Added arguments "pretty" and "withDocumentation" to method WSDL
in WSDL.pm (Fixed rt.cpan.org, bug/wish id 21137)
- TAREKA: Fixed Bug: calling method WSDL on WSDL.pm twice doubled output
- TAREKA: Fixed Bug: in schema part of wsdl must be
wrapped in (thanks to Thomas Walloschke for the hint)
- TAREKA: Fixed Bug: must have name attribute (thanks to
Thomas Walloschke for the hint)
0.051 Thu Oct 12 17:06:58 GMT 2006
- AHICOX: baseName is auto-set based on the package name of the sourced file.
NOTE: the '::' separator is removed so My::Great::Module gets the
automatic baseName of MyGreatModule.
OTHER NOTE: should the user be able to override the auto-generated
base name with a POD directive like this?
=begin WSDL
_baseName OtherNameToUse
=cut
or perhaps at instatiation with a 'baseName' option?
0.06 Fri Dec 17 12:16:00 GMT 2010
- BMAVT BUG fix: https://rt.cpan.org/Public/Bug/Display.html?id=28931
Fix anyUri to anyURI
- JCOP BUG fix: https://rt.cpan.org/Ticket/Display.html?id=51447
Spelling mistakes
- JCOP BUG fix: https://rt.cpan.org/Ticket/Display.html?id=25161
Ommit parameterOrder if method has no params as parameterOrder is optional:
http://www.w3.org/TR/wsdl#_parameter
0.061 Fri Dec 17 15:45:00 GMT 2010
- JCOP Minor cleanup of development classes
dist.ini 100644 000765 000024 1010 12266317307 13570 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062 main_module = lib/Pod/WSDL.pm
name = Pod-WSDL
author = Tarek Ahmed
license = Perl_5
copyright_holder = Tarek Ahmed
[VersionFromModule]
[GatherDir]
[MetaYAML]
[MakeMaker]
[Manifest]
[Prereqs]
Carp = 1.03
Test::More = 0.47
XML::Writer = 0.531
IO::Scalar = 2.110
XML::XPath = 1.13
Pod::Text = 2.21
Test::XML = 0
[MetaResources]
repository.web = http://github.com/tavaresb/Pod--WSDL
[TestRelease]
[ConfirmRelease]
[UploadToCPAN]
[@Git]
META.yml 100644 000765 000024 1140 12266317307 13401 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062 ---
abstract: 'Creates WSDL documents from (extended) pod'
author:
- 'Tarek Ahmed '
build_requires: {}
configure_requires:
ExtUtils::MakeMaker: 6.30
dynamic_config: 0
generated_by: 'Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Pod-WSDL
requires:
Carp: 1.03
IO::Scalar: 2.110
Pod::Text: 2.21
Test::More: 0.47
Test::XML: 0
XML::Writer: 0.531
XML::XPath: 1.13
resources:
repository: http://github.com/tavaresb/Pod--WSDL
version: 0.062
MANIFEST 100644 000765 000024 1541 12266317307 13266 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062 Changes
MANIFEST
META.yml
Makefile.PL
README
dist.ini
lib/Pod/WSDL.pm
lib/Pod/WSDL/AUTOLOAD.pm
lib/Pod/WSDL/Attr.pm
lib/Pod/WSDL/Doc.pm
lib/Pod/WSDL/Fault.pm
lib/Pod/WSDL/Method.pm
lib/Pod/WSDL/Param.pm
lib/Pod/WSDL/Return.pm
lib/Pod/WSDL/Type.pm
lib/Pod/WSDL/Utils.pm
lib/Pod/WSDL/Writer.pm
t/01AUTOLOAD01basic.t
t/01AUTOLOAD02forbiddenmethods.t
t/02Utils01basic.t
t/03Writer01basic.t
t/04Attr01basic.t
t/04Type01basic.t
t/05Doc01basic.t
t/06Fault01basic.t
t/07Return01basic.t
t/08Param01basic.t
t/09Attr01basic.t
t/10Method01basic.t
t/11WSDL01basic.t
t/11WSDL02types.t
t/11WSDL03operations.t
t/11WSDL04binding.t
t/11WSDL05service.t
t/11WSDL06parsing.t
t/My/AxisTest.pm
t/My/Bar.pm
t/My/BindingTest.pm
t/My/Foo.pm
t/My/OperationTest.pm
t/My/Server.pm
t/My/ServiceTest.pm
t/My/TypeTest.pm
t/My/WrongTypeTest.pm
t/axistest.pl
t/outputtest001.xml
t/outputtest002.xml
My 000755 000765 000024 0 12266317307 12624 5 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t Bar.pm 100644 000765 000024 371 12266317307 14007 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t/My package My::Bar;
sub barSub {}
1;
__END__
=head1 NAME
My::Bar - blah
=head1 SYNOPSIS
use My::Bar;
=head1 DESCRIPTION
blah blah
=cut
=begin WSDL
_ATTR _bar $negativeInteger _NEEDED a bar
_ATTR _boerk $boolean a nillable _boerk
=cut
Foo.pm 100644 000765 000024 352 12266317307 14025 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t/My package My::Foo;
1;
__END__
=head1 NAME
My::Foo - blah
=head1 SYNOPSIS
use My::Foo;
=head1 DESCRIPTION
blah blah
=cut
=begin WSDL
_ATTR _bar $negativeInteger _NEEDED a bar
_ATTR _boerk $boolean a nillable _boerk
=cut
Makefile.PL 100644 000765 000024 2336 12266317307 14112 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062
use strict;
use warnings;
use ExtUtils::MakeMaker 6.30;
my %WriteMakefileArgs = (
"ABSTRACT" => "Creates WSDL documents from (extended) pod",
"AUTHOR" => "Tarek Ahmed ",
"BUILD_REQUIRES" => {},
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => "6.30"
},
"DISTNAME" => "Pod-WSDL",
"EXE_FILES" => [],
"LICENSE" => "perl",
"NAME" => "Pod::WSDL",
"PREREQ_PM" => {
"Carp" => "1.03",
"IO::Scalar" => "2.110",
"Pod::Text" => "2.21",
"Test::More" => "0.47",
"Test::XML" => 0,
"XML::Writer" => "0.531",
"XML::XPath" => "1.13"
},
"TEST_REQUIRES" => {},
"VERSION" => "0.062",
"test" => {
"TESTS" => "t/*.t"
}
);
my %FallbackPrereqs = (
"Carp" => "1.03",
"IO::Scalar" => "2.110",
"Pod::Text" => "2.21",
"Test::More" => "0.47",
"Test::XML" => 0,
"XML::Writer" => "0.531",
"XML::XPath" => "1.13"
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
t 000755 000765 000024 0 12266317307 12237 5 ustar 00bat staff 000000 000000 Pod-WSDL-0.062 axistest.pl 100755 000765 000024 323 12266317307 14561 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl
use strict;
use warnings;
use Pod::WSDL;
my $p = new Pod::WSDL(source => 'My::AxisTest',
location => 'http://localhost/My/AxisTest',
pretty => 1,
withDocumentation => 1);
print $p->WSDL;
Server.pm 100644 000765 000024 112 12266317307 14542 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t/My package My::Server;
=begin WSDL
_IN bla @string
=cut
sub foo {
}
1; Pod 000755 000765 000024 0 12266317307 13264 5 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib WSDL.pm 100755 000765 000024 63051 12266317307 14563 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod package Pod::WSDL;
# TODO: make array based objects work as own complex types
# TODO: non RPC style bindings
# TODO: read type information alternatively from own file
# TODO: write soapAction attribute in operations?
use strict;
use warnings;
use Carp;
use IO::Scalar;
use Pod::Text;
use Pod::WSDL::Method;
use Pod::WSDL::Return;
use Pod::WSDL::Param;
use Pod::WSDL::Fault;
use Pod::WSDL::Doc;
use Pod::WSDL::Type;
use Pod::WSDL::Writer;
use Pod::WSDL::Utils qw(:writexml :namespaces :messages :types);
use Pod::WSDL::AUTOLOAD;
# -------------------------------------------------------------------------- #
# ------------------ > "CONSTANTS" ----------------------------------------- #
# -------------------------------------------------------------------------- #
our $VERSION = "0.062";
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
our $WSDL_METHOD_REGEXP_BEG = qr/^=(?:begin)\s+wsdl\s*\n(.*?)^=(?:cut|end\s+wsdl).*?^\s*sub\s+(\w+)/ims;
our $WSDL_METHOD_REGEXP_FOR = qr/^=(?:for)\s+wsdl\s*\n(.*?)\n\n^\s*sub\s+(\w+)/ims;
our $WSDL_TYPE_REGEXP_BEG = qr/^=(?:begin)\s+wsdl\s*\n(.*?_ATTR.*?)^=(?:cut|end\s+wsdl)/ims;
our $WSDL_TYPE_REGEXP_FOR = qr/^=(?:for)\s+wsdl\s*\n(.*?_ATTR.*?)\n\n/ims;
our $DEFAULT_BASE_NAME = 'myService';
our $PORT_TYPE_SUFFIX_NAME = 'Handler';
our $BINDING_SUFFIX_NAME = 'SoapBinding';
our $SERVICE_SUFFIX_NAME = 'Service';
# Pod::WSDL::AUTOLOAD uses this
our %FORBIDDEN_METHODS = (
source => {get => 0, set => 0},
source => {get => 0, set => 0},
baseName => {get => 0, set => 0},
methods => {get => 0, set => 0},
location => {get => 1, set => 1},
namespaces => {get => 0, set => 0},
generateNS => {get => 0, set => 0},
types => {get => 0, set => 0},
writer => {get => 0, set => 0},
standardTypeArrays => {get => 0, set => 0},
emptymessagewritten => {get => 0, set => 0},
targetNS => {get => 1, set => 1},
);
# -------------------------------------------------------------------------- #
# --------------- > PUBLIC METHODS ---------------------------------------- #
# -------------------------------------------------------------------------- #
sub new {
my ($pkg, %data) = @_;
my $nsnum = 0;
croak "I need a location, died" unless defined $data{location};
croak "I need a file or module name or a filehandle, died" unless defined $data{source};
$data{use} = $LITERAL_USE if $data{style} and $data{style} eq $DOCUMENT_STYLE and !defined $data{use};
$data{use} = $LITERAL_USE and $data{style} = $DOCUMENT_STYLE if $data{wrapped} and !defined $data{use} and !defined $data{style};
my $me = bless {
_source => $data{source},
_baseName => undef,
_methods => [],
_location => $data{location},
_namespaces => {},
_targetNS => undef,
_generateNS => sub {return $DEFAULT_NS_DECL . $nsnum++},
_types => {},
_writer => new Pod::WSDL::Writer(withDocumentation => $data{withDocumentation}, pretty => $data{pretty}),
_standardTypeArrays => {},
_emptymessagewritten => 0,
_use => $data{use} || $ENCODED_USE,
_style => $data{style} || $RPC_STYLE,
_wrapped => $data{wrapped} || 0,
}, $pkg;
croak "'use' argument may only be one of $ENCODED_USE or $LITERAL_USE, died" if $me->use ne $ENCODED_USE and $me->use ne $LITERAL_USE;
croak "'style' argument may only be one of $RPC_STYLE or $DOCUMENT_STYLE, died" if $me->style ne $RPC_STYLE and $me->style ne $DOCUMENT_STYLE;
croak "The combination of use=$ENCODED_USE and style=$DOCUMENT_STYLE is not valid, died" if ($me->style eq $DOCUMENT_STYLE and $me->use eq $ENCODED_USE);
## AHICOX 10/12/2006
## this is a quick and dirty hack to set the baseName
## the baseName should probably be set from the POD
## source (which is why it's set in _getModuleCode)
## this quick hack takes the 'name' parameter when
## we create the object, and
$me->_initSource($data{'source'});
$me->_initNS;
$me->_initTypes;
return $me;
}
sub WSDL {
my $me = shift;
my %args = @_;
my $wr = $me->writer;
$wr->prepare;
if (%args) {
$wr->pretty($args{pretty}) if defined $args{pretty};
$wr->withDocumentation($args{withDocumentation}) if defined $args{withDocumentation};
}
$me->writer->comment("WSDL for " . $me->{_location} . " created by " . ref ($me) . " version: $VERSION on " . scalar localtime);
$me->writer->startTag('wsdl:definitions', targetNamespace => $me->targetNS, %{$me->{_namespaces}});
$me->writer->wrNewLine(2);
$me->_writeTypes;
$_->writeMessages($me->types, $me->style, $me->wrapped) for @{$me->methods};
$me->_writePortType;
$me->_writeBinding;
$me->_writeService;
$me->writer->endTag('wsdl:definitions');
$me->writer->end;
return $me->writer->output;
}
sub addNamespace {
my $me = shift;
my $uri = shift;
my $decl = shift;
croak "I need a namespace, died" unless defined $uri;
defined $decl or $decl = $me->{_generateNS};
$decl = 'xmlns:' . $decl unless $decl =~ /xmlns:/;
$me->{_namespaces}->{$decl} = $uri;
}
# -------------------------------------------------------------------------- #
# ---------------- > INIT METHODS < ---------------------------------------- #
# -------------------------------------------------------------------------- #
sub _initNS {
my $me = shift;
my $namespaces = shift;
$namespaces ||= {};
$me->addNamespace($namespaces->{$_}, $_) for keys %$namespaces;
$me->addNamespace($BASIC_NAMESPACES{$_}, $_) for keys %BASIC_NAMESPACES;
$me->addNamespace($me->targetNS, $IMPL_NS_DECL);
$me->addNamespace($me->targetNS, $TARGET_NS_DECL);
}
sub _initSource {
my $me = shift;
my $src = shift;
my ($baseName, $contents) = $me->_getModuleCode($src, 1);
#set the baseName in the object
$me->baseName($baseName);
# find =begin wsdl ... =end
while ($contents =~ /$WSDL_METHOD_REGEXP_BEG/g) {
$me->_parseMethodPod($2, $1);
}
# find =for wsdl
while ($contents =~ /$WSDL_METHOD_REGEXP_FOR/g) {
$me->_parseMethodPod($2, $1);
}
}
sub _initTypes {
my $me = shift;
for my $method (@{$me->{_methods}}) {
for my $param (@{$method->params},$method->return) {
next unless $param;
unless (exists $XSD_STANDARD_TYPE_MAP{$param->type}) {
$me->_addType($param->type, $param->array);
} elsif ($param->array) {
#AHICOX: 10/10/2006
#changed to _standardTypeArrays (was singular)
$me->{_standardTypeArrays}->{$param->type} = 1;
}
}
for my $fault (@{$method->faults}) {
unless (exists $XSD_STANDARD_TYPE_MAP{$fault->type}) {
$me->_addType($fault->type, 0);
}
}
}
}
sub _addType {
my $me = shift;
my $name = shift;
my $array = shift;
if (exists $me->types->{$name}) {
$me->types->{$name}->array($array) if $array;
return;
}
my $code = $me->_getModuleCode($name);
my $pod = '';
my $in = $code;
my $out = '';
# collect =begin wsdl ... =end
while ($code =~ /$WSDL_TYPE_REGEXP_BEG/g) {
$pod .= "$1\n";
}
# collect =for wsdl
while ($code =~ /$WSDL_TYPE_REGEXP_FOR/g) {
$pod .= "$1\n";
}
warn "No pod wsdl found for type '$name'.\n" unless $pod;
my $IN = new IO::Scalar \$in;
my $OUT = new IO::Scalar \$out;
new Pod::Text()->parse_from_filehandle($IN, $OUT);
$me->types->{$name} = new Pod::WSDL::Type(name => $name, array => $array, pod => $pod, descr => $out, writer => $me->writer);
for my $attr (@{$me->types->{$name}->attrs}) {
unless (exists $XSD_STANDARD_TYPE_MAP{$attr->type}) {
$me->_addType($attr->type, $attr->array);
} elsif ($attr->array) {
#AHICOX: 10/10/2006
#changed to _standardTypeArrays (was singular)
$me->{_standardTypeArrays}->{$attr->type} = 1;
}
}
}
sub _parseMethodPod {
my $me = shift;
my $methodName = shift;
my $podData = shift;
my $method = new Pod::WSDL::Method(name => $methodName, writer => $me->writer);
my @data = split "\n", $podData;
# Preprocess wsdl pod: trim all lines and concatenate lines not
# beginning with wsdl type tokens to previous line.
# Ignore first element, if it does not begin with wsdl type token.
for (my $i = $#data; $i >= 0; $i--) {
if ($data[$i] !~ /^\s*(_INOUT|_IN|_OUT|_RETURN|_DOC|_FAULT|_ONEWAY)/i) {
if ($i > 0) {
$data[$i - 1] .= " $data[$i]";
$data[$i] = '';
}
}
}
for (@data) {
s/\s+/ /g;
s/^ //;
s/ $//;
if (/^_(INOUT|IN|OUT)\s+/i) {
my $param = new Pod::WSDL::Param($_);
$method->addParam($param);
$me->standardTypeArrays->{$param->type} = 1 if $param->array and $XSD_STANDARD_TYPE_MAP{$param->type};
} elsif (/^_RETURN\s+/i) {
my $return = new Pod::WSDL::Return($_);
$method->return($return);
$me->standardTypeArrays->{$return->type} = 1 if $return->array and $XSD_STANDARD_TYPE_MAP{$return->type};
} elsif (/^_DOC\s+/i) {
$method->doc(new Pod::WSDL::Doc($_));
} elsif (/^_FAULT\s+/i) {
$method->addFault(new Pod::WSDL::Fault($_));
} elsif (/^_ONEWAY\s*$/i) {
$method->oneway(1);
}
}
push @{$me->{_methods}}, $method;
}
sub _getModuleCode {
my $me = shift;
my $src = shift;
my $findNS = shift;
if (ref $src and ($src->isa('IO::Handle') or $src->isa('GLOB'))) {
local $/ = undef;
my $contents = <$src>;
$me->_setTargetNS($contents) if $findNS;
##AHICOX: 10/12/2006
##attempt to construct a base name based on the package
my $baseName = $DEFAULT_BASE_NAME;
$src =~ /package\s+(.*?)\s*;/s;
if ($1){
$baseName = $1;
$baseName =~ s/::(.)/uc $1/eg;
}
return ($baseName, $contents);
} else {
my $moduleFile;
if (-e $src) {
$moduleFile = $src;
} else {
my $subDir = $src;
$subDir =~ s!::!/!g;
my @files = map {"$_/$subDir.pm"} @INC;
my $foundPkg = 0;
for my $file (@files) {
if (-e $file) {
$moduleFile = $file;
last;
}
}
}
if ($moduleFile) {
open IN, $moduleFile or die "Could not open $moduleFile, died";
local $/ = undef;
my $contents = ;
close IN;
$me->_setTargetNS($contents) if $findNS;
##AHICOX: 10/12/2006
##attempt to construct a base name based on the package
my $baseName = $DEFAULT_BASE_NAME;
$contents =~ /package\s+(.*?)\s*;/s;
if ($1){
$baseName = $1;
$baseName =~ s/::(.)/uc $1/eg;
}
return ($baseName, $contents);
} else {
die "Can't find any file '$src' and can't locate it as a module in \@INC either (\@INC contains " . join (" ", @INC) . "), died";
}
}
}
sub _setTargetNS {
my $me = shift;
my $contents = shift;
$contents =~ /package\s+(.*?)\s*;/s;
if ($1) {
my $tmp = $1;
$tmp =~ s!::!/!g;
my $serverURL = $me->location;
$serverURL =~ s!(http(s)??://[^/]*).*!$1!;
$me->targetNS("$serverURL/$tmp");
} else {
$me->targetNS($me->location);
}
}
# -------------------------------------------------------------------------- #
# -------------- > OUTPUT UTILITIES < -------------------------------------- #
# -------------------------------------------------------------------------- #
sub _writeTypes {
my $me = shift;
return if keys %{$me->standardTypeArrays} == 0 and keys %{$me->types} == 0;
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:types');
$me->writer->wrElem($START_PREFIX_NAME, 'schema', targetNamespace => $me->namespaces->{'xmlns:' . $TARGET_NS_DECL}, xmlns => "http://www.w3.org/2001/XMLSchema");
$me->writer->wrElem($EMPTY_PREFIX_NAME, "import", namespace => "http://schemas.xmlsoap.org/soap/encoding/");
for my $type (sort keys %{$me->standardTypeArrays}) {
$me->writer->wrElem($START_PREFIX_NAME, "complexType", name => $ARRAY_PREFIX_NAME . ucfirst $type);
$me->writer->wrElem($START_PREFIX_NAME, "complexContent");
$me->writer->wrElem($START_PREFIX_NAME, "restriction", base => "soapenc:Array");
$me->writer->wrElem($EMPTY_PREFIX_NAME, "attribute", ref => "soapenc:arrayType", "wsdl:arrayType" => 'soapenc:' . $type . '[]');
$me->writer->wrElem($END_PREFIX_NAME, "restriction");
$me->writer->wrElem($END_PREFIX_NAME, "complexContent");
$me->writer->wrElem($END_PREFIX_NAME, "complexType");
}
for my $type (values %{$me->types}) {
$type->writeComplexType($me->types);
}
if ($me->style eq $DOCUMENT_STYLE) {
for my $method (@{$me->methods}) {
$method->writeDocumentStyleSchemaElements($me->types);
}
}
$me->writer->wrElem($END_PREFIX_NAME, 'schema');
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:types');
$me->writer->wrNewLine;
}
sub _writePortType {
my $me = shift;
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:portType', name => $me->baseName . $PORT_TYPE_SUFFIX_NAME);
for my $method (@{$me->{_methods}}) {
$method->writePortTypeOperation;
$me->writer->wrNewLine;
}
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:portType');
$me->writer->wrNewLine(1);
}
sub _writeBinding {
my $me = shift;
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:binding', name => $me->baseName . $BINDING_SUFFIX_NAME, type => $IMPL_NS_DECL . ':' . $me->baseName . $PORT_TYPE_SUFFIX_NAME);
$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:binding", style => $me->style, transport => "http://schemas.xmlsoap.org/soap/http");
$me->writer->wrNewLine;
for my $method (@{$me->methods}) {
$method->writeBindingOperation($me->targetNS, $me->use);
$me->writer->wrNewLine;
}
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:binding');
$me->writer->wrNewLine;
}
sub _writeService {
my $me = shift;
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:service', name => $me->baseName . $PORT_TYPE_SUFFIX_NAME . $SERVICE_SUFFIX_NAME);
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:port', binding => $IMPL_NS_DECL . ':' . $me->baseName . $BINDING_SUFFIX_NAME, name => $me->baseName);
$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:address", location => $me->location);
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:port');
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:service');
$me->writer->wrNewLine;
}
1;
__END__
=head1 NAME
Pod::WSDL - Creates WSDL documents from (extended) pod
=head1 SYNOPSIS
use Pod::WSDL;
my $pod = new Pod::WSDL(source => 'My::Server',
location => 'http://localhost/My/Server',
pretty => 1,
withDocumentation => 1);
print $pod->WSDL;
=head1 DESCRIPTION - How to use Pod::WSDL
=head2 Parsing the pod
How does Pod::WSDL work? If you instantiate a Pod::WSDL object with the name of the module (or the path of the file, or an open filehandle) providing the web service like this
my $pwsdl = new Pod::WSDL(source => 'My::Module',
location => 'http://my.services.location/on/the/web');
Pod::WSDL will try to find C in C<@INC>, open the file, parse it for WSDL directives and prepare the information for WSDL output. By calling
$pwsdl->WSDL;
Pod::WSDL will output the WSDL document. That's it.
When using Pod::WSDL, the parser expects you to do the following:
=over 2
=item *
Put the pod directly above the subroutines which the web service's client is going to call. There may be whitespace between the pod and the sub declaration but nothing else.
=item *
Use the C<=begin>/C<=end> respectively the C<=for> directives according to standard pod: anything between C<=begin WSDL> and C<=end> will be treated as pod. Anything composing a paragraph together with C<=for WSDL> will be treated as pod.
=back
Any subroutine not preceded by WSDL pod will be left unmentioned. Any standard pod will be ignored (though, for an exception to this, see the section on own complex types below).
The individual instructions for Pod::WSDL always begin with a keyword, like C<_RETURN> or C<_DOC> or C<_FAULT>. After this different things may follow, according to the specific type of instruction. The instruction may take one or more lines - everything up to the next line beginning with a keyword or the end of the pod is belonging to the current instruction.
=head2 Describing Methods
How do we use Pod::WSDL? In describing a web service's method we have to say something about parameters, return values and faults. In addition you might want to add some documentation to these items and to the method itself.
=head3 Parameters
WSDL differentiates between in-, out- and inout-parameters, so we do that, too. A different matter is the question, if the client can do this too, but now we are talking about possibilities, not actualities.
The pod string describing a parameter has the structure
(_IN|_OUT|_INOUT) NAME ($|@)TYPE DESCRIPTION
like
_IN foo $string This is a foo
or
_INOUT bar @bar An array of bars
You will easily guess what C<_IN>, C<_OUT> and C<_INOUT> stand for so we can move on. C is the name of your parameter. It does not have any real function (the order of the parameters being the only important thing) but it is nice to have it since in a WSDL document the parameters need to have names. So instead of having Pod::WSDL automatically generate cryptic names (it cannot do that right now) be nice to the client and use some sensible name. The C of the parameters can be any of the xsd (schema) standard types (see [5]) or a type of your own creation. The C<$> resp. C<@> symbols tell Pod::WSDL and your client if it is a scalar or array parameter. Everything following the type up to the next instruction is treated as the parameter's documentation. If you call the constructor of Pod::WSDL with the argument C 1>, it will be added to the WSDL.
=head3 Return Values
Return values work like parameters but since in WSDL there is provision for only one return value (you have (in)out parameters, or can return arrays if that isn't enough), you do not need to give them a name. Pod::WSDL will automatically call them 'Return' in the WSDL document. So, the structure of C<_RETURN> instructions is
_RETURN ($|@)TYPE DESCRIPTION
as in
_RETURN $string Returns a string
The pod for one method may only have one C<_RETURN> instruction. If you don't specify a C<_RETURN> instruction, Pod::WSDL will assume that you return void. Of course the perl subroutine still will return something, but your web service won't. To make this clear Pod::WSDL generates an empty response message for this.
If you want some method to be a one way operation (see [4], ch. 2.4.1), say so by using the instruction C<_ONEWAY> in the pod. In this case no response message will be generated and a C<_RETURN> instruction will be ignored.
=head3 Faults
SOAP faults are usually translated into exceptions in languages like Java. If you set up a web service using SOAP::Lite, SOAP will trap your dying program and generate a generic fault using the message of C. It is also possible to access SOAP::Lite's SOAP::Fault directly if you want more control - but this is not our issue. If you want to use custom-made fault messages of your own, define them in C<_FAULT> instructions, which look like this:
_FAULT TYPE DESCRIPTION
An example could be the following:
_FAULT My::Fault If anything goes wrong
Since you probably won't return an array of fault objects, you do not need to use the C<($|@)> tokens. Just say that you return a fault, declare its type and add an optional description.
As with parameters (but in contrary to C<_RETURN> instructions) you can declare as many C<_FAULT> instructions as you like, providing for different exception types your method might throw.
=head3 Method Documentation
Method documentation is easily explained. Its structure is
_DOC Here comes my documentation ...
That's it. Use several lines of documentation if you like. If you instantiate the Pod::WSDL object with the parameter C 1>, it will be written into the WSDL document.
=head2 Describing Modules - Using Own Complex Types
Quite often it will be the case that you have to use complex types as parameters or return values. One example of this we saw when talking about faults: you might want to create custom fault types (exceptions) of your own to fullfill special needs in the communication between web service and client. But of course you also might simply want to pass a complex parameter like a address object containing customer data to your application. WSDL provides the means to describe complex types borrowing the xsd schema syntax. Pod::WSDL makes use of this by allowing you to add WSDL pod to your own types. Assuming you have some own type like
package My::Type;
sub new {
bless {
foo => 'foo',
bar => -1
}, $_[0];
}
1;
simply describe the keys of your blessed hash like this.
=begin WSDL
_ATTR foo $string A foo
_ATTR bar $integer And a bar
=end WSDL
Put this pod anywhere within the package My::Type. Pod::WSDL will find it (if it is in @INC), parse it and integrate it into the WSDL document. The C<_ATTR> instruction works exactly as the C<_IN>, C<_OUT> and C<_INOUT> instructions for methods (see above).
If you initialize the Pod::WSDL object using C 1>, Pod::WSDL will look for standard pod in the module, parse it using Pod::Text and put it into the WSDL document.
=head1 METHODS
=head2 new
Instantiates a new Pod::WSDL.
=head3 Parameters
=over 4
=item
source - Name of the source file, package of the source module or file handle on source file for which the WSDL shall be generated. This source must contain specialized Pod tags. So, if your source is '/some/directory/modules/Foo/Bar.pm' with package declaration 'Foo::Bar', source may be '/some/directory/modules/Foo/Bar.pm' or 'Foo::Bar' (in which case '/some/directory/modules' has to be in @INC) or an open file handle on the file. Right?
=item
location - Target namespace for the WSDL, usually the full URL of your webservice's proxy.
=item
pretty - Pretty print WSDL, if true. Otherwise the WSDL will come out in one line. The software generating the client stubs might not mind, but a person reading the WSDL will!
=item
withDocumentation - If true, put available documentation in the WSDL (see "Pod Syntax" above). For used own complex types ('modules') this will be the output of Pod::Text on these modules. The software generating the client stubs might give a damn, but a person reading the WSDL won't!
=back
=head2 WSDL
Returns WSDL as string.
=head3 Parameters
=over 4
=item
pretty - Pretty print WSDL, if true. Otherwise the WSDL will come out in one line. The software generating the client stubs might not mind, but a person reading the WSDL will!
=item
withDocumentation - If true, put available documentation in the WSDL (see "Pod Syntax" above). For used own complex types ('modules') this will be the output of Pod::Text on these modules. The software generating the client stubs might give a damn, but a person reading the WSDL won't!
=back
=head2 addNamespace
Adds a namespace. Will be taken up in WSDL's definitions element.
=head3 Parameters
=over 4
=item 1
URI of the namespace
=item 2
Declarator of the namespace
=back
=head1 EXTERNAL DEPENDENCIES
Carp
XML::Writer
IO::Scalar
Pod::Text
The test scripts use
XML::XPath
=head1 EXAMPLES
see the *.t files in the distribution
=head1 BUGS
Please send me any bug reports, I will fix them or mention the bugs here :-)
=head1 TODO
=head2 Describe Several Signatures for one Method
Of course, one subroutine declaration might take a lot of different sets of parameters. In Java or C++ you would have to have several methods with different signatures. In perl you fix this within the method. So why not put several WSDL pod blocks above the method so the web service's client can handle that.
=head2 Implement a Better Parsing of the pod
Right know, the pod is found using some rather complex regular expressions. This is evil and will certainly fail in some situations. So, an issue on top of the fixme list is to switch to regular parsing. I'm not sure if I can use Pod::Parser since I need the sub declaration outside the pod, too.
=head2 Handle Several Package Declarations in One File
So far, Pod::WSDL assumes a one to one relation between packages and files. If it meets several package declarations in one file, it will fail some way or the other. For most uses, one package in one file will presumably suffice, but it would be nice to be able to handle the other cases, too.
=head2 Handle Array based blessed References
Array based blessed references used for complex types are something of a problem.
=head2 Get Information on Complex Types from Somewhere Else
If you use complex types for parameters that are not your own (we assume, that the module containing the web service always is your own), you might not be able to put the WSDL pod into the module files. So why not fetch it from somewhere else like a configuration file?
=head2 Integrate Pod::WSDL with SOAP::Lite
With Axis, you simply call the web service's URL with the parameter '?wsdl' and you get the WSDL document. It would be nice to be able to do this with SOAP::Lite, too.
=head2 Implement Non RPC Style Messages
Pod::WSDL writes WSDL documents in encoded RPC style. It should be able to generate literal RPC and document styles, too.
=head1 REFERENCES
[1] L
[2] L
[3] L
[4] L
[5] L
=head1 SEE ALSO
http://ws.apache.org/axis/
http://search.cpan.org/~kbrown/SOAP-0.28/
http://search.cpan.org/~byrne/SOAP-Lite-0.65_5/
http://www.w3.org/TR/wsdl
WSDL::Generator (a different way to do it)
SOAP::WSDL (the client side)
SOAP::Clean::WSDL (I have not tried this)
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is alpha software and comes with no warranty whatsoever.
It is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
05Doc01basic.t 100644 000765 000024 1413 12266317307 14600 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
use Test::More tests => 7;
BEGIN {use_ok('Pod::WSDL::Doc')}
use strict;
use warnings;
eval {
my $a1 = new Pod::WSDL::Doc();
};
ok(defined $@, 'new dies, if it does not get a string');
eval {
my $a1 = new Pod::WSDL::Doc('blah blah ...');
};
ok(defined $@, 'new dies, if it does not get a string beginning with _DOC');
my $a1 = new Pod::WSDL::Doc('_DOC blah blah ...');
ok($a1->descr eq 'blah blah ...', 'Read descr correctly from input');
$a1 = new Pod::WSDL::Doc(' _DOC blah blah ...');
ok($a1->descr eq 'blah blah ...', 'Handles whitespace before _DOC correctly.');
$a1 = new Pod::WSDL::Doc('_DOC');
ok($a1->descr eq '', 'No description is handled correctly');
$a1->descr('more blah');
ok($a1->descr eq 'more blah', 'Setting description works');
AxisTest.pm 100644 000765 000024 334 12266317307 15046 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t/My package My::AxisTest;
=begin WSDL
_IN in $string
_IN bla $My::Bar
_FAULT My::Foo
_RETURN $string
_DOC bla bla
=cut
sub test {}
=begin WSDL
_IN in @string
_ONEWAY
=cut
sub testOneway {}
sub testWithoutPod {}
1;
TypeTest.pm 100644 000765 000024 6562 12266317307 15114 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t/My package My::TypeTest;
=begin WSDL
_IN blaanyType $anyType is a anyType
_IN blaanySimpleType $anySimpleType is a anySimpleType
_IN blastring $string is a string
_IN blanormalizedString $normalizedString is a normalizedString
_IN blatoken $token is a token
_IN blaanyURI $anyURI is a anyURI
_IN blalanguage $language is a language
_IN blaName $Name is a Name
_IN blaQName $QName is a QName
_IN blaNCName $NCName is a NCName
_IN blaboolean $boolean is a boolean
_IN blafloat $float is a float
_IN bladouble $double is a double
_IN bladecimal $decimal is a decimal
_IN blaint $int is a int
_IN blapositiveInteger $positiveInteger is a positiveInteger
_IN blanonPositiveInteger $nonPositiveInteger is a nonPositiveInteger
_IN blanegativeInteger $negativeInteger is a negativeInteger
_IN blanonNegativeInteger $nonNegativeInteger is a nonNegativeInteger
_IN blalong $long is a long
_IN blashort $short is a short
_IN blabyte $byte is a byte
_IN blaunsignedInt $unsignedInt is a unsignedInt
_IN blaunsignedLong $unsignedLong is a unsignedLong
_IN blaunsignedShort $unsignedShort is a unsignedShort
_IN blaunsignedByte $unsignedByte is a unsignedByte
_IN bladuration $duration is a duration
_IN bladateTime $dateTime is a dateTime
_IN blatime $time is a time
_IN bladate $date is a date
_IN blagYearMonth $gYearMonth is a gYearMonth
_IN blagYear $gYear is a gYear
_IN blagMonthDay $gMonthDay is a gMonthDay
_IN blagDay $gDay is a gDay
_IN blagMonth $gMonth is a gMonth
_IN blahexBinary $hexBinary is a hexBinary
_IN blabase64Binary $base64Binary is a base64Binary
=cut
sub testXSDTypes {}
=begin WSDL
_IN foo $My::Foo is my Foo
=cut
sub testComplexTypes {}
=begin WSDL
_IN foo @My::Foo is my Foo
_IN bar @string is a bar
=cut
sub testArrayTypes {}
1;
04Attr01basic.t 100644 000765 000024 3147 12266317307 15012 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
use Test::More tests => 14;
BEGIN {use_ok('Pod::WSDL::Attr')}
use strict;
use warnings;
eval {
my $a1 = new Pod::WSDL::Attr();
};
ok(defined $@, 'new dies, if it does not get a string');
eval {
my $a1 = new Pod::WSDL::Attr('myAttr $string _NEEDED blah blah ...');
};
ok(defined $@, 'new dies, if it does not get a string beginning with _ATTR');
eval {
my $a1 = new Pod::WSDL::Attr('_ATTR myAttr string _NEEDED blah blah ...');
};
ok(defined $@, 'new dies, if array/scalar type is not specified');
my $a1 = new Pod::WSDL::Attr('_ATTR myAttr $string _NEEDED blah blah ...');
ok($a1->name eq 'myAttr', 'Read name correctly from input');
ok($a1->type eq 'string', 'Read type correctly from input');
ok($a1->array == 0, 'Read scalar type correctly from input');
ok($a1->descr eq 'blah blah ...', 'Read descr correctly from input');
no warnings;
ok($a1->nillable == undef, 'Read _NEEDED correctly from input');
use warnings;
$a1 = new Pod::WSDL::Attr(' _ATTR myAttr $string _NEEDED blah blah ...');
ok($a1->name eq 'myAttr', 'Handles whitespace before _ATTR correctly.');
$a1 = new Pod::WSDL::Attr('_ATTR myAttr @string _NEEDED blah blah ...');
ok($a1->array == 1, 'Read array type correctly from input');
$a1 = new Pod::WSDL::Attr('_ATTR myAttr @string blah blah etc ...');
ok($a1->nillable eq 'true' && $a1->descr eq 'blah blah etc ...', 'Read descr correctly from input without needed');
$a1 = new Pod::WSDL::Attr('_ATTR myAttr @string _NEEDED');
ok($a1->descr eq '', 'No description is handled correctly');
eval {
$a1->name('foo');
};
{
no warnings;
ok($@ == undef, 'Renaming attr is forbidden.');
}
04Type01basic.t 100644 000765 000024 2346 12266317307 15021 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Pod::WSDL::Type;
use Test::More tests => 11;
BEGIN {use_ok('Pod::WSDL::Type')}
use Pod::WSDL::Writer;
use strict;
use warnings;
eval {
my $a1 = new Pod::WSDL::Type();
};
ok(defined $@, 'new Type dies, if it does not get a name');
my $t1 = new Pod::WSDL::Type(name => 'foo',
array => 1,
descr => 'a description',
writer => new Pod::WSDL::Writer);
ok($t1->name eq 'foo', 'Read name argument correctly from input');
ok($t1->array == 1, 'Read array argument correctly from input');
ok($t1->descr eq 'a description', 'Read descr argument correctly from input');
ok((ref $t1->writer eq 'Pod::WSDL::Writer'), 'Read writer argument correctly from input');
$t1->array(0);
ok($t1->array == 0, 'Setting array member works');
package Main;
use Test::More;
my $t2 = new Pod::WSDL::Type(name => 'foo',
array => 1,
descr => 'a description',
writer => new Pod::WSDL::Writer);
eval {$t2->writer;};
ok(defined $@, 'Type does not allow getting of writer');
eval {$t2->name('bar');};
ok(defined $@, 'Type does not allow setting of name');
eval {$t2->descr('blah');};
ok(defined $@, 'Type does not allow setting of descr');
eval {$t2->writer(new Pod::WSDL::Writer);};
ok(defined $@, 'Type does not allow setting of writer');
09Attr01basic.t 100644 000765 000024 2713 12266317307 15015 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
use Test::More tests => 13;
BEGIN {use_ok('Pod::WSDL::Type')}
use strict;
use warnings;
my $attrData;
{
local $/ = undef;
$attrData = ;
}
eval {
my $a1 = new Pod::WSDL::Type();
};
ok(defined $@, 'new dies, if it does not get a name parameter');
my $a1 = new Pod::WSDL::Type(name => 'my::foo', array => 1, descr => 'blah ...', pod => 'blah blah ...', pod => $attrData);
ok ($a1->name eq 'my::foo', 'Red name argument correctly');
ok ($a1->wsdlName eq 'MyFoo', 'Made wsdl name correctly');
ok ($a1->array == 1, 'Red array argument correctly');
ok ($a1->descr eq 'blah ...', 'Red descr argument correctly');
ok (@{$a1->attrs} == 6, 'Seem to parse pod correctly');
ok (($a1->attrs)->[0]->name eq '_ID', '... yes');
ok (($a1->attrs)->[0]->type eq 'string', '... yes');
ok (($a1->attrs)->[3]->descr eq 'Additional information', '... indeed');
$a1 = new Pod::WSDL::Type(name => 'My::foo');
ok ($a1->array == 0, 'Default for array works');
ok ($a1->descr eq '', 'Handling lack of description works');
eval {
$a1->name('bar');
};
{
no warnings;
ok($@ == undef, 'Renaming type is forbidden');
}
__DATA__
_ATTR _ID $string Word's ID
_ATTR _citation $string _NEEDED Word's citation form
_ATTR _grammar $string Grammatical information
_ATTR _addInfo $string Additional information
_ATTR _language $string _NEEDED Word's language as 2-letter ISO code
_ATTR _user $Voko::User _NEEDED Word's owner
11WSDL01basic.t 100644 000765 000024 12365 12266317307 14671 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Pod::WSDL;
use Test::More tests => 33;
BEGIN {use_ok('Pod::WSDL');}
use lib length $0 > 10 ? substr $0, 0, length($0) - 16 : '.';
use strict;
use warnings;
use XML::XPath;
use Test::XML;
eval {
new Pod::WSDL(source => 'bla');
};
ok($@ =~ /I need a location/, 'new dies, if it does not get a location');
eval {
new Pod::WSDL(location => 'bla');
};
ok($@ =~ /I need a file or module name or a filehandle, died/, 'new dies, if it does not get a source');
my $p = new Pod::WSDL(source => 'My::Server',
location => 'http://localhost/My/Server',
pretty => 1,
withDocumentation => 1);
ok($p->writer->{_pretty}, 'Received pretty argument correctly');
ok($p->writer->{_withDocumentation}, 'Received withDocumentation argument correctly');
ok($p->location eq 'http://localhost/My/Server', 'Received location argument correctly');
ok($p->{_source} eq 'My::Server', 'Received source argument correctly');
ok($p->{_baseName} eq 'MyServer', 'Generated base name argument correctly');
$p->location('http://localhost/My/Other/Server');
ok($p->location eq 'http://localhost/My/Other/Server', 'Setting location works');
ok($p->namespaces->{'xmlns:impl'} eq 'http://localhost/My/Server', 'Generated xmlns:impl namespace correctly');
ok($p->namespaces->{'xmlns:wsdlsoap'} eq 'http://schemas.xmlsoap.org/wsdl/soap/', 'Generated xmlns:soap namespace correctly');
ok($p->namespaces->{'xmlns:wsdl'} eq 'http://schemas.xmlsoap.org/wsdl/', 'Generated xmlns:wsdl namespace correctly');
ok($p->namespaces->{'xmlns:soapenc'} eq 'http://schemas.xmlsoap.org/soap/encoding/', 'Generated xmlns:soapenc namespace correctly');
ok($p->namespaces->{'xmlns:xsd'} eq 'http://www.w3.org/2001/XMLSchema', 'Generated xmlns:xsd namespace correctly');
ok($p->namespaces->{'xmlns:tns1'} eq 'http://localhost/My/Server', 'Generated xmlns:tns1 namespace correctly');
ok(ref $p->writer->{_outStr} eq 'XML::Writer::_String', 'Initialized outStr for writer correctly.');
ok(ref $p->writer->{_writer} eq 'XML::Writer', 'Found an XML::Writer for output');
ok(ref $p->generateNS eq 'CODE', 'Initialized generateNS correctly');
ok($p->writer->{_indent} == 1, 'Initialized indentation correctly');
ok($p->writer->{_lastTag} eq '', 'Initialized lastTag correctly');
my $loc = $p->location;
ok($p->WSDL =~ m##, 'Generated comment correctly');
# arguments of method WSDL()
$p = new Pod::WSDL(source => 'My::OperationTest',
location => 'http://localhost/My/OperationTest',
pretty => 1,
withDocumentation => 1);
my $xp = XML::XPath->new(xml => $p->WSDL);
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name="MyFoo"]/annotation/documentation'), 'Found documentation in schema part (complexType).');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name="MyFoo"]/sequence/element[@name="_bar"]/annotation/documentation'), 'Found documentation in schema part (element).');
ok($xp->exists('/wsdl:definitions/wsdl:portType[@name="MyOperationTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdl:documentation'), 'Found documentation in operation part.');
#print $p->WSDL;
$xp = XML::XPath->new(xml => $p->WSDL(withDocumentation => 0));
ok(!$xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name="MyFoo"]/annotation/documentation'), 'Switched off documentation -> did not find documentation in schema part (complexType).');
ok(!$xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name="MyFoo"]/sequence/element[@name="_bar"]/annotation/documentation'), 'Switched off documentation -> did not find documentation in schema part (element).');
ok(!$xp->exists('/wsdl:definitions/wsdl:portType[@name="MyOperationTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdl:documentation'), 'Switched off documentation -> did not find documentation in operation part.');
$xp = XML::XPath->new(xml => $p->WSDL(withDocumentation => 1));
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name="MyFoo"]/annotation/documentation'), 'Found documentation in schema part (complexType).');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name="MyFoo"]/sequence/element[@name="_bar"]/annotation/documentation'), 'Found documentation in schema part (element).');
ok($xp->exists('/wsdl:definitions/wsdl:portType[@name="MyOperationTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdl:documentation'), 'Found documentation in operation part.');
$p = new Pod::WSDL(source => 'My::Server',
location => 'http://localhost/My/Server',
pretty => 1);
my $outputtestFile = $0;
$outputtestFile =~ s![^/]+$!outputtest001.xml!;
my $outputtest;
{
$/ = undef;
open TEST, "$outputtestFile" or die "Could not open $outputtestFile";
$outputtest = ;
close TEST;
}
my $tmp = $p->WSDL;
$tmp =~ s/\n//;
is_xml($outputtest, $tmp, "Pretty works.");
$outputtestFile = $0;
$outputtestFile =~ s![^/]+$!outputtest002.xml!;
my $outputtest2;
{
$/ = undef;
open TEST, "$outputtestFile" or die "Could not open $outputtestFile";
$outputtest2 = ;
close TEST;
}
$tmp = $p->WSDL(pretty => 0);
$tmp =~ s/\n//;
#print "--->$tmp<---\n";
is_xml($outputtest2, $tmp, "Switch pretty off works.");
$tmp = $p->WSDL(pretty => 1);
$tmp =~ s/\n//;
is_xml($outputtest, $tmp, "Switch pretty on works.");
11WSDL02types.t 100644 000765 000024 14276 12266317307 14760 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Pod::WSDL;
use Test::More tests => 54;
BEGIN {use_ok('Pod::WSDL');}
use lib length $0 > 10 ? substr $0, 0, length($0) - 16 : '.';
use strict;
use warnings;
use XML::XPath;
my $tmpXP;
# test standardtypes
my @xsdTypes = qw(
anyType
anySimpleType
string
normalizedString
token
anyURI
language
Name
QName
NCName
boolean
float
double
decimal
int
positiveInteger
nonPositiveInteger
negativeInteger
nonNegativeInteger
long
short
byte
unsignedInt
unsignedLong
unsignedShort
unsignedByte
duration
dateTime
time
date
gYearMonth
gYear
gMonthDay
gDay
gMonth
hexBinary
base64Binary
);
my $p = new Pod::WSDL(source => 'My::TypeTest',
location => 'http://localhost/My/TypeTest',
pretty => 1,
withDocumentation => 1);
my $xmlOutput = $p->WSDL;
my $xp = XML::XPath->new(xml => $xmlOutput);
my $foundMethod = 0;
for my $m (@{$p->methods}) {
if ($m->name eq 'testXSDTypes') {
$foundMethod = 1;
for (0 .. @xsdTypes - 1) {
ok($m->params->[$_]->type eq $xsdTypes[$_], "Recognized xsd type '$xsdTypes[$_]' on method 'testXSDTypes' correctly")
}
}
}
fail('Did not find method testXSDTypes in package My::TypeTest') unless $foundMethod;
# test own complex types
$foundMethod = 0;
for my $m (@{$p->methods}) {
if ($m->name eq 'testComplexTypes') {
$foundMethod = 1;
ok($m->params->[0]->type eq 'My::Foo', "Recognized own complex type 'My::Foo' on method 'testComplexTypes' correctly")
}
}
fail('Did not find method testComplexTypes in package My::TypeTest') unless $foundMethod;
ok($xp->exists('/wsdl:definitions/wsdl:types/schema[@targetNamespace = "http://localhost/My/TypeTest"]'), 'Found schema with targetNamespace "http://localhost/My/TypeTest" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/import[@namespace = "http://schemas.xmlsoap.org/soap/encoding/"]'), 'Found import of namespace "http://schemas.xmlsoap.org/soap/encoding/" in schema in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name = "MyFoo"]'), 'Found complex type MyFoo in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType/sequence/element[@name = "_bar" and @type = "xsd:negativeInteger"]'), 'Found element with name "_bar" and type xsd:negativeInteger in complex type MyFoo in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType/sequence/element/annotation/documentation[text() = "a bar"]'), 'Found documentation for element with name "_bar" in complex type MyFoo in xml output.');
# test array types
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name = "ArrayOfString"]'), 'Found array type ArrayOfString in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name = "ArrayOfString"]/complexContent'), 'ArrayOfString has complexContent child.');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name = "ArrayOfString"]/complexContent/restriction[@base = "soapenc:Array"]'), 'complexContent has restriction child with base="soapenc:Array".');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name = "ArrayOfString"]/complexContent/restriction[@base = "soapenc:Array"]/attribute[@ref="soapenc:arrayType" and @wsdl:arrayType="soapenc:string[]"]'), 'restriction has attribute child with ref="soapenc:arrayType" and wsdl:arrayType="soapenc:string[].');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name = "ArrayOfMyFoo"]'), 'Found array type ArrayOfMyFoo in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name = "ArrayOfMyFoo"]/complexContent'), 'ArrayOfMyFoo has complexContent child.');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name = "ArrayOfMyFoo"]/complexContent/restriction[@base = "soapenc:Array"]'), 'complexContent has restriction child with base="soapenc:Array".');
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType[@name = "ArrayOfMyFoo"]/complexContent/restriction[@base = "soapenc:Array"]/attribute[@ref="soapenc:arrayType" and @wsdl:arrayType="tns1:MyFoo[]"]'), 'restriction has attribute child with ref="soapenc:arrayType" and wsdl:arrayType="tns1:MyFoo[].');
# test nillable attributes
ok($xp->exists('/wsdl:definitions/wsdl:types/schema/complexType/sequence/element[@name = "_boerk" and @type = "xsd:boolean" and @nillable = "true"]'), 'Found nillable element with name "_boerk" in complex type MyFoo in xml output.');
# test non existing types
eval {
$p = new Pod::WSDL(source => 'My::WrongTypeTest',
location => 'http://localhost/My/WrongTypeTest',
pretty => 1,
withDocumentation => 1);
};
ok($@ =~ /Can't find any file 'Non::Existent::Type' and can't locate it as a module in \@INC either \(\@INC contains/, 'Pod::WSDL dies on encountering unknown type');
__END__
This is just to help making tests ...
a bar
a nillable _boerk
02Utils01basic.t 100644 000765 000024 1351 12266317307 15171 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
use Test::More tests => 5;
BEGIN {use_ok('Pod::WSDL::Utils')}
use strict;
use warnings;
# test getTypeDescr()
ok(Pod::WSDL::Utils::getTypeDescr('int', 0, undef) eq 'xsd:int', 'getTypeDescr() returns simple scalar type correctly');
ok(Pod::WSDL::Utils::getTypeDescr('int', 1, undef) eq 'tns1:ArrayOfInt', 'getTypeDescr() returns simple array type correctly');
ok(Pod::WSDL::Utils::getTypeDescr('foo', 0, OwnType->new) eq 'tns1:wsdlName', 'getTypeDescr() returns complex scalar type correctly');
ok(Pod::WSDL::Utils::getTypeDescr('foo', 1, OwnType->new) eq 'tns1:ArrayOfWsdlName', 'getTypeDescr() returns complex array type correctly');
package OwnType;
sub new {
bless {}, 'OwnType';
}
sub wsdlName {
return 'wsdlName';
} 06Fault01basic.t 100644 000765 000024 2142 12266317307 15147 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
use Test::More tests => 10;
BEGIN {use_ok('Pod::WSDL::Fault')}
use strict;
use warnings;
eval {
my $a1 = new Pod::WSDL::Fault();
};
ok(defined $@, 'new dies, if it does not get a string');
eval {
my $a1 = new Pod::WSDL::Fault('blah blah ...');
};
ok(defined $@, 'new dies, if it does not get a string beginning with _FAULT');
eval {
my $a1 = new Pod::WSDL::Fault('_FAULT My::Fault blah blah ...');
};
ok(defined $@, 'new dies, if array/scalar type is not specified');
my $a1 = new Pod::WSDL::Fault('_FAULT My::Fault blah blah ...');
ok($a1->wsdlName eq 'MyFault', 'Read wsdl name correctly from input');
ok($a1->type eq 'My::Fault', 'Read type correctly from input');
ok($a1->descr eq 'blah blah ...', 'Read descr correctly from input');
$a1 = new Pod::WSDL::Fault(' _FAULT My::Fault blah blah ...');
ok($a1->wsdlName eq 'MyFault', 'Handles whitespace before _FAULT correctly.');
$a1 = new Pod::WSDL::Fault('_FAULT My::Fault');
ok($a1->descr eq '', 'No description is handled correctly');
eval {
$a1->type('foo');
};
{
no warnings;
ok($@ == undef, 'Renaming fault is forbidden.');
}
08Param01basic.t 100644 000765 000024 3153 12266317307 15141 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
use Test::More tests => 15;
BEGIN {use_ok('Pod::WSDL::Param')}
use strict;
use warnings;
eval {
my $a1 = new Pod::WSDL::Param();
};
ok(defined $@, 'new dies, if it does not get a string');
eval {
my $a1 = new Pod::WSDL::Param('myParam $string blah blah ...');
};
ok(defined $@, 'new dies, if it does not get a string beginning with _IN, _OUT, or _INOUT');
eval {
my $a1 = new Pod::WSDL::Param('_IN myParam string blah blah ...');
};
ok(defined $@, 'new dies, if array/scalar type is not specified');
my $a1 = new Pod::WSDL::Param('_IN myParam $string blah blah ...');
ok($a1->name eq 'myParam', 'Read name correctly from input');
ok($a1->type eq 'string', 'Read type correctly from input');
ok($a1->paramType eq 'IN', 'Read in type correctly from input');
ok($a1->array == 0, 'Read scalar type correctly from input');
ok($a1->descr eq 'blah blah ...', 'Read descr correctly from input');
$a1 = new Pod::WSDL::Param(' _IN myParam $string blah blah ...');
ok($a1->name eq 'myParam', 'Handles whitespace before _IN correctly.');
$a1 = new Pod::WSDL::Param('_IN myParam @string blah blah ...');
ok($a1->array == 1, 'Read array type correctly from input');
$a1 = new Pod::WSDL::Param('_IN myParam @string');
ok($a1->descr eq '', 'No description is handled correctly');
$a1 = new Pod::WSDL::Param('_OUT myParam @string');
ok($a1->paramType eq 'OUT', 'Read in type correctly from input');
$a1 = new Pod::WSDL::Param('_INOUT myParam @string');
ok($a1->paramType eq 'INOUT', 'Read inout type correctly from input');
eval {
$a1->name('foo');
};
{
no warnings;
ok($@ == undef, 'Renaming param is forbidden.');
}
WSDL 000755 000765 000024 0 12266317307 14035 5 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod Doc.pm 100644 000765 000024 3037 12266317307 15243 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::Doc;
use strict;
use warnings;
use Pod::WSDL::AUTOLOAD;
our $VERSION = "0.05";
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
sub new {
my ($pkg, $str) = @_;
defined $str or $str = ''; # avoids warnings
$str =~ /\s*_DOC\s*(.*)/ or die "_DOC statements must have structure '_DOC ', like '_DOC This is my documentation'";
bless {
_descr => $1 || '',
}, $pkg;
}
1;
__END__
=head1 NAME
Pod::WSDL::Doc - Represents the WSDL pod for the documentation of methods (internal use only)
=head1 SYNOPSIS
use Pod::WSDL::Doc;
my $doc = new Pod::WSDL::Doc('_DOC This method is for blah ...');
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
=head1 METHODS
=head2 new
Instantiates a new Pod::WSDL::Attr. The method needs one parameter, the documentation string from the pod. Please see SYNOPSIS or the section "Pod Syntax" in the description of Pod::WSDL.
=head1 EXTERNAL DEPENDENCIES
[none]
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL :-)
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
03Writer01basic.t 100644 000765 000024 10205 12266317307 15364 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
use Test::More tests => 16;
BEGIN {use_ok('Pod::WSDL::Writer')}
use strict;
use warnings;
# ****************************************************************
# test constructor()
my $wr = new Pod::WSDL::Writer(pretty => 1, withDocumentation => 1);
ok($wr->{_pretty} == 1, 'Constructor: Read argument pretty correctly.');
ok($wr->{_withDocumentation} == 1, 'Constructor: Read argument withDocumentation correctly.');
ok($wr->{_indent} == 1, 'Constructor: Initialized indentation correctly.');
ok($wr->{_lastTag} eq '', 'Constructor: Initialized last tag correctly.');
ok((ref $wr->{_faultMessageWritten} eq 'HASH'), 'Constructor: Initialized "faultMessageWritten" correctly.');
ok($wr->output eq '' . "\n", 'Constructor: Initialized XML::Writer correctly.');
# ****************************************************************
# test wrNewLine()
$wr->startTag('bla');
$wr->wrNewLine();
$wr->endTag('bla');
my $expectedOutput =<
EOU
ok($wr->output . "\n" eq $expectedOutput, 'wrNewLine works.');
# ****************************************************************
# test wrElem()
$wr = new Pod::WSDL::Writer();
$wr->wrElem('empty', 'foo', bar => 1, bloerch => 'ggg');
$expectedOutput =<
EOU
ok($wr->output . "\n" eq $expectedOutput, 'Writing empty elements works.');
$wr = new Pod::WSDL::Writer();
$wr->wrElem('start', 'foo', bar => 1, bloerch => 'ggg');
$wr->wrElem('end', 'foo', bar => 1, bloerch => 'ggg');
$expectedOutput =<
EOU
ok($wr->output . "\n" eq $expectedOutput, 'Writing non empty elements works.');
# ****************************************************************
# test wrDoc()
$wr = new Pod::WSDL::Writer(withDocumentation => 1);
$wr->wrElem('start', 'foo', bar => 1, bloerch => 'ggg');
$wr->wrDoc('This is my documentation.');
$wr->wrElem('end', 'foo', bar => 1, bloerch => 'ggg');
$expectedOutput =<
This is my documentation.
EOU
ok($wr->output . "\n" eq $expectedOutput, 'wrDoc works.');
$wr = new Pod::WSDL::Writer(withDocumentation => 0);
$wr->wrElem('start', 'foo', bar => 1, bloerch => 'ggg');
$wr->wrDoc('This is my documentation.');
$wr->wrElem('end', 'foo', bar => 1, bloerch => 'ggg');
$expectedOutput =<
EOU
ok($wr->output . "\n" eq $expectedOutput, 'wrDoc writes no documentation when object not initialized with withDocumentation.');
# ****************************************************************
# test withDocumentation()
$wr = new Pod::WSDL::Writer(withDocumentation => 1);
$wr->withDocumentation(0);
$wr->wrElem('start', 'foo', bar => 1, bloerch => 'ggg');
$wr->wrDoc('This is my documentation.');
$wr->wrElem('end', 'foo', bar => 1, bloerch => 'ggg');
$expectedOutput =<
EOU
ok($wr->output . "\n" eq $expectedOutput, 'wrDoc works.');
$wr = new Pod::WSDL::Writer(withDocumentation => 0);
$wr->withDocumentation(1);
$wr->wrElem('start', 'foo', bar => 1, bloerch => 'ggg');
$wr->wrDoc('This is my documentation.');
$wr->wrElem('end', 'foo', bar => 1, bloerch => 'ggg');
$expectedOutput =<
This is my documentation.
EOU
ok($wr->output . "\n" eq $expectedOutput, 'wrDoc writes no documentation when object not initialized with withDocumentation.');
# ****************************************************************
# test registerWrittenFaultMessage() and faultMessageWritten()
$wr->registerWrittenFaultMessage('bar');
ok($wr->faultMessageWritten('bar'), 'Registering written fault messages seems to work.');
# ****************************************************************
# test AUTOLOADING
eval {$wr->bla;};
ok($@ =~ /Can't locate object method "bla" via package "XML::Writer"/, 'AUTOLOADER using XML::Writer correctly.')
07Return01basic.t 100644 000765 000024 2337 12266317307 15362 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
use Test::More tests => 11;
BEGIN {use_ok('Pod::WSDL::Return')}
use strict;
use warnings;
eval {
my $a1 = new Pod::WSDL::Return();
};
ok(defined $@, 'new dies, if it does not get a string');
eval {
my $a1 = new Pod::WSDL::Return('$string blah blah ...');
};
ok(defined $@, 'new dies, if it does not get a string beginning with _RETURN');
eval {
my $a1 = new Pod::WSDL::Return('_RETURN string blah blah ...');
};
ok(defined $@, 'new dies, if array/scalar type is not specified');
my $a1 = new Pod::WSDL::Return('_RETURN $string blah blah ...');
ok($a1->type eq 'string', 'Read type correctly from input');
ok($a1->array == 0, 'Read scalar type correctly from input');
ok($a1->descr eq 'blah blah ...', 'Read descr correctly from input');
$a1 = new Pod::WSDL::Return(' _RETURN $string blah blah ...');
ok($a1->type eq 'string', 'Handles whitespace before _RETURN correctly.');
$a1 = new Pod::WSDL::Return('_RETURN @string blah blah ...');
ok($a1->array == 1, 'Read array type correctly from input');
$a1 = new Pod::WSDL::Return('_RETURN @string');
ok($a1->descr eq '', 'No description is handled correctly');
eval {
$a1->type('foo');
};
{
no warnings;
ok($@ == undef, 'Renaming return type is forbidden.');
}
10Method01basic.t 100644 000765 000024 6125 12266317307 15314 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Pod::WSDL::Method;
use Test::More tests => 21;
BEGIN {use_ok('Pod::WSDL::Method')}
use strict;
use warnings;
use Pod::WSDL::Return;
use Pod::WSDL::Param;
use Pod::WSDL::Doc;
use Pod::WSDL::Fault;
use Pod::WSDL::Writer;
my $m;
eval {$m = new Pod::WSDL::Method(writer => 1);};
ok($@ =~ /a method needs a name/i, 'new dies, if it does not get a name');
eval {$m = new Pod::WSDL::Method(name => 'bla');};
ok($@ =~ /a method needs a writer/i, 'new dies, if it does not get a writer');
my $ret1 = new Pod::WSDL::Return('_RETURN $string This returns blah ...');
my $ret2 = new Pod::WSDL::Return('_RETURN $boolean This returns blah blah ...');
my $doc1 = new Pod::WSDL::Doc('_DOC This method is for blah ...');
my $doc2 = new Pod::WSDL::Doc('_DOC This method is for blah blah ...');
my $par1 = new Pod::WSDL::Param('_IN myParam $string This parameter is for blah ...');
my $par2 = new Pod::WSDL::Param('_OUT yourParam $string This parameter is for blah ...');
my $fau1 = new Pod::WSDL::Fault('_FAULT My::Fault This happens if something happens');
my $fau2 = new Pod::WSDL::Fault('_FAULT My::Fault This happens if nothing happens');
$m = new Pod::WSDL::Method(name => "myMethod", return => $ret1, doc => $doc1, params => [$par1], faults => [$fau1], writer => new Pod::WSDL::Writer);
ok($m->name eq 'myMethod', 'Retrieving name works');
ok($m->oneway == 0, 'Default for oneway set correctly');
ok((ref $m->return eq 'Pod::WSDL::Return' and $m->return->type eq 'string'), 'Retrieving return works');
ok((ref $m->doc eq 'Pod::WSDL::Doc' and $m->doc->descr eq 'This method is for blah ...'), 'Retrieving doc works');
ok((ref $m->params->[0] eq 'Pod::WSDL::Param' and $m->params->[0]->name eq 'myParam'), 'Retrieving param works');
ok((ref $m->faults->[0] eq 'Pod::WSDL::Fault' and $m->faults->[0]->type eq 'My::Fault'), 'Retrieving fault works');
ok(ref $m->writer eq 'Pod::WSDL::Writer', 'Pod::WSDL::Writer correctly initialized');
$m->return($ret2);
$m->doc($doc2);
ok((ref $m->return eq 'Pod::WSDL::Return' and $m->return->type eq 'boolean'), 'Setting return works');
ok((ref $m->doc eq 'Pod::WSDL::Doc' and $m->doc->descr eq 'This method is for blah blah ...'), 'Setting doc works');
$m->addParam($par2);
$m->addFault($fau2);
ok((ref $m->params->[0] eq 'Pod::WSDL::Param' and $m->params->[0]->name eq 'myParam'), 'Adding param does not influence existing params');
ok((ref $m->faults->[0] eq 'Pod::WSDL::Fault' and $m->faults->[0]->type eq 'My::Fault'), 'Adding fault does not influence existing faults');
ok((ref $m->params->[1] eq 'Pod::WSDL::Param' and $m->params->[1]->name eq 'yourParam'), 'Setting param works');
ok((ref $m->faults->[1] eq 'Pod::WSDL::Fault' and $m->faults->[1]->descr eq 'This happens if nothing happens'), 'Setting fault works');
$m->oneway(1);
ok($m->oneway == 1, 'Setting param oneway works');
$m->oneway(0);
ok($m->oneway == 0, 'Unsetting param oneway works');
eval {
$m->name('foo');
};
{
no warnings;
ok($@ == undef, 'Renaming method is forbidden.');
}
ok($m->requestName eq 'fooRequest', 'Method requestName() works');
ok($m->responseName eq 'fooResponse', 'Method responseName() works');
11WSDL04binding.t 100644 000765 000024 13067 12266317307 15225 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Pod::WSDL;
use Test::More tests => 15;
BEGIN {use_ok('Pod::WSDL');}
use lib length $0 > 11 ? substr $0, 0, length($0) - 17 : '.';
use strict;
use warnings;
use XML::XPath;
my $p = new Pod::WSDL(source => 'My::BindingTest',
location => 'http://localhost/My/Test',
pretty => 1,
withDocumentation => 1);
my $xmlOutput = $p->WSDL;
my $xp = XML::XPath->new(xml => $xmlOutput);
#print $xmlOutput;
#print XML::XPath::XMLParser::as_string(($xp->find('/wsdl:definitions/wsdl:binding')->get_nodelist())[0]);
# test general structure
# binding
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]'), 'Found wsdl:binding element in xml output.');
# wsdlsoap:binding
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdlsoap:binding[@style="rpc" and @transport="http://schemas.xmlsoap.org/soap/http"]'), 'Found wsdlsoap:binding element in wsdl:binding.');
# operation
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testGeneral"]'), 'Found operation "testGeneral" element in wsdl:binding.');
# wsdlsoap:operation
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdlsoap:operation[@soapAction = ""]'), 'Found wsdlsoap:operation in operation "testGeneral" element.');
# input
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdl:input[@name = "testGeneralRequest"]'), 'Found wsdl:input in operation "testGeneral" element.');
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdl:input[@name = "testGeneralRequest"]/wsdlsoap:body[@encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" and @namespace="http://localhost/My/BindingTest" and @use="encoded"]'), 'Found wsdlsoap:body in wsdl:input element.');
# output
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdl:output[@name = "testGeneralResponse"]'), 'Found wsdl:output in operation "testGeneral" element.');
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdl:output[@name = "testGeneralResponse"]/wsdlsoap:body[@encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" and @namespace="http://localhost/My/BindingTest" and @use="encoded"]'), 'Found wsdlsoap:body in wsdl:output element.');
# fault
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdl:fault[@name = "MyFoo"]'), 'Found wsdl:fault in operation "testGeneral" element.');
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testGeneral"]/wsdl:fault[@name = "MyFoo"]/wsdlsoap:fault[@encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" and @namespace="http://localhost/My/BindingTest" and @use="encoded"]'), 'Found wsdlsoap:fault in wsdl:fault element.');
# one-way operation
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testOneway"]/wsdl:input[@name = "testOnewayRequest"]'), 'Found wsdl:input in operation "testOneway" element.');
ok($xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testOneway"]/wsdl:input[@name = "testOnewayRequest"]/wsdlsoap:body[@encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" and @namespace="http://localhost/My/BindingTest" and @use="encoded"]'), 'Found wsdlsoap:body in wsdl:input element.');
# output
ok(!$xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testOneway"]/wsdl:output[@name = "testOnewayResponse"]'), 'Did not find wsdl:output in operation "testOneway" element (which is correct).');
# test method without wsdl pod
ok(!$xp->exists('/wsdl:definitions/wsdl:binding[@name="MyBindingTestSoapBinding" and @type="impl:MyBindingTestHandler"]/wsdl:operation[@name="testWithoutPod"]'), 'Non pod operation not found in binding.');
#print $xmlOutput;
__END__
# just to make writing tests easier ...
11WSDL05service.t 100644 000765 000024 2640 12266317307 15227 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Pod::WSDL;
use Test::More tests => 4;
BEGIN {use_ok('Pod::WSDL');}
use lib length $0 > 11 ? substr $0, 0, length($0) - 17 : '.';
use strict;
use warnings;
use XML::XPath;
my $p = new Pod::WSDL(source => 'My::ServiceTest',
location => 'http://localhost/My/Test',
pretty => 1,
withDocumentation => 1);
my $xmlOutput = $p->WSDL;
my $xp = XML::XPath->new(xml => $xmlOutput);
#print $xmlOutput;
#print XML::XPath::XMLParser::as_string(($xp->find('/wsdl:definitions/wsdl:service')->get_nodelist())[0])
# test general structure
ok($xp->exists('/wsdl:definitions/wsdl:service[@name="MyServiceTestHandlerService"]'), 'Found wsdl:service element in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:service[@name="MyServiceTestHandlerService"]/wsdl:port[@binding="impl:MyServiceTestSoapBinding" and @name="MyServiceTest"]'), 'Found wsdl:port in wsdl:service element.');
ok($xp->exists('/wsdl:definitions/wsdl:service[@name="MyServiceTestHandlerService"]/wsdl:port[@binding="impl:MyServiceTestSoapBinding" and @name="MyServiceTest"]/wsdlsoap:address[@location="http://localhost/My/Test"]'), 'Found wsdlsoap:address in wsdl:port element.');
__END__
11WSDL06parsing.t 100644 000765 000024 266 12266317307 15215 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Pod::WSDL;
use Test::More tests => 1;
BEGIN {use_ok('Pod::WSDL');}
use lib length $0 > 10 ? substr $0, 0, length($0) - 16 : '.';
use strict;
use warnings;
outputtest001.xml 100644 000765 000024 4012 12266317307 15577 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t
outputtest002.xml 100644 000765 000024 3570 12266317307 15610 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t
BindingTest.pm 100644 000765 000024 325 12266317307 15514 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t/My package My::BindingTest;
=begin WSDL
_IN in $string
_FAULT My::Foo
_RETURN $string
_DOC bla bla
=cut
sub testGeneral {}
=begin WSDL
_IN in @string
_ONEWAY
=cut
sub testOneway {}
sub testWithoutPod {}
1;
ServiceTest.pm 100644 000765 000024 200 12266317307 15532 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t/My package My::ServiceTest;
=begin WSDL
_IN in $string
_FAULT My::Foo
_RETURN $string
_DOC bla bla
=cut
sub testGeneral {}
1;
Attr.pm 100644 000765 000024 4165 12266317307 15453 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::Attr;
use strict;
use warnings;
use Pod::WSDL::AUTOLOAD;
our $VERSION = "0.05";
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
our %FORBIDDEN_METHODS = (
name => {get => 1, set => 0},
type => {get => 1, set => 0},
nillable => {get => 1, set => 0},
descr => {get => 1, set => 0},
array => {get => 1, set => 0},
);
sub new {
my ($pkg, $str) = @_;
defined $str or $str = ''; # avoids warnings
$str =~ s/\s*_ATTR\s*//i or die "Input string '$str' does not begin with '_ATTR'";
my ($name, $type, $needed, $descr) = split /\s+/, $str, 4;
$descr ||= '';
if ((uc $needed) ne '_NEEDED') {
$descr = "$needed $descr";
$needed = 0;
} else {
$needed = 1;
}
$type =~ /([\$\@])(.*)/;
die "Type '$type' must be prefixed with either '\$' or '\@', died" unless $1;
bless {
_name => $name,
_type => $2,
_nillable => $needed ? undef : 'true',
_descr => $descr,
_array => $1 eq '@' ? 1 : 0,
}, $pkg;
}
1;
__END__
=head1 NAME
Pod::WSDL::Attr - Represents the WSDL pod for an attribute of a class (internal use only)
=head1 SYNOPSIS
use Pod::WSDL::Attr;
my $attr = new Pod::WSDL::Attr('_ATTR $string _NEEDED This attribute is for blah ...');
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
=head1 METHODS
=head2 new
Instantiates a new Pod::WSDL::Attr. The method needs one parameter, the attribute string from the pod. Please see SYNOPSIS or the section "Pod Syntax" in the description of Pod::WSDL.
=head1 EXTERNAL DEPENDENCIES
[none]
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
Type.pm 100644 000765 000024 11513 12266317307 15475 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::Type;
use strict;
use warnings;
use Pod::WSDL::Attr;
use Pod::WSDL::Utils qw(:writexml :namespaces :types);
use Pod::WSDL::AUTOLOAD;
our $VERSION = "0.05";
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
our %FORBIDDEN_METHODS = (
name => {get => 1, set => 0},
wsdlName => {get => 1, set => 0},
array => {get => 1, set => 1},
descr => {get => 1, set => 0},
attrs => {get => 1, set => 0},
writer => {get => 0, set => 0},
);
sub new {
my ($pkg, %data) = @_;
die "A type needs a name, died" unless $data{name};
my $wsdlName = $data{name};
$wsdlName =~ s/(?:^|::)(.)/uc $1/eg;
my $me = bless {
_name => $data{name},
_wsdlName => ucfirst $wsdlName,
_array => $data{array} || 0,
_attrs => [],
_descr => $data{descr} || '',
_writer => $data{writer},
_reftype => 'HASH',
}, $pkg;
$me->_initPod($data{pod}) if $data{pod};
return $me;
}
sub _initPod {
my $me = shift;
my $pod = shift;
my @data = split "\n", $pod;
# Preprocess wsdl pod: trim all lines and concatenate lines not
# beginning with wsdl type tokens to previous line.
# Ignore first element, if it does not begin with wsdl type token.
for (my $i = $#data; $i >= 0; $i--) {
if ($data[$i] !~ /^\s*(?:_ATTR|_REFTYPE)/i) {
if ($i > 0) {
$data[$i - 1] .= " $data[$i]";
$data[$i] = '';
}
}
}
for (@data) {
s/\s+/ /g;
s/^ //;
s/ $//;
if (/^\s*_ATTR\s+/i) {
push @{$me->{_attrs}}, new Pod::WSDL::Attr($_);
} elsif (/^\s*_REFTYPE\s+(HASH|ARRAY)/i) {
$me->reftype(uc $1);
}
}
}
sub writeComplexType {
my $me = shift;
my $ownTypes = shift;
$me->writer->wrElem($START_PREFIX_NAME, "complexType", name => $me->wsdlName);
$me->writer->wrDoc($me->descr, useAnnotation => 1);
if ($me->reftype eq 'HASH') {
$me->writer->wrElem($START_PREFIX_NAME, "sequence");
for my $attr (@{$me->attrs}) {
my %tmpArgs = (name => $attr->name,
type => Pod::WSDL::Utils::getTypeDescr($attr->type, $attr->array, $ownTypes->{$attr->type}));
$tmpArgs{nillable} = $attr->nillable if $attr->nillable;
$me->writer->wrElem($START_PREFIX_NAME, "element", %tmpArgs);
$me->writer->wrDoc($attr->descr, useAnnotation => 1);
$me->writer->wrElem($END_PREFIX_NAME, "element");
}
$me->writer->wrElem($END_PREFIX_NAME, "sequence");
} elsif ($me->reftype eq 'ARRAY') {
$me->writer->wrElem($START_PREFIX_NAME, "complexContent");
$me->writer->wrElem($START_PREFIX_NAME, "restriction", base => "soapenc:Array");
$me->writer->wrElem($EMPTY_PREFIX_NAME, "attribute", ref => $TARGET_NS_DECL . ':' . $me->wsdlName, "wsdl:arrayType" => 'xsd:anyType[]');
$me->writer->wrElem($END_PREFIX_NAME, "restriction");
$me->writer->wrElem($END_PREFIX_NAME, "complexContent");
}
$me->writer->wrElem($END_PREFIX_NAME, "complexType");
if ($me->array) {
$me->writer->wrElem($START_PREFIX_NAME, "complexType", name => $ARRAY_PREFIX_NAME . ucfirst $me->wsdlName);
$me->writer->wrElem($START_PREFIX_NAME, "complexContent");
$me->writer->wrElem($START_PREFIX_NAME, "restriction", base => "soapenc:Array");
$me->writer->wrElem($EMPTY_PREFIX_NAME, "attribute", ref => "soapenc:arrayType", "wsdl:arrayType" => $TARGET_NS_DECL . ':' . $me->wsdlName . '[]');
$me->writer->wrElem($END_PREFIX_NAME, "restriction");
$me->writer->wrElem($END_PREFIX_NAME, "complexContent");
$me->writer->wrElem($END_PREFIX_NAME, "complexType");
}
}
1;
__END__
=head1 NAME
Pod::WSDL::Type - Represents a type in Pod::WSDL (internal use only)
=head1 SYNOPSIS
use Pod::WSDL::Type;
my $type = new Pod::WSDL::Param(name => 'My::Foo', array => 0, descr => 'My foo bars');
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
=head1 METHODS
=head2 new
Instantiates a new Pod::WSDL::Type.
=head3 Parameters
=over 4
=item
name - name of the type, something like 'string', 'boolean', 'My::Foo' etc.
=item
array - if true, an array of the type is used (defaults to 0)
=item
descr - description of the type
=item
pod - the wsdl pod of the type. Please see the section "Pod Syntax" in the description of Pod::WSDL.
=back
=head2 writeComplexType
Write complex type element for XML output. Takes one parameter: ownTypes, reference to hash with own type information
=head1 EXTERNAL DEPENDENCIES
[none]
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL :-)
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
Fault.pm 100644 000765 000024 3621 12266317307 15610 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::Fault;
use strict;
use warnings;
use Pod::WSDL::AUTOLOAD;
our $VERSION = "0.05";
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
our %FORBIDDEN_METHODS = (
type => {get => 1, set => 0},
descr => {get => 1, set => 0},
wsdlName => {get => 1, set => 0},
);
sub new {
my ($pkg, $str) = @_;
$str ||= '' ; # avoid warnings here, will die soon
$str =~ s/^\s*_FAULT\s*//i or die "_FAULT statements must have structure '_FAULT ', like '_FAULT My::Fault This is my documentation'";
my ($type, $descr) = split /\s+/, $str, 2;
my $wsdlName = $type;
$wsdlName =~ s/::(.)/uc $1/eg;
$descr ||= '';
bless {
_type => $type,
_descr => $descr,
_wsdlName => ucfirst $wsdlName,
}, $pkg;
}
1;
__END__
=head1 NAME
Pod::WSDL::Fault - Represents the WSDL pod describing the fault of a method (internal use only)
=head1 SYNOPSIS
use Pod::WSDL::Fault;
my $fault = new Pod::WSDL::Fault('_FAULT My::Fault This happens if something happens');
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
=head1 METHODS
=head2 new
Instantiates a new Pod::WSDL::Fault. The method needs one parameter, the fault string from the pod. Please see SYNOPSIS or the section "Pod Syntax" in the description of Pod::WSDL.
=head1 EXTERNAL DEPENDENCIES
[none]
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL :-)
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
Param.pm 100644 000765 000024 4224 12266317307 15575 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::Param;
use strict;
use warnings;
use Pod::WSDL::AUTOLOAD;
our $VERSION = "0.05";
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
our %FORBIDDEN_METHODS = (
name => {get => 1, set => 0},
type => {get => 1, set => 0},
paramType => {get => 1, set => 0},
descr => {get => 1, set => 0},
array => {get => 1, set => 0},
);
sub new {
my ($pkg, $str) = @_;
defined $str or $str = ''; # avoids warnings, dies soon
$str =~ s/\s*_(INOUT|IN|OUT)\s*//i or die "Input string '$str' does not begin with '_IN', '_OUT' or '_INOUT'";
my $paramType = $1;
my ($name, $type, $descr) = split /\s+/, $str, 3;
$type ||= ''; # avoids warnings, dies soon
$type =~ /([\$\@])(.+)/;
die "Type '$type' must have structure (\$|@), e.g. '\$boolean' or '\@string', not '$type' died" unless $1 and $2;
bless {
_name => $name,
_type => $2,
_paramType => $paramType,
_descr => $descr || '',
_array => $1 eq '@' ? 1 : 0,
}, $pkg;
}
1;
__END__
=head1 NAME
Pod::WSDL::Param - Represents the WSDL pod for a parameter of a method (internal use only)
=head1 SYNOPSIS
use Pod::WSDL::Param;
my $param = new Pod::WSDL::Param('_IN myParam $string This parameter is for blah ...');
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
=head1 METHODS
=head2 new
Instantiates a new Pod::WSDL::Param. The method needs one parameter, the _IN, _OUT or _INOUT string from the pod. Please see SYNOPSIS or the section "Pod Syntax" in the description of Pod::WSDL.
=head1 EXTERNAL DEPENDENCIES
[none]
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
Utils.pm 100644 000765 000024 7036 12266317307 15641 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::Utils;
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = (
writexml => [qw($END_PREFIX_NAME $START_PREFIX_NAME $EMPTY_PREFIX_NAME)],
namespaces => [qw(%BASIC_NAMESPACES $DEFAULT_NS_DECL $TARGET_NS_DECL $IMPL_NS_DECL)],
messages => [qw($REQUEST_SUFFIX_NAME $RESPONSE_SUFFIX_NAME $RETURN_SUFFIX_NAME $EMPTY_MESSAGE_NAME $DOCUMENT_STYLE $RPC_STYLE $LITERAL_USE $ENCODED_USE $PART_IN $FAULT_NAME $MESSAGE_PART)],
types => [qw($ARRAY_PREFIX_NAME %XSD_STANDARD_TYPE_MAP)],
);
our @EXPORT_OK = (@{$EXPORT_TAGS{writexml}}, @{$EXPORT_TAGS{namespaces}}, @{$EXPORT_TAGS{messages}}, @{$EXPORT_TAGS{types}});
our $VERSION = "0.05";
# writexml
our $END_PREFIX_NAME = 'end';
our $START_PREFIX_NAME = 'start';
our $EMPTY_PREFIX_NAME = 'empty';
# namespaces
our %BASIC_NAMESPACES = qw (
soapenc http://schemas.xmlsoap.org/soap/encoding/
wsdl http://schemas.xmlsoap.org/wsdl/
wsdlsoap http://schemas.xmlsoap.org/wsdl/soap/
xsd http://www.w3.org/2001/XMLSchema
);
our $DEFAULT_NS_DECL = 'podwsdl';
our $TARGET_NS_DECL = 'tns1';
our $IMPL_NS_DECL = 'impl';
# messages
our $REQUEST_SUFFIX_NAME = 'Request';
our $RESPONSE_SUFFIX_NAME = 'Response';
our $RETURN_SUFFIX_NAME = 'Return';
our $EMPTY_MESSAGE_NAME = 'empty';
our $FAULT_NAME = 'fault';
our $DOCUMENT_STYLE = 'document';
our $RPC_STYLE = 'rpc';
our $LITERAL_USE = 'literal';
our $ENCODED_USE = 'encoded';
our $PART_IN = 'PartIn';
our $MESSAGE_PART = 'MessagePart';
# types
our $ARRAY_PREFIX_NAME = 'ArrayOf';
our %XSD_STANDARD_TYPE_MAP;
# see http://www.w3.org/TR/2004/REC-xmlschema-2-20041028/
$XSD_STANDARD_TYPE_MAP{$_} = 1 for qw(
anyType
anySimpleType
string
normalizedString
token
anyURI
language
Name
QName
NCName
boolean
float
double
decimal
int
positiveInteger
nonPositiveInteger
negativeInteger
nonNegativeInteger
long
short
byte
unsignedInt
unsignedLong
unsignedShort
unsignedByte
duration
dateTime
time
date
gYearMonth
gYear
gMonthDay
gDay
gMonth
hexBinary
base64Binary
);
sub getTypeDescr {
my $typeName = shift;
my $array = shift;
my $ownType = shift;
if ((defined $typeName) and (exists $XSD_STANDARD_TYPE_MAP{$typeName})) {
if ($array) {
return $TARGET_NS_DECL . ':' . $ARRAY_PREFIX_NAME . ucfirst $typeName;
} else {
return 'xsd:' . $typeName;
}
} elsif (defined $ownType) {
return $TARGET_NS_DECL . ':' . ($array ? $ARRAY_PREFIX_NAME . ucfirst $ownType->wsdlName : $ownType->wsdlName);
} else {
return undef;
}
}
1;
__END__
=head1 NAME
Pod::WSDL::Utils - Utilities and constants for Pod::WSDL (internal use only)
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
=head1 METHODS
=head2 getTypeDescr
Returns a type description for type attributes in the wsdl document
=head1 EXTERNAL DEPENDENCIES
[none]
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL ;-)
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
01AUTOLOAD01basic.t 100644 000765 000024 743 12266317307 15264 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Foo;
use Pod::WSDL::AUTOLOAD;
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
sub new {
my $pgk = shift;
bless {
_bar => 'blah',
}, $pgk
}
1;
package main;
use Test::More tests => 3;
$foo = Foo->new;
ok($foo->bar eq 'blah', '"_bar" retrievable with "bar".');
$foo->bar('bloerch'); # sets _bar to 'bloerch'
ok($foo->bar eq 'bloerch', '"_bar" settable with "bar".');
eval {
$foo->boerk;
};
ok($@, 'Using method not equivalent to any attribute croaks');
OperationTest.pm 100644 000765 000024 733 12266317307 16105 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t/My package My::OperationTest;
=begin WSDL
_IN in $string
_FAULT My::Foo
_RETURN $string
_DOC bla bla
=cut
sub testGeneral {}
=begin WSDL
_IN in $string
_OUT out $string
_INOUT inout $string
=cut
sub testInOut {}
=begin WSDL
_IN in @string
_RETURN @string
=cut
sub testArray {}
=begin WSDL
_IN in @string
=cut
sub testEmpty {}
=begin WSDL
_IN in @string
_ONEWAY
=cut
sub testOneway {}
=begin WSDL
=cut
sub testNoReturnNoParam {}
sub testWithoutPod {}
1;
WrongTypeTest.pm 100644 000765 000024 147 12266317307 16102 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t/My package My::WrongTypeTest;
=begin WSDL
_IN bar $Non::Existent::Type
=cut
sub testArrayTypes {}
1;
Method.pm 100644 000765 000024 26344 12266317307 16004 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::Method;
use strict;
use warnings;
use Pod::WSDL::Param;
use Pod::WSDL::Fault;
use Pod::WSDL::Return;
use Pod::WSDL::Doc;
use Pod::WSDL::Writer;
use Pod::WSDL::Utils qw(:writexml :namespaces :messages);
use Pod::WSDL::AUTOLOAD;
our $VERSION = "0.05";
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
our $EMPTY_MESSAGE_NAME = 'empty';
our $REQUEST_SUFFIX_NAME = 'Request';
our $RESPONSE_SUFFIX_NAME = 'Response';
our $RETURN_SUFFIX_NAME = 'Return';
our $TARGET_NS_DECL = 'tns1';
our %FORBIDDEN_METHODS = (
name => {get => 1, set => 0},
params => {get => 1, set => 0},
doc => {get => 1, set => 1},
return => {get => 1, set => 1},
faults => {get => 1, set => 0},
oneway => {get => 1, set => 1},
writer => {get => 0, set => 0},
);
sub new {
my ($pkg, %data) = @_;
die "A method needs a name, died" unless defined $data{name};
die "A method needs a writer, died" unless defined $data{writer} and ref $data{writer} eq 'Pod::WSDL::Writer';
bless {
_name => $data{name},
_params => $data{params} || [],
_return => $data{return},
_doc => $data{doc} || new Pod::WSDL::Doc('_DOC'),
_faults => $data{faults} || [],
_oneway => $data{oneWay} || 0,
_writer => $data{writer},
_emptyMessageWritten => 0,
}, $pkg;
}
sub addParam {
push @{$_[0]->{_params}}, $_[1] if defined $_[1];
}
sub addFault {
push @{$_[0]->{_faults}}, $_[1] if defined $_[1];
}
sub requestName {
return $_[0]->name . $REQUEST_SUFFIX_NAME;
}
sub responseName {
return $_[0]->name . $RESPONSE_SUFFIX_NAME;
}
sub writeMessages {
my $me = shift;
my $types = shift;
my $style = shift;
my $wrapped = shift;
$me->_writeMessageRequestElem($types, $style, $wrapped);
$me->writer->wrNewLine;
unless ($me->oneway) {
if ($me->return) {
$me->_writeMessageResponseElem($types, $style, $wrapped);
$me->writer->wrNewLine;
} else {
unless ($me->writer->emptyMessageWritten) {
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:message', name => $EMPTY_MESSAGE_NAME);
$me->writer->registerWrittenEmptyMessage;
$me->writer->wrNewLine;
}
}
}
for my $fault (@{$me->faults}) {
next if $me->writer->faultMessageWritten($fault->wsdlName);
$me->_writeMessageFaultElem($fault->wsdlName, $style, $wrapped);
$me->writer->registerWrittenFaultMessage($fault->wsdlName);
$me->writer->wrNewLine;
}
}
sub writePortTypeOperation {
my $me = shift;
my $name = $me->name;
my $paramOrder = '';
for my $param (@{$me->params}) {
$paramOrder .= $param->name . ' ';
}
$paramOrder =~ s/\s+$//;
my $inputName = $name . $REQUEST_SUFFIX_NAME;
my $outputName = $name . $RESPONSE_SUFFIX_NAME;
# maintain param order, name always first
# if no params, don't send and element with that name
my @p_order = $paramOrder ? ('parameterOrder', $paramOrder) : () ;
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:operation', name => $name, @p_order);
$me->writer->wrDoc($me->doc->descr);
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:input', message => "$IMPL_NS_DECL:$inputName", name => $inputName);
# if method has no return, we treat it as one-way operation
unless ($me->oneway) {
if ($me->return) {
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:output', message => "$IMPL_NS_DECL:$outputName", name => $outputName);
} else {
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:output', message => "$IMPL_NS_DECL:$EMPTY_MESSAGE_NAME");
}
}
my $elemType;
# write methods faults
for my $fault (@{$me->faults}) {
# if we want documentation and have some documentation ...
if ($fault->descr and $me->writer->withDocumentation) {
$elemType = $START_PREFIX_NAME;
} else {
$elemType = $EMPTY_PREFIX_NAME;
}
$me->writer->wrElem($elemType, "wsdl:fault", message => "$IMPL_NS_DECL:" . $fault->wsdlName, name => $fault->wsdlName);
# only, if with documentation
if ($elemType eq $START_PREFIX_NAME) {
$me->writer->wrDoc($fault->descr);
$me->writer->wrElem($END_PREFIX_NAME, "wsdl:fault");
}
}
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:operation');
}
sub _writeMessageRequestElem {
my $me = shift;
my $types = shift;
my $style = shift;
my $wrapped = shift;
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:message', name => $me->requestName);
if ($wrapped) {
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', name => 'parameters', element => $me->requestName);
} else {
for my $param (@{$me->params}) {
$me->_writePartElem($param->name, $param->type, $param->array, $param->descr, $style, 0, $types->{$param->type}) if $param->paramType =~ /^(INOUT|OUT|IN)$/;
}
}
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:message');
}
sub _writeMessageResponseElem {
my $me = shift;
my $types = shift;
my $style = shift;
my $wrapped = shift;
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:message', name => $me->responseName);
if ($wrapped) {
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', name => 'parameters', element => $me->responseName);
} else {
for my $param (@{$me->params}) {
$me->_writePartElem($param->name, $param->type, $param->array, $param->descr, $style, 0, $types->{$param->type}) if $param->paramType =~ /^(INOUT|OUT)?$/;
}
if (defined $me->return) {
$me->_writePartElem($me->name . $RETURN_SUFFIX_NAME, $me->return->type, $me->return->array, $me->return->descr, $style, 1, $types->{$me->return->type});
}
}
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:message');
}
sub _writeMessageFaultElem {
my $me = shift;
my $name = shift;
my $style = shift;
my $wrapped = shift;
my %attrs = (name => $FAULT_NAME);
if ($style eq $RPC_STYLE) {
$attrs{type} = "$TARGET_NS_DECL:$name";
} elsif ($style eq $DOCUMENT_STYLE) {
$attrs{element} = $name . $MESSAGE_PART;
}
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:message', name => $name);
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', %attrs);
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:message');
}
sub _writePartElem {
my $me = shift;
my $name = shift;
my $type = shift;
my $array = shift;
my $descr = shift;
my $style = shift;
my $isReturn = shift;
my $ownType = shift;
my %attrs = (name => $name);
if ($style eq $RPC_STYLE) {
$attrs{type} = Pod::WSDL::Utils::getTypeDescr($type, $array, $ownType);
} elsif ($style eq $DOCUMENT_STYLE) {
$attrs{element} = ($isReturn ? lcfirst $RETURN_SUFFIX_NAME : $name) . $PART_IN . ucfirst $me->requestName
}
if ($descr and $me->writer->withDocumentation) {
$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:part', %attrs);
$me->writer->wrDoc($descr);
$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:part');
} else {
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', %attrs);
}
}
sub writeBindingOperation {
my $me = shift;
my $location = shift;
my $use = shift;
$me->writer->wrElem($START_PREFIX_NAME, "wsdl:operation", name => $me->name);
$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:operation", soapAction => "");
$me->writer->wrElem($START_PREFIX_NAME, "wsdl:input", name => $me->requestName);
$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:body", encodingStyle => "http://schemas.xmlsoap.org/soap/encoding/", namespace => $location, use => $use);
$me->writer->wrElem($END_PREFIX_NAME, "wsdl:input");
unless ($me->oneway) {
$me->writer->wrElem($START_PREFIX_NAME, "wsdl:output", name => $me->return ? $me->responseName : $EMPTY_MESSAGE_NAME);
$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:body", encodingStyle => "http://schemas.xmlsoap.org/soap/encoding/", namespace => $location, use => $use);
$me->writer->wrElem($END_PREFIX_NAME, "wsdl:output");
}
for my $fault (@{$me->faults}) {
$me->writer->wrElem($START_PREFIX_NAME, "wsdl:fault", name => $fault->wsdlName);
$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:fault", name => $fault->wsdlName, encodingStyle => "http://schemas.xmlsoap.org/soap/encoding/", namespace => $location, use => $use);
$me->writer->wrElem($END_PREFIX_NAME, "wsdl:fault");
}
$me->writer->wrElem($END_PREFIX_NAME, "wsdl:operation");
}
sub writeDocumentStyleSchemaElements {
my $me = shift;
my $types = shift;
for my $param (@{$me->params}) {
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'element',
name => $param->name . $PART_IN . ucfirst $me->requestName,
type => Pod::WSDL::Utils::getTypeDescr($param->type, $param->array, $types->{$param->type}));
}
for my $fault (@{$me->faults}) {
next if $me->writer->faultMessageWritten($fault->wsdlName . $MESSAGE_PART);
$me->writer->registerWrittenFaultMessage($fault->wsdlName . $MESSAGE_PART);
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'element',
name => $fault->wsdlName . $MESSAGE_PART,
type => Pod::WSDL::Utils::getTypeDescr($fault->type, 0, $types->{$fault->type}));
}
if (!$me->oneway and $me->return) {
$me->writer->wrElem($EMPTY_PREFIX_NAME, 'element',
name => lcfirst $RETURN_SUFFIX_NAME . $PART_IN . ucfirst $me->requestName,
type => Pod::WSDL::Utils::getTypeDescr($me->return->type, $me->return->array, $types->{$me->return->type}));
}
}
1;
__END__
=head1 NAME
Pod::WSDL::Method - Represents a method in Pod::WSDL (internal use only)
=head1 SYNOPSIS
use Pod::WSDL::Method;
my $m = new Pod::WSDL::Method(name => 'mySub', writer => 'myWriter', doc => new Pod::WSDL::Doc($docStr), return => new Pod::WSDL::Return($retStr));
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
=head1 METHODS
=head2 new
Instantiates a new Pod::WSDL::Method.
=head2 Parameters
=over 4
=item
name - name of the method, mandatory
=item
doc - a Pod::WSDL::Doc object, can be omitted, use method doc later
=item
return - a Pod::WSDL::Return object, can be omitted, use method return later
=item
params - ref to array of Pod::WSDL::Param objects, can be omitted, use addParam() later
=item
faults - ref to array of Pod::WSDL::Fault objects, can be omitted, use addFault() later
=item
oneway - if true, method is a one way operation
=item
writer - XML::Writer-Object for output, mandatory
=back
=head2 addParam
Add a Pod::WSDL::Param object to Pod::WSDL::Method
=head2 addFault
Add a Pod::WSDL::Fault object to Pod::WSDL::Method
=head2 return
Get or Set the Pod::WSDL::Return object for Pod::WSDL::Method
=head2 doc
Get or Set the Pod::WSDL::Doc object for Pod::WSDL::Method
=head2 requestName
Get name for request in XML output
=head2 responseName
Get name for response in XML output
=head2 writeBindingOperation
Write operation child for binding element in XML output
=head2 writeMessages
Write message elements in XML output
=head2 writePortTypeOperation
Write operation child for porttype element in XML output
=head1 EXTERNAL DEPENDENCIES
[none]
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL :-)
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
Return.pm 100644 000765 000024 3564 12266317307 16022 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::Return;
use strict;
use warnings;
use Pod::WSDL::AUTOLOAD;
our $VERSION = "0.05";
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
our %FORBIDDEN_METHODS = (
type => {get => 1, set => 0},
array => {get => 1, set => 0},
descr => {get => 1, set => 0},
);
sub new {
my ($pkg, $str) = @_;
defined $str or $str = ''; # avoids warnings, dies soon
$str =~ s/\s*_RETURN\s*//i;
my ($type, $descr) = split /\s+/, $str, 2;
$type ||= ''; # avoids warnings, dies soon
$type =~ /([\$\@])(.+)/;
die "Type '$type' must have structure (\$|\@), e.g. '\$boolean' or '\@string', died" unless $1 and $2;
bless {
_type => $2,
_descr => $descr || '',
_array => $1 eq '@' ? 1 : 0,
}, $pkg;
}
1;
__END__
=head1 NAME
Pod::WSDL::Return - Represents the WSDL pod for the return value of a method (internal use only)
=head1 SYNOPSIS
use Pod::WSDL::Return;
my $return = new Pod::WSDL::Return('_RETURN $string This returns blah ...');
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
=head1 METHODS
=head2 new
Instantiates a new Pod::WSDL::Param. The method needs one parameter, the _RETURN string from the pod. Please see SYNOPSIS or the section "Pod Syntax" in the description of Pod::WSDL.
=head1 EXTERNAL DEPENDENCIES
[none]
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
Writer.pm 100644 000765 000024 13211 12266317307 16025 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::Writer;
use strict;
use warnings;
use XML::Writer;
use Pod::WSDL::Utils ':writexml';
our $AUTOLOAD;
our $VERSION = "0.05";
our $INDENT_CHAR = "\t";
our $NL_CHAR = "\n";
sub new {
my ($pkg, %data) = @_;
$data{pretty} ||= 0;
$data{withDocumentation} ||= 0;
my $outStr = "";
my $me = bless {
_pretty => $data{pretty},
_withDocumentation => $data{withDocumentation},
_outStr => \$outStr,
_writer => undef,
_indent => 1,
_lastTag => '',
_faultMessageWritten => {},
_emptyMessageWritten => 0,
}, $pkg;
$me->prepare;
return $me;
}
sub wrNewLine {
my $me = shift;
my $cnt = shift;
$cnt ||= 1;
return unless $me->{_pretty};
$me->{_writer}->characters($NL_CHAR x $cnt);
}
sub wrElem {
my $me = shift;
my $type = shift;
if ($me->{_pretty}) {
if ($me->{_lastTag} eq $START_PREFIX_NAME and ($type eq $START_PREFIX_NAME or $type eq $EMPTY_PREFIX_NAME)) {
$me->{_indent}++;
} elsif ($me->{_lastTag} ne $START_PREFIX_NAME and $type eq $END_PREFIX_NAME) {
$me->{_indent}--;
}
$me->{_lastTag} = $type;
$me->{_writer}->characters($INDENT_CHAR x $me->{_indent});
}
$type .= 'Tag';
$me->{_writer}->$type(@_);
$me->wrNewLine;
}
sub wrDoc {
my $me = shift;
return unless $me->{_withDocumentation};
my $txt = shift;
my %args = @_;
my $useAnnotation = 0;
my $docTagName = "wsdl:documentation";
if (%args and $args{useAnnotation}) {
$useAnnotation = 1;
$docTagName = "documentation";
}
$txt ||= '';
$txt =~ s/\s+$//;
return unless $txt;
$me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty};
if ($useAnnotation) {
$me->{_writer}->startTag("annotation") ;
$me->wrNewLine;
$me->{_indent}++;
$me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty};
}
$me->{_writer}->startTag($docTagName);
$me->{_writer}->characters($txt);
$me->{_writer}->endTag($docTagName);
if ($useAnnotation) {
$me->wrNewLine;
$me->{_indent}--;
$me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty};
$me->{_writer}->endTag("annotation");
}
$me->wrNewLine;
}
sub output {
my $me = shift;
return ${$me->{_outStr}};
}
sub prepare {
my $me = shift;
${$me->{_outStr}} = "";
$me->{_emptyMessageWritten} = 0;
$me->{_writer} = new XML::Writer(OUTPUT => $me->{_outStr});
$me->{_writer}->xmlDecl("UTF-8");
}
sub withDocumentation {
my $me = shift;
my $arg = shift;
if (defined $arg) {
$me->{_withDocumentation} = $arg;
return $me;
} else {
return $me->{_withDocumentation};
}
}
sub pretty {
my $me = shift;
my $arg = shift;
if (defined $arg) {
$me->{_pretty} = $arg;
return $me;
} else {
return $me->{_pretty};
}
}
sub registerWrittenFaultMessage {
my $me = shift;
my $arg = shift;
return $me->{_faultMessageWritten}->{$arg} = 1;
}
sub faultMessageWritten {
my $me = shift;
my $arg = shift;
return $me->{_faultMessageWritten}->{$arg};
}
sub registerWrittenEmptyMessage {
my $me = shift;
return $me->{_emptyMessageWritten} = 1;
}
sub emptyMessageWritten {
my $me = shift;
return $me->{_emptyMessageWritten};
}
sub AUTOLOAD {
my $me = shift;
my $method = $AUTOLOAD;
$method =~ s/.*:://;
if ($method eq "DESTROY"){
return;
} else {
no strict 'refs';
$me->{_writer}->$method(@_);
}
}
1;
__END__
=head1 NAME
Pod::WSDL::Writer - Writes XML output for Pod::WSDL (internal use only)
=head1 SYNOPSIS
use Pod::WSDL::Writer;
my $wr = new Pod::WSDL::Writer(pretty => 1, withDocumentation => 1);
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. By using AUTOLOADing it delegates all unknown methods to XML::Writer. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
=head1 METHODS
=head2 new
Instantiates a new Pod::WSDL::Writer. The method can take two parameters C with a true value triggers pretty printing of the WSDL output. C with a true value produces a WSDL docuemnt containing documentation for types and methods.
=head2 wrNewLine
Has XML::Writer write a newline
=head2 wrElem
Has XML::Writer write an Element. The first argument is one of (empty|start|end), to write an empty element, a start or an end tag. The second argument signifies the name of the tag. All further arguments are attributes of the tag (does not work, when first argument is 'end')
=head2 wrDoc
Writes the string passed to the method as a Element
=head2 registerWrittenFaultMessage
There needs to be only one fault message per fault type. Here the client class can register fault types already written. The fault name is passed as the single argument to this method.
=head2 faultMessageWritten
Counterpart to registerWrittenFaultMessage. The client can ask if a fault message has already written. The fault name is passed as the single argument to this method.
=head2 output
Returns XML output.
=head1 EXTERNAL DEPENDENCIES
XML::Writer
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
11WSDL03operations.t 100644 000765 000024 12125 12266317307 15767 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Pod::WSDL;
use Test::More tests => 23;
BEGIN {use_ok('Pod::WSDL');}
use lib length $0 > 14 ? substr $0, 0, length($0) - 20 : '.';
use strict;
use warnings;
use XML::XPath;
my $p = new Pod::WSDL(source => 'My::OperationTest',
location => 'http://localhost/My/OperationTest',
pretty => 1,
withDocumentation => 1);
my $xmlOutput = $p->WSDL;
my $xp = XML::XPath->new(xml => $xmlOutput);
# test general structure
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testGeneralRequest"]'), 'Found message element "testGeneralRequest" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testGeneralRequest"]/wsdl:part[@name = "in" and @type = "xsd:string"]'), 'Found part element "in" for message "testGeneralRequest" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testGeneralResponse"]'), 'Found message element "testGeneralResponse" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testGeneralResponse"]/wsdl:part[@name = "testGeneralReturn" and @type = "xsd:string"]'), 'Found part element "testGeneralReturn" for message "testGeneralResponse" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:portType[@name = "MyOperationTestHandler"]'), 'Found portType element "MyOperationTestHandler" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:portType[@name = "MyOperationTestHandler"]/wsdl:operation[@name = "testGeneral" and @parameterOrder = "in"]'), 'Found operation element "testGeneral" in portType in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:portType[@name = "MyOperationTestHandler"]/wsdl:operation[@name = "testGeneral" and @parameterOrder = "in"]/wsdl:documentation[text() = "bla bla"]'), 'Found documentation for operation element "testGeneral".');
ok($xp->exists('/wsdl:definitions/wsdl:portType[@name = "MyOperationTestHandler"]/wsdl:operation[@name = "testGeneral" and @parameterOrder = "in"]/wsdl:input[@message = "impl:testGeneralRequest" and @name="testGeneralRequest"]'), 'Found input message for operation element "testGeneral".');
ok($xp->exists('/wsdl:definitions/wsdl:portType[@name = "MyOperationTestHandler"]/wsdl:operation[@name = "testGeneral" and @parameterOrder = "in"]/wsdl:output[@message = "impl:testGeneralResponse" and @name="testGeneralResponse"]'), 'Found output message for operation element "testGeneral".');
# test parameters: _IN, _OUT, _INOUT
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testInOutRequest"]/wsdl:part[@name = "in" and @type = "xsd:string"]'), 'Found part element "in" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testInOutRequest"]/wsdl:part[@name = "out" and @type = "xsd:string"]'), 'Found part element "out" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testInOutRequest"]/wsdl:part[@name = "inout" and @type = "xsd:string"]'), 'Found part element "inout" in xml output.');
# test faults
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "MyFoo"]'), 'Found message element "MyFoo" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "MyFoo"]/wsdl:part[@name = "fault" and @type = "tns1:MyFoo"]'), 'Found part element "fault" for message "MyFoo" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:portType[@name = "MyOperationTestHandler"]/wsdl:operation[@name = "testGeneral" and @parameterOrder = "in"]/wsdl:fault[@message = "impl:MyFoo" and @name="MyFoo"]'), 'Found fault message for operation element "testGeneral".');
# test arrays
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testArrayRequest"]/wsdl:part[@name = "in" and @type = "tns1:ArrayOfString"]'), 'Found correct part element "in" for message "testArrayRequest" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testArrayResponse"]/wsdl:part[@name = "testArrayReturn" and @type = "tns1:ArrayOfString"]'), 'Found correct part element "testArrayReturn" for message "testArrayResponse" in xml output.');
# test empty message
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "testOnewayRequest"]'), 'Found message element with name "testOnewayRequest" for message "testOneway" in xml output.');
# test oneway message
ok($xp->exists('/wsdl:definitions/wsdl:message[@name = "empty"]'), 'Found message element with name "empty" for message "testEmpty" in xml output.');
ok($xp->exists('/wsdl:definitions/wsdl:portType[@name = "MyOperationTestHandler"]/wsdl:operation[@name = "testOneway" and @parameterOrder = "in"]/wsdl:input[@message = "impl:testOnewayRequest" and @name="testOnewayRequest"]'), 'Found input message for operation element "testOneway".');
ok(!$xp->exists('/wsdl:definitions/wsdl:portType[@name = "MyOperationTestHandler"]/wsdl:operation[@name = "testOneway" and @parameterOrder = "in"]/wsdl:output'), 'Did not find output message (which is correct) for operation element "testOneway".');
# test method without wsdl pod
ok(!$xp->exists('/wsdl:definitions/wsdl:message[@name = "testWithoutPodRequest"]') && !$xp->exists('/wsdl:definitions/wsdl:message[@name = "testWithoutPodResponse"]'), 'Non pod messages not found xml output.');
print $xmlOutput; AUTOLOAD.pm 100644 000765 000024 6066 12266317307 15753 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/lib/Pod/WSDL package Pod::WSDL::AUTOLOAD;
use Carp;
use strict;
use warnings;
our $AUTOLOAD;
our $VERSION = "0.05";
sub AUTOLOAD {
my $me = shift;
my $param = shift;
my $fbd = ref($me) . '::FORBIDDEN_METHODS';
my $attr = $AUTOLOAD;
$attr =~ s/.*:://;
if (@_) {
croak ref $me . " received call to '$attr' with too many params (max 1). Call was '$attr($param, " . join (", ", @_) . ")'!";
}
if ($attr eq "DESTROY"){
return;
} elsif (exists $me->{'_' . $attr}) {
no strict 'refs';
if (defined $param) {
croak ref ($me) . " does not allow setting of '$attr', died" if (caller)[0] ne ref($me) and %$fbd and $fbd->{$attr} and !$fbd->{$attr}->{set};
$me->{'_' . $attr} = $param;
return $me;
} else {
croak ref ($me) . " does not allow getting of '$attr', died" if (caller)[0] ne ref($me) and %$fbd and $fbd->{$attr} and !$fbd->{$attr}->{get};
#if (ref $me->{'_' . $attr} eq 'ARRAY') {
# return @{$me->{'_' . $attr}};
#} elsif (ref $me->{'_' . $attr} eq 'HASH') {
# return %{$me->{'_' . $attr}};
#} elsif (ref $me->{'_' . $attr} eq 'SCALAR') {
# return ${$me->{'_' . $attr}};
#} else {
return $me->{'_' . $attr};
#}
}
} else {
croak "I have no method called '$attr()'!";
}
}
1;
__END__
=head1 NAME
Pod::WSDL::AUTOLOAD - Base class for autoloading (internal use only)
=head1 SYNOPSIS
package Foo;
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
sub new {
my $pgk = shift;
bless {
_bar => 'blah',
}, $pgk
}
package main;
use Foo;
my $foo = new Foo();
print $foo->bar; # prints 'blah'
$foo->bar('bloerch'); # sets _bar to 'bloerch'
=head1 DESCRIPTION
This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. The Pod::WSDL::AUTOLOADER is used as a base class and handels autoloading of accessor methods. If there is a property called _foo in a hash based blessed reference, it will allow the use of the method 'foo' as a getter and setter. As a getter is returns the value of _foo, as a setter it sets _foo with the argument and returns the object. You can exclude the accessor by using a hash %FORBIDDEN_METHODS in the derived class like that:
our %FORBIDDEN_METHODS = (
foo => {get => 1, set => 0},
bar => {get => 0, set => 0}
);
In this example it will not be allowed to set _foo and to set or get _bar. If the user of the object tries to do so, it croaks. From within the objects package every accessor is allowed.
=head1 METHODS
[none]
=head1 EXTERNAL DEPENDENCIES
Carp;
=head1 EXAMPLES
see Pod::WSDL
=head1 BUGS
see Pod::WSDL
=head1 TODO
see Pod::WSDL
=head1 SEE ALSO
Pod::WSDL :-)
=head1 AUTHOR
Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Tarek Ahmed
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut
01AUTOLOAD02forbiddenmethods.t 100644 000765 000024 2305 12266317307 17540 0 ustar 00bat staff 000000 000000 Pod-WSDL-0.062/t #!/usr/bin/perl -w
package Foo;
use Pod::WSDL::AUTOLOAD;
our @ISA = qw/Pod::WSDL::AUTOLOAD/;
our %FORBIDDEN_METHODS = (
bar => {get => 0, set => 0},
boerk => {get => 0, set => 1},
bloerch => {get => 1, set => 0},
boerps => {get => 1, set => 1},
);
sub new {
my $pgk = shift;
bless {
_bar => 'blah',
}, $pgk
}
sub miaow {
my $me = shift;
$me->bar;
$me->bar('br');
}
1;
package main;
use Test::More tests => 9;
no warnings;
my $foo = Foo->new;
eval {$foo->bar;};
ok($@, 'Both forbidden: Using getter croaks');
eval {$foo->bar('br');};
ok($@, 'Both forbidden: Using setter croaks');
eval {$foo->boerk;};
ok($@ == undef, 'Setter forbidden: Using getter does not croak');
eval {$foo->boerk('br');};
ok($@, 'Setter forbidden: Using setter croaks');
eval {$foo->bloerch;};
ok($@, 'Getter forbidden: Using getter croaks');
eval {$foo->bloerch('br');};
ok($@ == undef, 'Getter forbidden: Using setter does not croak');
eval {$foo->boeps;};
ok($@ == undef, 'Nothing forbidden: Using getter does not croak');
eval {$foo->boerps('br');};
ok($@ == undef, 'Nothing forbidden: Using setter does not croak');
eval{$foo->miaow};
ok($@ == undef, 'Calling accessors from within package does not croak');