import SOAP-WSDL 2.00_01 from CPAN
git-cpan-module: SOAP-WSDL git-cpan-version: 2.00_01 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_01.tar.gz
This commit is contained in:
Martin Kutter
committed by
Michael G. Schwern
Michael G. Schwern
parent
bfbf5e27e0
commit
6fe52c4370
@@ -0,0 +1,254 @@
|
||||
package SOAP::WSDL::XSD::ComplexType;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Class::Std::Storable;
|
||||
use Scalar::Util qw(blessed);
|
||||
use base qw/SOAP::WSDL::Base/;
|
||||
|
||||
my %annotation_of :ATTR(:name<annotation> :default<()>);
|
||||
my %element_of :ATTR(:name<element> :default<()>);
|
||||
my %flavor_of :ATTR(:name<flavor> :default<()>);
|
||||
my %base_of :ATTR(:name<base> :default<()>);
|
||||
my %itemType_of :ATTR(:name<itemType> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %abstract_of :ATTR(:name<abstract> :default<()>);
|
||||
# is set to simpleContent/complexContent
|
||||
my %content_Model_of :ATTR(:name<contentModel> :default<()>);
|
||||
|
||||
sub find_element {
|
||||
my ($self, @args) = @_;
|
||||
my @found_at = grep {
|
||||
$_->get_targetNamespace() eq $args[0] &&
|
||||
$_->get_name() eq $args[1]
|
||||
}
|
||||
@{ $element_of{ ident $self } };
|
||||
return $found_at[0];
|
||||
}
|
||||
|
||||
sub push_element {
|
||||
my $self = shift;
|
||||
my $element = shift;
|
||||
if ($flavor_of{ ident $self } eq 'all')
|
||||
{
|
||||
$element->set_minOccurs(0) if not defined ($element->get_minOccurs);
|
||||
$element->set_maxOccurs(1) if not defined ($element->get_maxOccurs);
|
||||
}
|
||||
elsif ($flavor_of{ ident $self } eq 'sequence')
|
||||
{
|
||||
$element->set_minOccurs(1) if not defined ($element->get_minOccurs);
|
||||
$element->set_maxOccurs(1) if not defined ($element->get_maxOccurs);
|
||||
}
|
||||
push @{ $element_of{ ident $self } }, $element;
|
||||
}
|
||||
|
||||
sub set_restriction {
|
||||
my $self = shift;
|
||||
my $element = shift;
|
||||
$flavor_of{ ident $self } = 'restriction';
|
||||
$base_of{ ident $self } = $element->{ Value };
|
||||
}
|
||||
|
||||
|
||||
sub init {
|
||||
my $self = shift;
|
||||
my @args = @_;
|
||||
$self->SUPER::init( @args );
|
||||
}
|
||||
|
||||
sub serialize
|
||||
{
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
|
||||
$opt->{ indent } ||= q{};
|
||||
my $flavor = $self->get_flavor();
|
||||
my $xml = '';
|
||||
|
||||
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
|
||||
$xml .= "<$name";
|
||||
if ( $opt->{ autotype })
|
||||
{
|
||||
my $ns = $self->get_targetNamespace();
|
||||
my $prefix = $opt->{ namespace }->{ $ns }
|
||||
|| die 'No prefix found for namespace '. $ns;
|
||||
$xml .= join q{}, " type=\"$prefix:", $self->get_name(), '"'
|
||||
if ($self->get_name() );
|
||||
}
|
||||
$xml .= '>';
|
||||
$xml .= "\n" if ( $opt->{ readable } ); # add linebreak
|
||||
if ( ($flavor eq "sequence") or ($flavor eq "all") )
|
||||
{
|
||||
$opt->{ indent } .= "\t";
|
||||
for my $element (@{ $self->get_element() })
|
||||
{
|
||||
# might be list - listify
|
||||
$value = [ $value ] if not ref $value eq 'ARRAY';
|
||||
|
||||
for my $single_value (@{ $value }) {
|
||||
my $element_value;
|
||||
if (blessed $single_value) {
|
||||
my $method = 'get_' . $element->get_name();
|
||||
$element_value = $single_value->$method();
|
||||
}
|
||||
else {
|
||||
$element_value = $single_value->{ $element->get_name() }
|
||||
}
|
||||
$element_value = [ $element_value ]
|
||||
if not ref $element_value eq 'ARRAY';
|
||||
|
||||
$xml .= join q{}
|
||||
, map { $element->serialize( undef, $_, $opt ) }
|
||||
@{ $element_value };
|
||||
}
|
||||
}
|
||||
$opt->{ indent } =~s/\t$//;
|
||||
}
|
||||
else
|
||||
{
|
||||
die "sorry, we just handle all and sequence types yet...";
|
||||
}
|
||||
$xml .= $opt->{ indent } if ( $opt->{ readable } ); # add indentation
|
||||
$xml .= '</' . $name . '>';
|
||||
$xml .= "\n" if ($opt->{ readable } ); # add linebreak
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub explain
|
||||
{
|
||||
my ($self, $opt, $name ) = @_;
|
||||
my $flavor = $self->get_flavor();
|
||||
my $xml = '';
|
||||
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
|
||||
$xml .= q{'} . $name . q{' => };
|
||||
|
||||
return q{} if not $flavor; # empty complexType
|
||||
|
||||
if ( ($flavor eq "sequence") or ($flavor eq "all") )
|
||||
{
|
||||
$xml .= "{\n";
|
||||
$opt->{ indent } .= "\t";
|
||||
$xml .= join q{}, map { $_->explain( $opt ) }
|
||||
@{ $self->get_element() };
|
||||
$opt->{ indent } =~s/\t$//; # step back
|
||||
$xml .= $opt->{ indent } . "},\n";
|
||||
}
|
||||
elsif ($flavor eq "complexContent")
|
||||
{
|
||||
|
||||
}
|
||||
elsif ($flavor eq "simpleContent")
|
||||
{
|
||||
|
||||
}
|
||||
else
|
||||
{
|
||||
warn "unknown complexType definition $flavor";
|
||||
}
|
||||
$xml .= "\n" if ($opt->{ readable } ); # add linebreak
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my ($self, $opt, $name ) = @_;
|
||||
my $flavor = $self->get_flavor();
|
||||
my $txt;
|
||||
return q{} if not $flavor; # empty complexType
|
||||
|
||||
my %nsmap = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
|
||||
if ( ($flavor eq "sequence") or ($flavor eq "all") )
|
||||
{
|
||||
for my $element (@{ $self->get_element() }) {
|
||||
$txt .= $element->to_typemap( $opt );
|
||||
}
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
|
||||
my $template = <<'EOT';
|
||||
package [% class_prefix %]::[% self.get_name %];
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType
|
||||
);
|
||||
|
||||
[% FOREACH element=self.get_element -%]
|
||||
my %[% element.get_name %]_of :ATTR(:get<[% element.get_name %]>);
|
||||
[% END %]
|
||||
|
||||
__PACKAGE__->_factory(
|
||||
[ qw([% FOREACH element=self.get_element -%]
|
||||
[% element.get_name %]
|
||||
[% END %]) ],
|
||||
{
|
||||
[% FOREACH element=self.get_element %] [% element.get_name %] => \%[% element.get_name %]_of,
|
||||
[% END %]
|
||||
},
|
||||
{
|
||||
[%- FOREACH element=self.get_element;
|
||||
split_name = element.get_type.split(':');
|
||||
prefix = split_name.0;
|
||||
localname = split_name.1;
|
||||
IF nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema' -%]
|
||||
[% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% localname %]',
|
||||
[% ELSE %]
|
||||
[% element.get_name %] => '[% class_prefix %]::[% localname %]',
|
||||
[%- END;
|
||||
END %]
|
||||
}
|
||||
);
|
||||
|
||||
sub get_xmlns { '[% self.get_targetNamespace %]' }
|
||||
|
||||
1;
|
||||
EOT
|
||||
|
||||
$opt->{ base_path } ||= '.';
|
||||
|
||||
require Template;
|
||||
my $tt = Template->new(
|
||||
RELATIVE => 1,
|
||||
);
|
||||
my $code = $tt->process( \$template, {
|
||||
class_prefix => $opt->{ prefix },
|
||||
self => $self,
|
||||
nsmap => { reverse %{ $opt->{ wsdl }->get_xmlns() } },
|
||||
},
|
||||
$opt->{ output },
|
||||
) or die $tt->error();
|
||||
}
|
||||
|
||||
sub _check_value {
|
||||
my $self = shift;
|
||||
}
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * attribute definitions
|
||||
|
||||
Attribute definitions are ignored
|
||||
|
||||
=item * abstract, block, final, mixed
|
||||
|
||||
Handling of these attribute is not implemented yet.
|
||||
|
||||
=item * simpleContent, complexContent, extension, restriction, group, choice
|
||||
|
||||
Handling of these child elements is not implemented yet
|
||||
|
||||
=item * explain may produce erroneous results
|
||||
|
||||
=over
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,348 @@
|
||||
package SOAP::WSDL::XSD::Element;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %simpleType_of :ATTR(:name<simpleType> :default<()>);
|
||||
my %complexType_of :ATTR(:name<complexType> :default<()>);
|
||||
my %facet_of :ATTR(:name<facet> :default<()>);
|
||||
my %type_of :ATTR(:name<type> :default<()>);
|
||||
my %abstract_of :ATTR(:name<abstract> :default<()>);
|
||||
my %block_of :ATTR(:name<block> :default<()>);
|
||||
my %default_of :ATTR(:name<default> :default<()>);
|
||||
my %final_of :ATTR(:name<final> :default<()>);
|
||||
my %fixed_of :ATTR(:name<fixed> :default<()>);
|
||||
my %form_of :ATTR(:name<form> :default<()>);
|
||||
my %maxOccurs_of :ATTR(:name<maxOccurs> :default<()>);
|
||||
my %minOccurs_of :ATTR(:name<minOccurs> :default<()>);
|
||||
my %nillable_of :ATTR(:name<nillable> :default<()>);
|
||||
my %ref_of :ATTR(:name<ref> :default<()>);
|
||||
my %substitutionGroup_of :ATTR(:name<substitutionGroup> :default<()>);
|
||||
|
||||
sub first_type {
|
||||
my $result_ref = $complexType_of{ ident shift };
|
||||
return if not $result_ref;
|
||||
return $result_ref if (not ref $result_ref eq 'ARRAY');
|
||||
return $result_ref->[0];
|
||||
}
|
||||
|
||||
sub first_simpleType {
|
||||
my $result_ref = $simpleType_of{ ident shift };
|
||||
return if not $result_ref;
|
||||
return $result_ref if (not ref $result_ref eq 'ARRAY');
|
||||
return $result_ref->[0];
|
||||
}
|
||||
|
||||
sub first_complexType {
|
||||
my $result_ref = $complexType_of{ ident shift };
|
||||
return if not $result_ref;
|
||||
return $result_ref if (not ref $result_ref eq 'ARRAY');
|
||||
return $result_ref->[0];
|
||||
}
|
||||
|
||||
# serialize type instead...
|
||||
sub serialize
|
||||
{
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
my $type;
|
||||
my $typelib = $opt->{ typelib };
|
||||
my %ns_map = reverse %{ $opt->{ namespace } };
|
||||
my $ident = ident $self;
|
||||
|
||||
# abstract elements may only be serialized via ref - and then we have a
|
||||
# name...
|
||||
die "cannot serialize abstract element" if $abstract_of{ $ident }
|
||||
and not $name;
|
||||
|
||||
# TODO: implement final and substitutionGroup - maybe never implement
|
||||
# substitutionGroup ?
|
||||
|
||||
$name ||= $self->get_name();
|
||||
|
||||
# set default and fixed - fixed overrides everything,
|
||||
# default only empty (undefined) values
|
||||
if (not defined $value) {
|
||||
$value = $default_of{ ident $self } if $default_of{ ident $self };
|
||||
}
|
||||
$value = $fixed_of{ ident $self } if $fixed_of{ ident $self };
|
||||
|
||||
# TODO check nillable and serialize empty data correctly
|
||||
|
||||
# return if minOccurs is 0 and we have no value
|
||||
if (defined $minOccurs_of{ ident $self }
|
||||
and $minOccurs_of{ ident $self } == 0) {
|
||||
return q{} if not defined $value;
|
||||
}
|
||||
|
||||
# handle direct simpleType and complexType here
|
||||
if ($type = $self->first_simpleType() ) { # simpleType
|
||||
return $type->serialize( $name, $value, $opt );
|
||||
}
|
||||
elsif ($type = $self->first_complexType() ) { # complexType
|
||||
return $type->serialize( $name, $value, $opt );
|
||||
}
|
||||
elsif (my $ref_name = $ref_of{ $ident }) { # ref
|
||||
my ($prefix, $localname) = split /:/ , $ref_name;
|
||||
my $ns = $ns_map{ $prefix };
|
||||
$type = $typelib->find_type( $ns, $localname );
|
||||
die "no type for $prefix:$localname" if (not $type);
|
||||
return $type->serialize( $self->get_name(), $value, $opt );
|
||||
}
|
||||
|
||||
# lookup type
|
||||
my ($prefix, $localname) = split /:/ , $self->get_type();
|
||||
my $ns = $ns_map{ $prefix };
|
||||
$type = $typelib->find_type(
|
||||
$ns, $localname
|
||||
);
|
||||
|
||||
# safety check
|
||||
die "no type for $prefix:$localname $ns_map{$prefix}" if (not $type);
|
||||
|
||||
return $type->serialize( $self->get_name(), $value, $opt );
|
||||
}
|
||||
|
||||
sub explain
|
||||
{
|
||||
my ($self, $opt, $name) = @_;
|
||||
my $type;
|
||||
my $text = q{};
|
||||
|
||||
# if we have a simple / complexType, explain right here
|
||||
if ($type = $self->first_simpleType() )
|
||||
{
|
||||
$text .= $type->explain( $opt, $self->get_name() );
|
||||
}
|
||||
elsif ($type = $self->first_complexType() )
|
||||
{
|
||||
$text .= $type->explain( $opt, $self->get_name() )
|
||||
}
|
||||
|
||||
# return if it's not a derived type - we don't handle
|
||||
# other stuff yet.
|
||||
return $text if (not $self->get_type() );
|
||||
|
||||
# if we have a derived type, fetch type and explain
|
||||
my ($prefix, $localname) = split /:/ , $self->get_type();
|
||||
my %ns_map = reverse %{ $opt->{ namespace } };
|
||||
my $ns = $ns_map{ $prefix };
|
||||
|
||||
$type = $opt->{ wsdl }->first_types()->find_type(
|
||||
$ns, $localname
|
||||
);
|
||||
|
||||
die "no type for $prefix:$localname ($ns)" if (not $type);
|
||||
|
||||
return $text .= $type->explain( $opt, $self->get_name() );
|
||||
return 'ERROR: '. $@;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
|
||||
my ($self, $opt) = @_;
|
||||
my $txt = q{};
|
||||
|
||||
my %nsmap = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
|
||||
my $type;
|
||||
push @{ $opt->{path} }, $self->get_name();
|
||||
if ( my $typename = $self->get_type() ) {
|
||||
my ($prefix, $localname) = split /:/, $self->get_type();
|
||||
my $ns = $nsmap{ $prefix };
|
||||
my $typeclass;
|
||||
|
||||
# builtin type
|
||||
if ( $nsmap{ $prefix } eq 'http://www.w3.org/2001/XMLSchema') {
|
||||
$typeclass = "SOAP::WSDL::XSD::Typelib::Builtin::$localname";
|
||||
}
|
||||
else
|
||||
{
|
||||
$type = $opt->{ wsdl }->first_types()->find_type( $ns, $localname );
|
||||
$typeclass = $opt->{ prefix } . $type->get_name();
|
||||
$txt .= $type->to_typemap($opt);
|
||||
}
|
||||
$txt .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n";
|
||||
}
|
||||
elsif ($type = $self->first_simpleType() ) {
|
||||
my $flavor = $type->get_flavor();
|
||||
if ( $flavor eq 'sequence' ) {
|
||||
$txt .= "# atomic simple type (sequence)\n";
|
||||
$txt .= $type->to_typemap($opt). "\n";
|
||||
$txt .= "# end atomic simple type (sequence)\n";
|
||||
}
|
||||
elsif ( $flavor eq 'all' ) {
|
||||
$txt .= "# atomic simple type (all)\n";
|
||||
$txt .= $type->to_typemap($opt). "\n";
|
||||
$txt .= "# end atomic simple type (all)\n";
|
||||
}
|
||||
|
||||
}
|
||||
elsif ($type = $self->first_complexType() ) {
|
||||
my $typeclass = $opt->{ prefix } . $self->get_name();
|
||||
$txt .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n";
|
||||
my $flavor = $type->get_flavor();
|
||||
if ( $flavor eq 'sequence' ) {
|
||||
$txt .= "# atomic complex type (sequence)\n";
|
||||
$txt .= $type->to_typemap($opt). "\n";;
|
||||
$txt .= "# end atomic complex type (sequence)\n";
|
||||
}
|
||||
elsif ( $flavor eq 'all' ) {
|
||||
$txt .= "# atomic complex type (all)\n";
|
||||
$txt .= $type->to_typemap($opt). "\n";
|
||||
$txt .= "# end atomic complex type (all)\n";
|
||||
}
|
||||
}
|
||||
pop @{ $opt->{ path } };
|
||||
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
|
||||
my $template = <<'EOT';
|
||||
package [% class_prefix %]::[% self.get_name %];
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Element;
|
||||
[% IF (type = self.first_simpleType) %]
|
||||
# <element name="[% self.get_name %]"><simpleType> definition
|
||||
use SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType
|
||||
[% type.flavor_class %]
|
||||
[% type.base_class($class_prefix) %]
|
||||
);
|
||||
[% ELSIF (type = self.first_complexType) %]
|
||||
# <element name="[% self.get_name %]"><complexType> definition
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType
|
||||
);
|
||||
|
||||
[% FOREACH element = type.get_element %]
|
||||
my %[% element.get_name %]_of :ATTR(get:<[% element.get_name %]>);
|
||||
[% END %]
|
||||
|
||||
__PACKAGE__->_factory(
|
||||
[ qw([% FOREACH element = type.get_element %]
|
||||
[% element.get_name %]
|
||||
[% END %]) ],
|
||||
{
|
||||
[% FOREACH element = type.get_element %] [% element.get_name %] => \%[% element.get_name %]_of,
|
||||
[% END %]
|
||||
},
|
||||
{
|
||||
[% FOREACH element = type.get_element;
|
||||
split_name = element.get_type.split(':');
|
||||
prefix = split_name.0;
|
||||
localname = split_name.1;
|
||||
IF nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema' %]
|
||||
[% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% localname %]',
|
||||
[% ELSE %]
|
||||
[% element.get_name %] => '[% class_prefix %]::[% localname %]',
|
||||
[% END %]
|
||||
[% END %]
|
||||
}
|
||||
);
|
||||
[%# END complexType %]
|
||||
[% ELSIF (type = self.get_type) %]
|
||||
# <element name="[% self.get_name %]" type="[% self.get_type %]"/> definition
|
||||
[% (typename = self.get_type);
|
||||
split_name = element.type.split(':');
|
||||
prefix = split_name.0;
|
||||
localname = split_name.1;
|
||||
-%]
|
||||
[% IF (nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema');
|
||||
base_class = 'SOAP::WSDL::XSD::Typelib::Builtin::' _ localname ;
|
||||
ELSE;
|
||||
base_class = class_prefix _ '::' _ localname;
|
||||
-%]
|
||||
|
||||
use [% base_class %];
|
||||
[% END %]
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
[% base_class %]
|
||||
);
|
||||
[% ELSIF (element = self.get_ref)
|
||||
%]
|
||||
# element ref"element" definition
|
||||
# Sorry, we don't handle this yet...
|
||||
[% END %]
|
||||
|
||||
sub get_xmlns { '[% self.get_targetNamespace %]' }
|
||||
|
||||
__PACKAGE__->__set_name('[% self.get_name %]');
|
||||
__PACKAGE__->__set_nillable([% self.get_nillable %]);
|
||||
__PACKAGE__->__set_minOccurs([% self.get_minOccurs %]);
|
||||
__PACKAGE__->__set_maxOccurs([% self.get_maxOccurs %]);
|
||||
__PACKAGE__->__set_ref('[% self.get_ref %]');
|
||||
|
||||
1;
|
||||
EOT
|
||||
|
||||
require Template;
|
||||
my $tt = Template->new(
|
||||
RELATIVE => 1,
|
||||
);
|
||||
my $code = $tt->process( \$template, {
|
||||
class_prefix => $opt->{ prefix },
|
||||
self => $self,
|
||||
nsmap => { reverse %{ $opt->{ wsdl }->get_xmlns() } },
|
||||
},
|
||||
$opt->{ output },
|
||||
)
|
||||
or die $tt->error();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Element - XSD Element representation
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Represents a XML Schema Definition's Element element for serializing into
|
||||
various forms.
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * block
|
||||
|
||||
Handling of the block attribute is not implemented yet.
|
||||
|
||||
=item * final
|
||||
|
||||
Handling of the final attribute is not implemented yet.
|
||||
|
||||
=item * substitutionGroup
|
||||
|
||||
Handling of the substitutionGroup attribute is not implemented yet
|
||||
|
||||
=item * explain may produce erroneous results
|
||||
|
||||
=over
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This module is part of SOAP-WSDL. See SOAP::WSDL for license.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Insert @ instead of whitespace into e-mail.
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,53 @@
|
||||
package SOAP::WSDL::XSD::Primitive;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
use Data::Dumper;
|
||||
|
||||
sub serialize
|
||||
{
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
my $xml;
|
||||
$opt->{ indent } ||= "";
|
||||
$xml .= $opt->{ indent } if ($opt->{ readable });
|
||||
$xml .= '<' . $name;
|
||||
if ( $opt->{ autotype })
|
||||
{
|
||||
my $ns = $self->get_targetNamespace();
|
||||
my $prefix = $opt->{ namespace }->{ $ns }
|
||||
|| die 'No prefix found for namespace '. $ns;
|
||||
$xml .= ' type="' . $prefix . ':'
|
||||
. $self->get_name() . '"' if ($self->get_name() );
|
||||
}
|
||||
|
||||
if (defined $value)
|
||||
{
|
||||
$xml .= '>';
|
||||
$xml .= "$value";
|
||||
$xml .= '</' . $name . '>' ;
|
||||
}
|
||||
else
|
||||
{
|
||||
$xml .= '/>';
|
||||
}
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub explain
|
||||
{
|
||||
my ($self, $opt, $name ) = @_;
|
||||
my $perl;
|
||||
$opt->{ indent } ||= "";
|
||||
$perl .= $opt->{ indent } if ($opt->{ readable });
|
||||
|
||||
$perl .= q{'} . $name . q{' => $someValue };
|
||||
$perl .= "\n" if ($opt->{ readable });
|
||||
return $perl;
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
warn "# primitive";
|
||||
}
|
||||
1;
|
||||
@@ -0,0 +1,72 @@
|
||||
package SOAP::WSDL::XSD::Schema;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
# child elements
|
||||
my %type_of :ATTR(:name<type> :default<[]>);
|
||||
my %element_of :ATTR(:name<element> :default<[]>);
|
||||
|
||||
# attributes
|
||||
my %attributeFormDefault_of :ATTR(:name<attributeFormDefault> :default<()>);
|
||||
my %blockDefault_of :ATTR(:name<blockDefault> :default<()>);
|
||||
my %elementFormDefault_of :ATTR(:name<elementFormDefault> :default<()>);
|
||||
my %finalDefault_of :ATTR(:name<finalDefault> :default<()>);
|
||||
my %version_of :ATTR(:name<version> :default<()>);
|
||||
|
||||
# id
|
||||
# name
|
||||
# targetNamespace inherited from Base
|
||||
# xmlns
|
||||
|
||||
#
|
||||
# attributeFormDefault = (qualified | unqualified) : unqualified
|
||||
# blockDefault = (#all | List of (extension | restriction | substitution)) : ''
|
||||
# elementFormDefault = (qualified | unqualified) : unqualified
|
||||
# finalDefault = (#all | List of (extension | restriction | list | union)) : ''
|
||||
# id = ID
|
||||
# targetNamespace = anyURI
|
||||
# version = token
|
||||
# xml:lang = language
|
||||
#
|
||||
#
|
||||
# alias type with all variants
|
||||
# AUTOMETHOD is WAY too slow..
|
||||
{
|
||||
no strict qw/refs/;
|
||||
for my $name (qw(simpleType complexType) ) {
|
||||
*{ "set_$name" } = \&set_type;
|
||||
*{ "get_$name" } = \&get_type;
|
||||
*{ "push_$name" } = \&push_type;
|
||||
*{ "find_$name" } = \&find_type;
|
||||
}
|
||||
}
|
||||
|
||||
sub push_type {
|
||||
# use $_[n] for performance -
|
||||
# we're called on each and every type inside WSDL
|
||||
push @{ $type_of{ ident $_[0]} }, $_[1];
|
||||
}
|
||||
|
||||
sub find_element {
|
||||
my ($self, @args) = @_;
|
||||
my @found_at = grep {
|
||||
$_->get_targetNamespace() eq $args[0] &&
|
||||
$_->get_name() eq $args[1]
|
||||
}
|
||||
@{ $element_of{ ident $self } };
|
||||
return $found_at[0];
|
||||
}
|
||||
|
||||
sub find_type {
|
||||
my ($self, @args) = @_;
|
||||
my @found_at = grep {
|
||||
$_->get_targetNamespace() eq $args[0] &&
|
||||
$_->get_name() eq $args[1]
|
||||
}
|
||||
@{ $type_of{ ident $self } };
|
||||
return $found_at[0];
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,64 @@
|
||||
package SOAP::WSDL::XSD::Schema::Builtin;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Schema;
|
||||
use SOAP::WSDL::XSD::Primitive;
|
||||
use base qw(SOAP::WSDL::XSD::Schema);
|
||||
|
||||
# all builtin types - add validation (e.g. content restrictions) later...
|
||||
my %PRIMITIVES = (
|
||||
'string' => {},
|
||||
'boolean' => {},
|
||||
'decimal' => {},
|
||||
'dateTime' => {},
|
||||
'float' => {},
|
||||
'double' => {},
|
||||
'duration' => {},
|
||||
'time' => {},
|
||||
'date' => {},
|
||||
'gYearMonth' => {},
|
||||
'gYear' => {},
|
||||
'gMonthDay' => {},
|
||||
'gDay' => {},
|
||||
'gMonth' => {},
|
||||
'hexBinary' => {},
|
||||
'base64Binary' => {},
|
||||
'anyURI' => {},
|
||||
'QName' => {},
|
||||
'NOTATION' => {},
|
||||
'integer' => {},
|
||||
'non-positive-integer' => {},
|
||||
'non-negative-integer' => {},
|
||||
'positiveInteger' => {},
|
||||
'negativeInteger' => {},
|
||||
'long' => {},
|
||||
'int' => {},
|
||||
'unsignedInt' => {},
|
||||
'short' => {},
|
||||
'unsignedShort' => {},
|
||||
'byte' => {},
|
||||
'unsignedByte' => {},
|
||||
'normalizedString' => {},
|
||||
'token' => {},
|
||||
'NMTOKEN' => {},
|
||||
);
|
||||
|
||||
# TODO place into appropriate schema and push on schema definitions list
|
||||
# in types
|
||||
sub START {
|
||||
my $self = shift;
|
||||
my @args = @_;
|
||||
|
||||
while (my ($name, $value) = each %PRIMITIVES )
|
||||
{
|
||||
$self->push_type( SOAP::WSDL::XSD::Primitive->new({
|
||||
name => $name,
|
||||
targetNamespace => 'http://www.w3.org/2001/XMLSchema',
|
||||
} )
|
||||
);
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,178 @@
|
||||
package SOAP::WSDL::XSD::SimpleType;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %base_of :ATTR(:name<base> :default<()>);
|
||||
my %flavor_of :ATTR(:name<flavor> :default<()>);
|
||||
my %itemType_of :ATTR(:name<itemType> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
# is set to simpleContent/complexContent
|
||||
my %content_Model_of :ATTR(:name<contentModel> :default<()>);
|
||||
|
||||
sub set_restriction {
|
||||
my $self = shift;
|
||||
my @attributes = @_;
|
||||
$self->set_flavor( 'restriction' );
|
||||
foreach my $attr (@attributes)
|
||||
{
|
||||
next if (not $attr->{ LocalName } eq 'restriction');
|
||||
$self->base( $attr->{ Value } );
|
||||
}
|
||||
}
|
||||
|
||||
sub set_list {
|
||||
my $self = shift;
|
||||
my @attributes = @_;
|
||||
$self->set_flavor( 'list' );
|
||||
foreach my $attr (@attributes)
|
||||
{
|
||||
next if (not $attr->{ LocalName } eq 'list');
|
||||
$self->set_base( $attr->{ Value } );
|
||||
}
|
||||
}
|
||||
|
||||
sub set_union {
|
||||
my $self = shift;
|
||||
my @attributes = @_;
|
||||
$self->set_flavor( 'union' );
|
||||
foreach my $attr (@attributes)
|
||||
{
|
||||
next if (not $attr->{ LocalName } eq 'memberTypes');
|
||||
$self->set_base( [ split /\s/, $attr->{ Value } ] );
|
||||
}
|
||||
}
|
||||
|
||||
sub push_enumeration
|
||||
{
|
||||
my $self = shift;
|
||||
my @attr = @_;
|
||||
my @attributes = @_;
|
||||
$self->set_flavor( 'enumeration' );
|
||||
foreach my $attr (@attributes)
|
||||
{
|
||||
next if (not $attr->{ LocalName } eq 'value');
|
||||
push @{ $enumeration_of{ ident $self } }, $attr->{ 'Value' };
|
||||
}
|
||||
}
|
||||
|
||||
sub serialize
|
||||
{
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $value = shift;
|
||||
my $opt = shift;
|
||||
my $ident = ident $self;
|
||||
$self->_check_value( $value );
|
||||
|
||||
return $self->_serialize_single($name, $value , $opt)
|
||||
if ( $flavor_of{ $ident } eq 'restriction'
|
||||
or $flavor_of{ $ident } eq 'union'
|
||||
or $flavor_of{ $ident } eq 'enumeration');
|
||||
|
||||
if ($flavor_of{ $ident } eq 'list' )
|
||||
{
|
||||
$value ||= [];
|
||||
$value = [ $value ] if ( ref( $value) ne 'ARRAY' );
|
||||
return $self->_serialize_single($name, join( q{ }, @{ $value } ), $opt);
|
||||
}
|
||||
}
|
||||
|
||||
sub _serialize_single
|
||||
{
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
my $xml = '';
|
||||
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
|
||||
$xml .= '<' . $name;
|
||||
if ( $opt->{ autotype })
|
||||
{
|
||||
my $ns = $self->get_targetNamespace();
|
||||
my $prefix = $opt->{ namespace }->{ $ns }
|
||||
|| die 'No prefix found for namespace '. $ns;
|
||||
$xml .= ' type="' . $prefix . ':'
|
||||
. $self->get_name() .'"';
|
||||
}
|
||||
$xml .= '>';
|
||||
$xml .= $value;
|
||||
$xml .= '</' . $name . '>' ;
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub explain
|
||||
{
|
||||
my ($self, $opt, $name) = @_;
|
||||
my $perl;
|
||||
$opt->{ indent } ||= "";
|
||||
$perl .= $opt->{ indent } if ($opt->{ readable });
|
||||
$perl .= q{'} . $name . q{' => $someValue };
|
||||
$perl .= "\n" if ($opt->{ readable });
|
||||
return $perl;
|
||||
}
|
||||
|
||||
sub _check_value {
|
||||
my $self = shift;
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $class_prefix = $opt->{ prefix };
|
||||
my $name = $opt->{name} || $self->get_name();
|
||||
my $flavor = $self->get_flavor() eq 'list'
|
||||
? 'SOAP::WSDL::XSD::Typelib::Builtin::list'
|
||||
: $self->get_flavor() eq 'restriction'
|
||||
? 'SOAP::WSDL::XSD::Typelib::SimpleType::restriction'
|
||||
: q{};
|
||||
my $base = $self->get_base();
|
||||
my $targetNamespace = $self->get_targetNamespace;
|
||||
my ($prefix, $localname) = split /:/, $base;
|
||||
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
$base = ($ns_map{ $prefix} eq 'http://www.w3.org/2001/XMLSchema')
|
||||
? "SOAP::WSDL::XSD::Typelib::Builtin::$localname"
|
||||
: "$opt->{prefix}::$localname";
|
||||
|
||||
my $code =<<"EOT";
|
||||
package $class_prefix::$name;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType
|
||||
$flavor
|
||||
$base
|
||||
);
|
||||
|
||||
1;
|
||||
|
||||
sub get_xmlns { '$targetNamespace' }
|
||||
|
||||
EOT
|
||||
|
||||
return $code;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * simpleContent, complexContent
|
||||
|
||||
These child elements are not implemented yet
|
||||
|
||||
=item * union
|
||||
|
||||
union simpleType definitions probalbly serialize wrong
|
||||
|
||||
=item * explain may produce erroneous results
|
||||
|
||||
=over
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,514 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
# derivation classes first...
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::list;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
sub serialize {
|
||||
my ($self, $opt) = @_;
|
||||
my $value = $self->get_value();
|
||||
return $self->start_tag({ %$opt, nil => 1 }) if not defined $value;
|
||||
$value = [ $value ] if not ref $value;
|
||||
return join q{}, $self->start_tag($opt, $value)
|
||||
, join( q{ }, @{ $value } )
|
||||
, $self->end_tag($opt, $value);
|
||||
}
|
||||
|
||||
# Builtin classes
|
||||
# Every XML schema type inherits from anyType...
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::anyType;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
sub start_tag {
|
||||
my ($self, $opt) = @_;
|
||||
$opt ||= {};
|
||||
return '<' . $opt->{name} . ' >' if $opt->{ name };
|
||||
return q{}
|
||||
}
|
||||
sub end_tag {
|
||||
my ($self, $opt) = @_;
|
||||
$opt ||= {};
|
||||
return '</' . $opt->{name} . ' >' if $opt->{ name };
|
||||
return q{}
|
||||
};
|
||||
|
||||
sub serialize_qualified :STRINGIFY {
|
||||
return $_[0]->serialize( { qualified => 1 } );
|
||||
}
|
||||
|
||||
# All builtin and all simpleType types inherit from anySimpleType
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
|
||||
|
||||
my %value_of :ATTR(:name<value> :default<()>);
|
||||
|
||||
sub serialize {
|
||||
my ($self, $opt) = @_;
|
||||
my $ident = ident $self;
|
||||
$opt ||= {};
|
||||
return $self->start_tag({ %$opt, nil => 1})
|
||||
if not defined $value_of{ $ident };
|
||||
return join q{}, $self->start_tag($opt, $value_of{ $ident })
|
||||
, $value_of{ $ident }
|
||||
, $self->end_tag($opt);
|
||||
}
|
||||
|
||||
sub as_bool :BOOLIFY {
|
||||
return $value_of { ident $_[0] };
|
||||
}
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::dateTime;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::duration;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::date;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::time;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gYear;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gMonth;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gDay;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::boolean;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
sub serialize {
|
||||
my ($self, $opt) = @_;
|
||||
my $ident = ident $self;
|
||||
$opt ||= {};
|
||||
return $self->start_tag({ %$opt, nil => 1})
|
||||
if not defined $value_of{ $ident };
|
||||
return join q{}
|
||||
, $self->start_tag($opt)
|
||||
, $value_of{ $ident } ? 'true' : 'false'
|
||||
, $self->end_tag($opt);
|
||||
}
|
||||
|
||||
sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
sub set_value {
|
||||
my ($self, $value) = @_;
|
||||
$value_of{ ident $self } = defined $value
|
||||
? ($value ne 'false' or ($value))
|
||||
? 1 : 0
|
||||
: 0;
|
||||
}
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::string;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::normalizedString;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::string);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::token;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::normalizedString);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::language;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::Name;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::NCName;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::Name);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::ID;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::IDREF;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::ID);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::IDREFS;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::IDREF);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::ENTITY;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::NMTOKENS;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::token);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::decimal;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
sub as_num :NUMERIFY :BOOLIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::base64Binary;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::hex64Binary;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::float;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::double;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::anyURI;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::qName;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::NOTATION;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::integer;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::decimal);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::long;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::int;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::long);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::short;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::int);
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::byte;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::short);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin - Built-in XML Schema datatypes
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module implements all builtin Types from the XML schema specification.
|
||||
|
||||
Objects of a class may be filled with values and serialize correctly.
|
||||
|
||||
These basic type classes are most useful when used as element or simpleType
|
||||
base classes.
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
my $bool = SOAP::WSDL::XSD::Typelib::Builtin::bool->new({ value => 0} );
|
||||
print $bool; # prints "true"
|
||||
|
||||
# implements <simpleType name="MySimpleType">
|
||||
# <list itemType="xsd:string" />
|
||||
# </simpleType>
|
||||
package MySimpleType;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::SimpleType
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::string
|
||||
);
|
||||
1;
|
||||
|
||||
# somewhere else
|
||||
my $list = MySimpleType->new({ value => [ 'You', 'shall', 'overcome' ] });
|
||||
print $list; # prints "You shall overcome"
|
||||
|
||||
=head1 CLASS HIERARCHY
|
||||
|
||||
This is the inheritance graph for builtin types.
|
||||
|
||||
Types with [] marker describe types derived via the item in [] in the XML
|
||||
Schema specs.
|
||||
|
||||
Derivation is implemented via multiple inheritance with the derivation method
|
||||
as first item in the base class list.
|
||||
|
||||
anyType
|
||||
- anySimpleType
|
||||
- duration
|
||||
- dateTime
|
||||
- date
|
||||
- time
|
||||
- gYearMonth
|
||||
- gYear
|
||||
- gMonthDay
|
||||
- gDay
|
||||
- gMonth
|
||||
- boolean
|
||||
- base64Binary
|
||||
- hexBinary
|
||||
- float
|
||||
- decimal
|
||||
- integer
|
||||
- nonPositiveInteger
|
||||
- negativeInteger
|
||||
- nonNegativeInteger
|
||||
- positiveInteger
|
||||
- unsignedLong
|
||||
- unsignedInt
|
||||
- unsignedShort
|
||||
- unsignedByte
|
||||
- long
|
||||
- int
|
||||
- short
|
||||
- byte
|
||||
- double
|
||||
- anyURI
|
||||
- string
|
||||
- normalizedString
|
||||
- language
|
||||
- Name
|
||||
- NCName
|
||||
- ID
|
||||
- IDREF
|
||||
- IDREFS [list]
|
||||
- ENTITY
|
||||
- NMTOKEN
|
||||
- NMTOKENS [list]
|
||||
|
||||
=head1 OVERLOADED OPERATORS
|
||||
|
||||
Overloading is implemented via Class::Std's trait mechanism.
|
||||
|
||||
The following behaviours apply:
|
||||
|
||||
=over
|
||||
|
||||
=item * string context
|
||||
|
||||
All classes use the C<serialize> method for stringification.
|
||||
|
||||
=item * bool context
|
||||
|
||||
All classes derived from anySimpleType return their value in bool context
|
||||
|
||||
=item * numeric context
|
||||
|
||||
The boolean class returns 0 or 1 in numeric context.
|
||||
|
||||
decimal, float and double (and derived classes) return their value in
|
||||
numeric context.
|
||||
|
||||
=back
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
=over
|
||||
|
||||
=item * Thread safety
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin uses Class::Std::Storable which uses
|
||||
Class::Std. Class::Std is not thread safe, so
|
||||
SOAP::WSDL::XSD::Typelib::Builtin is neither.
|
||||
|
||||
=item * XML Schema facets
|
||||
|
||||
No facets are implemented yet.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Replace whitespace by @ in e-mail address.
|
||||
|
||||
Martin Kutter E<gt>martin.kutter fen-net.deE<lt>
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This library is free software, you may distribute/modify it under the
|
||||
same terms as perl itself
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,184 @@
|
||||
#!/usr/bin/perl
|
||||
package SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
use strict;
|
||||
use Carp;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use Scalar::Util qw(blessed);
|
||||
use Class::Std::Storable;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
|
||||
|
||||
my %ELEMENTS_FROM;
|
||||
my %ATTRIBUTES_OF;
|
||||
my %CLASSES_OF;
|
||||
|
||||
# we store per-class elements.
|
||||
# call as __PACKAGE__->_factory
|
||||
sub _factory {
|
||||
my $class = shift;
|
||||
$ELEMENTS_FROM{ $class } = shift;
|
||||
$ATTRIBUTES_OF{ $class } = shift;
|
||||
$CLASSES_OF{ $class } = shift;
|
||||
|
||||
no strict qw(refs);
|
||||
while (my ($name, $attribute_ref) = each %{ $ATTRIBUTES_OF{ $class } } )
|
||||
{
|
||||
my $type = $CLASSES_OF{ $class }->{ $name }
|
||||
or die "No class given for $name";
|
||||
eval "require $type" if not eval { $type->isa('UNIVERSAL') };
|
||||
croak $@ if $@;
|
||||
|
||||
*{ "$class\::set_$name" } = sub {
|
||||
my ($self, $value) = @_;
|
||||
# set to a) value if it's an object
|
||||
# b) New object with value for simple vlues
|
||||
# c) New object with value for list values and list type
|
||||
# d) List ref of new objects with value for list values and non-list type
|
||||
$attribute_ref->{ ident $self } = (blessed $value)
|
||||
? $value
|
||||
: (ref $value && ref $value eq 'ARRAY')
|
||||
? $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list')
|
||||
? $type->new({ value => $value })
|
||||
: [ map { $type->new({ value => $_ }) } @{ $value } ]
|
||||
: $type->new({ value => $value });
|
||||
};
|
||||
|
||||
*{ "$class\::add_$name" } = sub {
|
||||
my ($self, $value) = @_;
|
||||
my $ident = ident $self;
|
||||
if (not defined $value) {
|
||||
warn "attempting to add empty value to " . ref $self;
|
||||
}
|
||||
|
||||
return $attribute_ref->{ $ident } = $value
|
||||
if not defined $attribute_ref->{ $ident };
|
||||
|
||||
# listify previous value if it's no list
|
||||
$attribute_ref->{ $ident } = [ $attribute_ref->{ $ident } ]
|
||||
if not ref $attribute_ref->{ $ident } eq 'ARRAY';
|
||||
|
||||
# add to list
|
||||
return push @{ $attribute_ref->{ $ident } }, $value;
|
||||
};
|
||||
}
|
||||
|
||||
# we need our own destructor - on the fly generated classes
|
||||
# don't necessarily go through Clas::Std::Storable's DEMOLISH
|
||||
# calls.
|
||||
# my $destructor_ref = *{ "$class\::DESTROY" };
|
||||
# no warnings qw(redefine);
|
||||
# *{ "$class\::DESTROY" } = sub {
|
||||
# my $self = shift;
|
||||
# my $class = shift;
|
||||
# for (@{ $ELEMENTS_FROM{ $class } }) {
|
||||
# delete $_->{ ident $self };
|
||||
# }
|
||||
# call original destructor.
|
||||
# $destructor_ref->( $self, @_) if ref ($destructor_ref);
|
||||
# };
|
||||
#
|
||||
}
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $args_of) = @_;
|
||||
my $class = ref $self;
|
||||
for my $name (keys %{ $ATTRIBUTES_OF{ $class } } ) {
|
||||
my $method = "set_$name";
|
||||
$self->$method( $args_of->{ $name } )
|
||||
if $args_of->{ $name };
|
||||
}
|
||||
}
|
||||
|
||||
sub _get_elements {
|
||||
my $self = shift;
|
||||
my $class = ref $self;
|
||||
my $ident = ident $self;
|
||||
return map { $_->{ $ident } } @{ $ELEMENTS_FROM{ $class } };
|
||||
}
|
||||
|
||||
# this serialize method works fine for <all> and <sequence>
|
||||
# complextypes, as well as for <restriction><all> or
|
||||
# <restriction><sequence>.
|
||||
# But what about choice, group, extension ?
|
||||
#
|
||||
sub _serialize {
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
my $class = ref $self;
|
||||
|
||||
# return concatenated return value of serialize call of all
|
||||
# elements retrieved from get_elements expanding list refs.
|
||||
# get_elements is inlined for performance.
|
||||
return join q{} , map {
|
||||
my $element = $ATTRIBUTES_OF{ $class }->{ $_ }->{$ident };
|
||||
$element = [ $element ]
|
||||
if not ref $element eq 'ARRAY';
|
||||
my $name = $_;
|
||||
|
||||
map {
|
||||
# skip empty elements - complexTypes may have empty elements
|
||||
# (minOccurs 0).
|
||||
if (not $_) {
|
||||
q{}
|
||||
}
|
||||
# serialize element elements with their own serializer
|
||||
# but name them like they're named here.
|
||||
elsif ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) {
|
||||
$_->serialize( { name => $_ } );
|
||||
}
|
||||
# serialize complextype elments (of other types) with their
|
||||
# serializer, but add element tags around.
|
||||
else {
|
||||
join q{}, $_->start_tag({ name => $name })
|
||||
, $_->serialize()
|
||||
, $_->end_tag({ name => $name });
|
||||
}
|
||||
} @{ $element }
|
||||
} (@{ $ELEMENTS_FROM{ $class } });
|
||||
}
|
||||
|
||||
sub serialize {
|
||||
my ($self, $opt) = @_;
|
||||
my $class = ref $self;
|
||||
$opt ||= {};
|
||||
# do we have a empty element ?
|
||||
return $self->start_tag({ %$opt, empty => 1 })
|
||||
if not @{ $ELEMENTS_FROM{ $class } };
|
||||
return join q{}, $self->start_tag($opt),
|
||||
$self->_serialize(), $self->end_tag();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * Thread safety
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin uses Class::Std::Storable which uses
|
||||
Class::Std. Class::Std is not thread safe, so
|
||||
SOAP::WSDL::XSD::Typelib::Builtin is neither.
|
||||
|
||||
=item * XML Schema facets
|
||||
|
||||
No facets are implemented yet.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Replace whitespace by @ in e-mail address.
|
||||
|
||||
Martin Kutter E<gt>martin.kutter fen-net.deE<lt>
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This library is free software, you may distribute/modify it under the
|
||||
same terms as perl itself
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,101 @@
|
||||
#!/usr/bin/perl
|
||||
package SOAP::WSDL::XSD::Typelib::Element;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use Data::Dumper;
|
||||
|
||||
my %NAME;
|
||||
my %NILLABLE;
|
||||
my %REF;
|
||||
my %MIN_OCCURS;
|
||||
my %MAX_OCCURS;
|
||||
|
||||
# Class data - remember, we're the base class for a class factory or for
|
||||
# generated code...
|
||||
# use BLOCK: for scoping
|
||||
BLOCK: {
|
||||
my %method_lookup = (
|
||||
_name => \%NAME,
|
||||
_nillable => \%NILLABLE,
|
||||
_ref => \%REF,
|
||||
_minOccurs => \%MIN_OCCURS,
|
||||
_maxOccurs => \%MAX_OCCURS,
|
||||
);
|
||||
|
||||
no strict qw(refs);
|
||||
while (my ($name, $value) = each %method_lookup ) {
|
||||
*{ "__set$name" } = sub {
|
||||
my $class = ref $_[0] || $_[0];
|
||||
$value->{ $class } = $_[1];
|
||||
};
|
||||
*{ "__get$name" } = sub {
|
||||
my $class = ref $_[0] || $_[0];
|
||||
return $value->{ $class };
|
||||
};
|
||||
}
|
||||
};
|
||||
|
||||
sub start_tag {
|
||||
my ($self, $opt, $value) = @_;
|
||||
my $class = ref $self;
|
||||
my $ending = '>';
|
||||
my @attr_from = ();
|
||||
|
||||
$ending = '/>' if ($opt->{ empty });
|
||||
|
||||
if ($opt->{qualified}) {
|
||||
push @attr_from, 'xmlns="' . $self->get_xmlns . '"';
|
||||
}
|
||||
if ($opt->{ nil }) {
|
||||
return q{} if not $NILLABLE{ $class };
|
||||
push @attr_from, 'xsi:nil="true"';
|
||||
$ending = '/>';
|
||||
}
|
||||
return join q{ }, "<$NAME{$class}" , @attr_from , $ending;
|
||||
}
|
||||
|
||||
sub end_tag {
|
||||
my ($self, $class) = ($_[0], ref $_[0]);
|
||||
return "</$NAME{$class}>";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package MyElement;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use base (
|
||||
'SOAP::WSDL::XSD::Typelib::Element',
|
||||
);
|
||||
|
||||
__PACKAGE__->__set_name('MyElementName');
|
||||
__PACKAGE__->__set_nillable(1);
|
||||
__PACKAGE__->__set_minOccurs(1);
|
||||
__PACKAGE__->__set_maxOccurs(1);
|
||||
__PACKAGE__->__set_ref(1);
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
=over
|
||||
|
||||
=item * minOccurs maxOccurs ref not implemented
|
||||
|
||||
These attributes are not yet supported, though they may be set as class
|
||||
properties via __PACKAGE__->__set_FOO methods.
|
||||
|
||||
=item * 'http://www.w3.org/2001/XMLSchema-instance prefix is hardcoded
|
||||
|
||||
The prefix for 'http://www.w3.org/2001/XMLSchema-instance (used as namespace
|
||||
for the {http://www.w3.org/2001/XMLSchema-instance}nil="true" attribute
|
||||
is hardcoded as 'xsi'.
|
||||
|
||||
You should definitly provide your XML envelope generator with the same prefix
|
||||
namespace combination (Default for SOAP::WSDL::Envelope).
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,130 @@
|
||||
#!/usr/bin/perl
|
||||
package SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::SimpleType::restriction;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::SimpleType);
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType - simple type base class
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module implements a base class for designing simple type classes
|
||||
modelling XML Schema simpleType definitions.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# example simpleType derived by restriction
|
||||
# XSD would be:
|
||||
# <simpleType name="MySimpleType">
|
||||
# <restriction base="xsd:string" />
|
||||
# </simpleType>
|
||||
package MySimpleType;
|
||||
use Class::Std::Storable;
|
||||
# restriction base implemented via inheritance
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
use base qw(
|
||||
# derive by restriction
|
||||
'SOAP::WSDL::XSD::Typelib::SimpleType::restriction',
|
||||
# restriction base
|
||||
'SOAP::WSDL::XSD::Typelib::Builtin::string'
|
||||
);
|
||||
|
||||
# example simpleType derived by list.
|
||||
# XSD would be:
|
||||
# <simpleType name="MySimpleListType">
|
||||
# <list itemTipe="xsd:string" />
|
||||
# </simpleType>
|
||||
package MySimpleListType;
|
||||
use Class::Std::Storable;
|
||||
# restriction base implemented via inheritance
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use base ('SOAP::WSDL::XSD::Typelib::SimpleType',
|
||||
'SOAP::WSDL::XSD::Typelib::Builtin::list', # derive by list
|
||||
'SOAP::WSDL::XSD::Typelib::Builtin::string' # list itemType
|
||||
);
|
||||
|
||||
=head1 How to write your own simple type
|
||||
|
||||
Writing a simple type class is easy - all you have to do is setting up the
|
||||
base classes correctly.
|
||||
|
||||
The following rules apply:
|
||||
|
||||
=over
|
||||
|
||||
=item * simpleType derived via list
|
||||
|
||||
simpleType classes derived via list must inherit from these classes in
|
||||
exactly this order:
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list # derive by list
|
||||
The::List::ItemType::Class # list itemType
|
||||
|
||||
The::List::ItemType::Class can either be a builtin class (see
|
||||
SOAP::WSDL::XSD::Builtin) or another simpleType class (any other class
|
||||
implementing the right methods is supported too, but not for the
|
||||
faint of heart).
|
||||
|
||||
=item * simpleType derived via restriction
|
||||
|
||||
simpleType classes derived via restriction must inherit from these classes in
|
||||
exactly this order:
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType # you may leave out this
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType::restriction # derive by retriction
|
||||
The::Restriction::Base::Class # resytriction base
|
||||
|
||||
The::Restriction::Base::Class can either be a builtin class (see
|
||||
SOAP::WSDL::XSD::Builtin) or another simpleType class.
|
||||
|
||||
The slight inconsistency between the these variants is caused by the
|
||||
restriction element, which has different meanings for simpleType and
|
||||
complexType definitions.
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over *
|
||||
|
||||
=item * Thread safety
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType uses Class::Std::Storable which uses
|
||||
Class::Std. Class::Std is not thread safe, so
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType is neither.
|
||||
|
||||
=item * union
|
||||
|
||||
union simple types are not supported yet.
|
||||
|
||||
=item * XML Schema facets
|
||||
|
||||
No facets are implemented yet.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Replace whitespace by @ in e-mail address.
|
||||
|
||||
Martin Kutter E<gt>martin.kutter fen-net.deE<lt>
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This library is free software, you may distribute/modify it under the
|
||||
same terms as perl itself
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user