dinislage/SOAP-WSDL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

import SOAP-WSDL 2.00.05 from CPAN

Browse Source 
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00.05
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.05.tar.gz
This commit is contained in:
Martin Kutter
2009-12-12 19:48:45 -08:00
committed by Michael G. Schwern
parent c3e3d1908e
commit c2ac24dd0f
109 changed files with 725 additions and 2095 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/SOAP/WSDL/Base.pm
+32 -29
View File
@@ -1,11 +1,11 @@
package SOAP::WSDL::Base;
use strict;
use warnings;
use strict; use warnings;
use Class::Std::Fast::Storable;
use List::Util qw(first);
use List::Util;
use Scalar::Util;
use Carp qw(croak carp confess);
use version; our $VERSION = qv('2.00.04');
use version; our $VERSION = qv('2.00.05');
my %id_of :ATTR(:name<id> :default<()>);
my %lang_of :ATTR(:name<lang> :default<()>);
@@ -15,7 +15,7 @@ my %documentation_of :ATTR(:name<documentation> :default<()>);
my %annotation_of :ATTR(:name<annotation> :default<()>);
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
my %parent_of :ATTR(:name<parent> :default<()>);
my %parent_of :ATTR(:get<parent> :default<()>);
my %namespaces_of :ATTR(:default<{}>);
@@ -23,34 +23,42 @@ sub namespaces {
return shift->get_xmlns();
}
sub BUILD {
my ($self, $ident, $arg_ref) = @_;
if (defined $arg_ref->{ parent }) {
$parent_of{ $ident } = delete $arg_ref->{ parent },
Scalar::Util::weaken($parent_of{ $ident });
}
}
sub START {
my ($self, $ident, $arg_ref) = @_;
$xmlns_of{ $ident }->{ 'xml' } = 'http://www.w3.org/XML/1998/namespace';
$namespaces_of{ $ident }->{ '#default' } = $self->get_xmlns()->{ '#default' };
$namespaces_of{ $ident }->{ 'xml' } = 'http://www.w3.org/XML/1998/namespace';
}
sub DEMOLISH {
my $self = shift;
# delete upward references
delete $parent_of{ ${ $self } };
return;
}
#
#sub STORABLE_freeze_pre :CUMULATIVE {};
#sub STORABLE_freeze_post :CUMULATIVE {};
#sub STORABLE_thaw_pre :CUMULATIVE {};
#sub STORABLE_thaw_post :CUMULATIVE { return $_[0] };
# set_parent is hand-implemented to break up (weaken) the circular reference
# between an object and it's parent
#
sub set_parent {
$parent_of{ ${ $_[0]} } = $_[1];
Scalar::Util::weaken($parent_of{ ${ $_[0]} });
}
# _accept is here to be called by visitor.
# The visitor pattern is a level of indirection - here the visitor calls
# $object->_accept($visitor) on each object, which in turn calls
# $visitor->visit_$class( $object ) where $class is the object's class.
#
sub _accept {
my $self = shift;
my $class = ref $self;
$class =~ s{ \A SOAP::WSDL:: }{}xms;
$class =~ s{ (:? :: ) }{_}gxms;
my $method = "visit_$class";
no strict qw(refs); ## no critic ProhibitNoStrict
no strict qw(refs);
return shift->$method( $self );
}
@@ -65,13 +73,12 @@ sub AUTOMETHOD {
if ($subname =~s{^push_}{}xms) {
my $getter = "get_$subname";
my $setter = "set_$subname";
## Checking here is paranoid - will fail fatally if
## there is no setter...
## And we would have to check getters, too.
## Maybe do it the Conway way via the Symbol table...
## ... can is way slow...
# Checking here is paranoid - will fail fatally if there is no setter.
# And we would have to check getters, too.
# Maybe do it the Conway way via the Symbol table...
# ... can is way slow...
return sub {
no strict qw(refs); ## no critic ProhibitNoStrict
no strict qw(refs);
my $old_value = $self->$getter();
# Listify if not a list ref
$old_value = $old_value ? [ $old_value ] : [] if not ref $old_value;
@@ -85,7 +92,7 @@ sub AUTOMETHOD {
elsif ($subname =~s {^find_}{get_}xms) {
@values = @{ $values[0] } if ref $values[0] eq 'ARRAY';
return sub {
return first {
return List::Util::first {
$_->get_targetNamespace() eq $values[0] &&
$_->get_name() eq $values[1]
}
@@ -101,10 +108,6 @@ sub AUTOMETHOD {
};
}
# return if called from can();
my @caller = caller(2);
return if ($caller[3] eq 'Class::Std::Fast::__ANON__');
# confess "$subname not found in class " . ref $self;
return;
}