Compare commits
1 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
7ba1959888 |
4
Build.PL
4
Build.PL
@@ -1,9 +1,9 @@
|
||||
use Module::Build;
|
||||
Module::Build->new(
|
||||
# create_makefile_pl => 'traditional',
|
||||
create_makefile_pl => 'passthrough',
|
||||
dist_abstract => 'SOAP with WSDL support',
|
||||
dist_name => 'SOAP-WSDL',
|
||||
dist_version => '2.00_09',
|
||||
dist_version => '2.00_10',
|
||||
module_name => 'SOAP::WSDL',
|
||||
license => 'artistic',
|
||||
requires => {
|
||||
|
||||
49
CHANGES
49
CHANGES
@@ -1,4 +1,53 @@
|
||||
------------------------------------------------------------------------
|
||||
r142 | kutterma | 2007-08-13 15:55:45 +0200 (Mo, 13 Aug 2007) | 1 line
|
||||
|
||||
typo
|
||||
------------------------------------------------------------------------
|
||||
r141 | kutterma | 2007-08-12 21:45:51 +0200 (So, 12 Aug 2007) | 2 lines
|
||||
|
||||
- corrected POD error
|
||||
- little speedup in add_FOO methods
|
||||
------------------------------------------------------------------------
|
||||
r140 | kutterma | 2007-08-12 21:27:58 +0200 (So, 12 Aug 2007) | 1 line
|
||||
|
||||
- corrected POD error
|
||||
------------------------------------------------------------------------
|
||||
r139 | kutterma | 2007-08-12 21:15:59 +0200 (So, 12 Aug 2007) | 1 line
|
||||
|
||||
- adder repository information
|
||||
------------------------------------------------------------------------
|
||||
r138 | kutterma | 2007-08-12 21:13:08 +0200 (So, 12 Aug 2007) | 1 line
|
||||
|
||||
- typo
|
||||
------------------------------------------------------------------------
|
||||
r137 | kutterma | 2007-08-12 21:12:20 +0200 (So, 12 Aug 2007) | 3 lines
|
||||
|
||||
- updated docs
|
||||
- added svn information
|
||||
- cosmetics
|
||||
------------------------------------------------------------------------
|
||||
r136 | kutterma | 2007-08-12 15:11:50 +0200 (So, 12 Aug 2007) | 2 lines
|
||||
|
||||
- fixed element ref="" top level- elements in code generator
|
||||
- prepared 2.00_09 pre-release
|
||||
------------------------------------------------------------------------
|
||||
r135 | kutterma | 2007-08-12 14:44:06 +0200 (So, 12 Aug 2007) | 1 line
|
||||
|
||||
- prepared 2.00_09 pre-release
|
||||
------------------------------------------------------------------------
|
||||
r134 | kutterma | 2007-08-12 14:30:33 +0200 (So, 12 Aug 2007) | 2 lines
|
||||
|
||||
- updated README
|
||||
- bumped up version
|
||||
------------------------------------------------------------------------
|
||||
r133 | kutterma | 2007-08-12 14:27:17 +0200 (So, 12 Aug 2007) | 1 line
|
||||
|
||||
- fixed Build.PL to leave Makefile.PL untouched.
|
||||
------------------------------------------------------------------------
|
||||
r132 | kutterma | 2007-08-12 14:21:24 +0200 (So, 12 Aug 2007) | 1 line
|
||||
|
||||
- now really added Makefile.PL
|
||||
------------------------------------------------------------------------
|
||||
r131 | kutterma | 2007-08-12 14:18:59 +0200 (So, 12 Aug 2007) | 3 lines
|
||||
|
||||
- fixed documentation for generated code with element ref="" declarations
|
||||
|
||||
4
META.yml
4
META.yml
@@ -1,6 +1,6 @@
|
||||
---
|
||||
name: SOAP-WSDL
|
||||
version: 2.00_09
|
||||
version: 2.00_10
|
||||
author:
|
||||
abstract: SOAP with WSDL support
|
||||
license: artistic
|
||||
@@ -24,7 +24,7 @@ meta-spec:
|
||||
provides:
|
||||
SOAP::WSDL:
|
||||
file: lib/SOAP/WSDL.pm
|
||||
version: 2.00_09
|
||||
version: 2.00_10
|
||||
SOAP::WSDL::Base:
|
||||
file: lib/SOAP/WSDL/Base.pm
|
||||
SOAP::WSDL::Binding:
|
||||
|
||||
56
Makefile.PL
56
Makefile.PL
@@ -1,27 +1,31 @@
|
||||
# Note: this file was auto-generated by Module::Build::Compat version 0.03
|
||||
use ExtUtils::MakeMaker;
|
||||
WriteMakefile
|
||||
(
|
||||
'PL_FILES' => {},
|
||||
'INSTALLDIRS' => 'site',
|
||||
'NAME' => 'SOAP::WSDL',
|
||||
'EXE_FILES' => [
|
||||
bin/wsdl2perl.pl'
|
||||
],
|
||||
'VERSION_FROM' => 'lib/SOAP/WSDL.pm',
|
||||
'PREREQ_PM' => {
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
'XML::Parser::Expat' => 0,
|
||||
'Class::Std' => 'v0.0.8',
|
||||
'Date::Format' => 0,
|
||||
'Date::Parse' => 0,
|
||||
'List::Util' => 0,
|
||||
'LWP::UserAgent' => 0,
|
||||
'XML::SAX::Base' => 0,
|
||||
'XML::LibXML' => 0,
|
||||
'File::Path' => 0,
|
||||
'Class::Std::Storable' => 0,
|
||||
'File::Basename' => 0
|
||||
}
|
||||
)
|
||||
;
|
||||
|
||||
unless (eval "use Module::Build::Compat 0.02; 1" ) {
|
||||
print "This module requires Module::Build to install itself.\n";
|
||||
|
||||
require ExtUtils::MakeMaker;
|
||||
my $yn = ExtUtils::MakeMaker::prompt
|
||||
(' Install Module::Build now from CPAN?', 'y');
|
||||
|
||||
unless ($yn =~ /^y/i) {
|
||||
die " *** Cannot install without Module::Build. Exiting ...\n";
|
||||
}
|
||||
|
||||
require Cwd;
|
||||
require File::Spec;
|
||||
require CPAN;
|
||||
|
||||
# Save this 'cause CPAN will chdir all over the place.
|
||||
my $cwd = Cwd::cwd();
|
||||
|
||||
CPAN::Shell->install('Module::Build::Compat');
|
||||
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
|
||||
or die "Couldn't install Module::Build, giving up.\n";
|
||||
|
||||
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
|
||||
}
|
||||
eval "use Module::Build::Compat 0.02; 1" or die $@;
|
||||
|
||||
Module::Build::Compat->run_build_pl(args => \@ARGV);
|
||||
require Module::Build;
|
||||
Module::Build::Compat->write_makefile(build_class => 'Module::Build');
|
||||
|
||||
@@ -9,10 +9,9 @@ use SOAP::WSDL::Envelope;
|
||||
use SOAP::WSDL::SAX::WSDLHandler;
|
||||
use Class::Std;
|
||||
use XML::LibXML;
|
||||
|
||||
use Data::Dumper;
|
||||
use LWP::UserAgent;
|
||||
our $VERSION='2.00_09';
|
||||
|
||||
our $VERSION='2.00_10';
|
||||
|
||||
my %no_dispatch_of :ATTR(:name<no_dispatch>);
|
||||
my %wsdl_of :ATTR(:name<wsdl>);
|
||||
@@ -64,8 +63,10 @@ for my $method (keys %LOOKUP ) {
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
{
|
||||
# we need to roll our own for supporting
|
||||
# SOAP::WSDL->new( key => value ) syntax,
|
||||
# like SOAP::Lite does
|
||||
no warnings qw(redefine);
|
||||
sub new {
|
||||
my $class = shift;
|
||||
@@ -85,7 +86,6 @@ for my $method (keys %LOOKUP ) {
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub wsdlinit {
|
||||
@@ -145,7 +145,7 @@ sub _wsdl_get_port :PRIVATE {
|
||||
return $port_of{ $ident } = $portname_of{ $ident }
|
||||
? $service_of{ $ident }->get_port( $ns, $portname_of{ $ident } )
|
||||
: $port_of{ $ident } = $service_of{ $ident }->get_port()->[ 0 ];
|
||||
} ## end sub _wsdl_get_port
|
||||
}
|
||||
|
||||
sub _wsdl_get_binding :PRIVATE {
|
||||
my $self = shift;
|
||||
@@ -155,7 +155,7 @@ sub _wsdl_get_binding :PRIVATE {
|
||||
$binding_of{ $ident } = $wsdl->find_binding( $wsdl->_expand( $port->get_binding() ) )
|
||||
or die "no binding found for ", $port->get_binding();
|
||||
return $binding_of{ $ident };
|
||||
} ## end sub _wsdl_get_binding
|
||||
}
|
||||
|
||||
sub _wsdl_get_portType :PRIVATE {
|
||||
my $self = shift;
|
||||
@@ -165,8 +165,7 @@ sub _wsdl_get_portType :PRIVATE {
|
||||
$porttype_of{ $ident } = $wsdl->find_portType( $wsdl->_expand( $binding->get_type() ) )
|
||||
or die "cannot find portType for " . $binding->get_type();
|
||||
return $porttype_of{ $ident };
|
||||
} ## end sub _wsdl_get_portType
|
||||
|
||||
}
|
||||
|
||||
sub _wsdl_init_methods :PRIVATE {
|
||||
my $self = shift;
|
||||
@@ -174,9 +173,7 @@ sub _wsdl_init_methods :PRIVATE {
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
|
||||
# get bindings, portType, message, part(s)
|
||||
# - use cached values where possible for speed,
|
||||
# private methods if not for clear separation...
|
||||
# get bindings, portType, message, part(s) - use private methods for clear separation...
|
||||
$self->_wsdl_get_service if not ($service_of{ $ident });
|
||||
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding()
|
||||
|| die "Can't find binding";
|
||||
@@ -241,7 +238,6 @@ sub call {
|
||||
my $response = (blessed $data)
|
||||
? $client->call( $method, $data )
|
||||
: do {
|
||||
|
||||
my $content = '';
|
||||
# TODO support RPC-encoding: Top-Level element + namespace...
|
||||
foreach my $part ( @{ $method_info_of{ $ident }->{ $method }->{ parts } } ) {
|
||||
@@ -471,7 +467,19 @@ You may pass the servicename and portname as attributes to wsdlinit, though.
|
||||
|
||||
=head1 Differences to SOAP::Lite
|
||||
|
||||
=head3 Output formats
|
||||
=head2 Message style/encoding
|
||||
|
||||
While SOAP::Lite supports rpc/encoded style/encoding only, SOAP::WSDL currently
|
||||
supports document/literal style/encoding.
|
||||
|
||||
=head2 autotype / type information
|
||||
|
||||
SOAP::Lite defaults to transmitting XML type information by default, where
|
||||
SOAP::WSDL defaults to leaving it out.
|
||||
|
||||
autotype(1) might even be broken in SOAP::WSDL - it's not well-tested, yet.
|
||||
|
||||
=head2 Output formats
|
||||
|
||||
In contrast to SOAP::Lite, SOAP::WSDL supports the following output formats:
|
||||
|
||||
@@ -498,7 +506,7 @@ See below.
|
||||
|
||||
=back
|
||||
|
||||
=head3 outputxml
|
||||
=head2 outputxml
|
||||
|
||||
SOAP::Lite returns only the content of the SOAP body when outputxml is set
|
||||
to true. SOAP::WSDL returns the complete XML response.
|
||||
@@ -588,6 +596,40 @@ The following facets have no influence yet:
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
There are lots of SOAP Clients on CPAN, lately.
|
||||
|
||||
You may wish to look at the following:
|
||||
|
||||
=over
|
||||
|
||||
=item * L<SOAP::Lite|SOAP::Lite>
|
||||
|
||||
Full featured SOAP-library, little WSDL support. Supports rpc-encoded style only. Many protocols supported.
|
||||
|
||||
=item * L<SOAP::Message|SOAP::Message>
|
||||
|
||||
A very basic SOAP library without transport facilities.
|
||||
|
||||
Handy if you got your XML message ready and just need an envelope around it.
|
||||
|
||||
=item * L<SOAP::MySOAP|SOAP::MySOAP>
|
||||
|
||||
An extremely basic SOAP client module - just HTTP support, no encoding / decoding,
|
||||
HTTP headers have to be set as arguments to 'new'
|
||||
|
||||
=item * <XML::Compile::WSDL|XML::Compile::WSDL>
|
||||
|
||||
A promising-looking approach derived from a cool functional DOM-based XML schema parser.
|
||||
|
||||
Will support encoding/decoding of SOAP messages based on WSDL definitions.
|
||||
|
||||
Not yet finished at the time of writing - but you may wish to give it a try, especially
|
||||
if you need to adhere very closely to the XML Schema / WSDL specs.
|
||||
|
||||
=back
|
||||
|
||||
=head1 ACKNOWLEDGMENTS
|
||||
|
||||
There are many people out there who fostered SOAP::WSDL's developement.
|
||||
@@ -595,7 +637,7 @@ I would like to thank them all (and apologize to all those I have forgotten).
|
||||
|
||||
Giovanni S. Fois wrote a improved version of SOAP::WSDL (which eventually became v1.23)
|
||||
|
||||
Damian A. Martinez Gelabert, Dennis S. Hennen, Dan Horne, Peter Orvos, Marc Overmeer,
|
||||
Damian A. Martinez Gelabert, Dennis S. Hennen, Dan Horne, Peter Orvos, Mark Overmeer,
|
||||
Jon Robens, Isidro Vila Verde and Glenn Wood spotted bugs and/or
|
||||
suggested improvements in the 1.2x releases.
|
||||
|
||||
@@ -617,5 +659,12 @@ the same terms as perl itself
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 143 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: WSDL.pm 143 2007-08-13 18:43:20Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
@@ -284,7 +284,12 @@ the same terms as perl itself
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 139 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Client.pm 139 2007-08-12 19:15:59Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -183,24 +183,28 @@ __PACKAGE__->__create_methods(
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
[% MACRO pod BLOCK %]=pod[% END %]
|
||||
[% MACRO cut BLOCK %]=pod[% END %]
|
||||
[% MACRO head1 BLOCK %]=head1[% END %]
|
||||
[% MACRO head2 BLOCK %]=head2[% END %]
|
||||
[% pod %]
|
||||
|
||||
=head1 NAME
|
||||
[% head1 %] NAME
|
||||
|
||||
[% interface_prefix %][% service.get_name %] - SOAP interface to [% service.get_name %] at
|
||||
[% service.first_port.get_location %]
|
||||
|
||||
=head1 SYNOPSIS
|
||||
[% head1 %] SYNOPSIS
|
||||
|
||||
my $interface = [% interface_prefix %][% service.get_name %]->new();
|
||||
my $[% operations.keys.1 %] = $interface->[% operations.keys.1 %]();
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
[% head1 %] METHODS
|
||||
[% FOREACH name=operations.keys;
|
||||
operation=operations.$name;
|
||||
%]
|
||||
=head2 [% name %]
|
||||
[% head2 %] [% name %]
|
||||
|
||||
[% operation.documentation %]
|
||||
|
||||
@@ -211,7 +215,7 @@ SYNOPSIS:
|
||||
|
||||
[% END %]
|
||||
|
||||
=cut
|
||||
[% cut %]
|
||||
|
||||
EOT
|
||||
|
||||
|
||||
@@ -242,18 +242,25 @@ sub get_xmlns { '[% self.get_targetNamespace %]' }
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
[% MACRO pod BLOCK %]=pod[% END %]
|
||||
[% MACRO cut BLOCK %]=cut[% END %]
|
||||
[% MACRO head1 BLOCK %]=head1[% END %]
|
||||
[% MACRO head2 BLOCK %]=head2[% END %]
|
||||
|
||||
[% pod %]
|
||||
|
||||
[% head1 %] NAME
|
||||
|
||||
[% type_prefix %][% self.get_name %]
|
||||
|
||||
=pod
|
||||
[% head1 %] SYNOPSIS
|
||||
|
||||
=head1 NAME [% type_prefix %][% self.get_name %]
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
[% head1 %] DESCRIPTION
|
||||
|
||||
Type class for the XML type [% self.get_name %].
|
||||
|
||||
=head1 PROPERTIES
|
||||
[% head1 %] PROPERTIES
|
||||
|
||||
The following properties may be accessed using get_PROPERTY / set_PROPERTY
|
||||
methods:
|
||||
@@ -302,7 +309,7 @@ Structure as perl hash:
|
||||
|
||||
[% structure %]
|
||||
|
||||
=cut
|
||||
[% cut %]
|
||||
|
||||
EOT
|
||||
|
||||
|
||||
@@ -336,18 +336,25 @@ __PACKAGE__->__set_ref('[% self.get_ref %]');
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
[% MACRO pod BLOCK %]=pod[% END %]
|
||||
[% MACRO cut BLOCK %]=cut[% END %]
|
||||
[% MACRO head1 BLOCK %]=head1[% END %]
|
||||
[% MACRO head2 BLOCK %]=head2[% END %]
|
||||
|
||||
[% pod %]
|
||||
|
||||
[% head1 %] NAME
|
||||
|
||||
=pod
|
||||
[% element_prefix %][% self.get_name %]
|
||||
|
||||
=head1 NAME [% element_prefix %][% self.get_name %]
|
||||
[% head1 %] SYNOPSIS
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
[% head1 %] DESCRIPTION
|
||||
|
||||
Type class for the XML element [% self.get_name %].
|
||||
|
||||
=head1 PROPERTIES
|
||||
[% head1 %] PROPERTIES
|
||||
|
||||
The following properties may be accessed using get_PROPERTY / set_PROPERTY
|
||||
methods:
|
||||
@@ -358,7 +365,7 @@ methods:
|
||||
[% END;
|
||||
END %]
|
||||
|
||||
=head1 Object structure
|
||||
[% head1 %] Object structure
|
||||
|
||||
[%- IF (type = self.first_complexType);
|
||||
FOREACH element = type.get_element;
|
||||
@@ -382,8 +389,8 @@ Structure as perl hash:
|
||||
tree.
|
||||
|
||||
[% structure %]
|
||||
|
||||
=cut
|
||||
|
||||
[% cut %]
|
||||
|
||||
EOT
|
||||
|
||||
|
||||
@@ -1,11 +1,11 @@
|
||||
#!/usr/bin/perl
|
||||
package SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
use strict;
|
||||
use warnings;
|
||||
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);
|
||||
@@ -29,54 +29,50 @@ sub _factory {
|
||||
my $type = $CLASSES_OF{ $class }->{ $name }
|
||||
or die "No class given for $name";
|
||||
|
||||
# require all types here - this is a slow check -
|
||||
# TODO speedup
|
||||
# require all types here
|
||||
$type->isa('UNIVERSAL')
|
||||
or eval "require $type"
|
||||
or croak $@;
|
||||
|
||||
# check now, so we don't need to do it later...
|
||||
my $is_list = $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list');
|
||||
|
||||
*{ "$class\::set_$name" } = sub {
|
||||
my ($self, $value) = @_;
|
||||
|
||||
=for developers
|
||||
|
||||
The structure below looks rather weird, but is optimized for performance.
|
||||
|
||||
We could use sub calls for sure, but these are much slower. And the logic
|
||||
is not that easy:
|
||||
|
||||
we accept:
|
||||
a) objects
|
||||
b) scalars
|
||||
c) list refs
|
||||
d) hash refs
|
||||
e) mixed stuff of all of the above, so we have to set our element to
|
||||
a) value if it's an object
|
||||
b) New object of expected class with value for simple values
|
||||
c 1) New object with value for list values and list type
|
||||
c 2) List ref of new objects with value for list values and non-list type
|
||||
c + e 1) List ref of objects for list values (list of objects) and non-list type
|
||||
c + e 2) List ref of new objects for list values (list of hashes) and non-list type
|
||||
where the hash ref is passed to new as argument
|
||||
d) New object with values passed to new for HASH references
|
||||
|
||||
We throw an error on
|
||||
a) list refs of list refs - don't know what to do with this (maybe use for lists of list types ?)
|
||||
b) wrong object types
|
||||
c) non-blessed non-ARRAY/HASH references - if you can define semantics
|
||||
for GLOB references, feel free to add them.
|
||||
d) we should also die for non-blessed non-ARRAY/HASH references in lists but don't do yet - oh my !
|
||||
|
||||
=cut
|
||||
# The structure below looks rather weird, but is optimized for performance.
|
||||
#
|
||||
# We could use sub calls for sure, but these are much slower. And the logic
|
||||
# is not that easy:
|
||||
#
|
||||
# we accept:
|
||||
# a) objects
|
||||
# b) scalars
|
||||
# c) list refs
|
||||
# d) hash refs
|
||||
# e) mixed stuff of all of the above, so we have to set our element to
|
||||
# a) value if it's an object
|
||||
# b) New object of expected class with value for simple values
|
||||
# c 1) New object with value for list values and list type
|
||||
# c 2) List ref of new objects with value for list values and non-list type
|
||||
# c + e 1) List ref of objects for list values (list of objects) and non-list type
|
||||
# c + e 2) List ref of new objects for list values (list of hashes) and non-list type
|
||||
# where the hash ref is passed to new as argument
|
||||
# d) New object with values passed to new for HASH references
|
||||
#
|
||||
# We throw an error on
|
||||
# a) list refs of list refs - don't know what to do with this (maybe use for lists of list types ?)
|
||||
# b) wrong object types
|
||||
# c) non-blessed non-ARRAY/HASH references - if you can define semantics
|
||||
# for GLOB references, feel free to add them.
|
||||
# d) we should also die for non-blessed non-ARRAY/HASH references in lists but don't do yet - oh my !
|
||||
|
||||
my $is_ref = ref $value;
|
||||
$attribute_ref->{ ident $self } = ($is_ref)
|
||||
? $is_ref eq 'ARRAY'
|
||||
? $is_list
|
||||
? $type->new({ value => $value })
|
||||
: [ map {
|
||||
? $is_list # remembered from outside closure
|
||||
? $type->new({ value => $value }) # list element - can take list ref as value
|
||||
: [ map {
|
||||
ref $_
|
||||
? ref $_ eq 'HASH'
|
||||
? $type->new($_)
|
||||
@@ -95,21 +91,20 @@ is not that easy:
|
||||
};
|
||||
|
||||
*{ "$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
|
||||
my $ident = ident $_[0];
|
||||
warn "attempting to add empty value to " . ref $_[0]
|
||||
if (not defined $_[1]);
|
||||
|
||||
# first call
|
||||
return $attribute_ref->{ $ident } = $_[1]
|
||||
if not defined $attribute_ref->{ $ident };
|
||||
|
||||
# listify previous value if it's no list
|
||||
# second call: 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;
|
||||
# second and following: add to list
|
||||
return push @{ $attribute_ref->{ $ident } }, $_[1];
|
||||
};
|
||||
|
||||
}
|
||||
@@ -139,7 +134,7 @@ is not that easy:
|
||||
# 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 ?
|
||||
# But what about choice, extension ?
|
||||
*{ "$class\::_serialize" } = sub {
|
||||
my $ident = ident $_[0];
|
||||
# my $class = ref $_[0];
|
||||
|
||||
Reference in New Issue
Block a user