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

import SOAP-WSDL 2.00_16 from CPAN

Browse Source 
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_16
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_16.tar.gz
This commit is contained in:
Martin Kutter
2007-09-29 12:52:16 -08:00
committed by Michael G. Schwern
parent 2347a88353
commit 30be0da3dc
267 changed files with 22463 additions and 2388 deletions
Download Patch File Download Diff File Expand all files Collapse all files

97
benchmark/01_expat.t Normal file
View File

@@ -0,0 +1,97 @@
#!/usr/bin/perl -w
%DB::packages=(SOAP::WSDL::Expat::MessageParser => 1);
use strict;
use warnings;
use lib '../lib';
use lib 'lib';
use lib '../t/lib';
# use SOAP::WSDL::SAX::MessageHandler;
use Benchmark;
use SOAP::WSDL::Expat::MessageParser;
use SOAP::WSDL::Expat::Message2Hash;
use XML::Simple;
use XML::LibXML;
use MyComplexType;
use MyElement;
use MySimpleType;
my $xml = q{<SOAP-ENV:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
<SOAP-ENV:Body><MyAtomicComplexTypeElement xmlns="urn:Test" >
<test>Test</test>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test2 >Test2</test2>
<test>Test</test>
<test>Test</test>
<test>Test</test>
<test>Test</test>
<test>Test</test>
<test>Test</test>
<test>Test</test>
<test>Test</test>
<test>Test</test>
<test>Test</test>
<test>Test</test>
</MyAtomicComplexTypeElement>
</SOAP-ENV:Body></SOAP-ENV:Envelope>};
my $parser = SOAP::WSDL::Expat::MessageParser->new({
class_resolver => 'FakeResolver'
});
my $hash_parser = SOAP::WSDL::Expat::Message2Hash->new();
$XML::Simple::PREFERRED_PARSER = 'XML::Parser';
my $libxml = XML::LibXML->new();
my @data;
timethese 10000,
{
'Hash (SOAP:WSDL)' => sub { push @data, $hash_parser->parse( $xml ) },
'XSD (SOAP::WSDL)' => sub { push @data, $parser->parse( $xml ) },
'XML::Simple (Hash)' => sub { push @data, XMLin $xml },
# 'XML::LibXML (DOM)' => sub { push @data, $libxml->parse_string( $xml ) },
};
# use Test::More tests => 1;
#is $parser->get_data(), q{<MyAtomicComplexTypeElement xmlns="urn:Test" >}
# . q{<test >Test</test><test2 >Test2</test2></MyAtomicComplexTypeElement>}
# , 'Content comparison';
#$parser->class_resolver( 'FakeResolver2' );
# data classes reside in t/lib/Typelib/
BEGIN {
package FakeResolver;
{
my %class_list = (
'MyAtomicComplexTypeElement' => 'MyAtomicComplexTypeElement',
'MyAtomicComplexTypeElement/test' => 'MyTestElement',
'MyAtomicComplexTypeElement/test2' => 'MyTestElement2',
);
sub get_map { return \%class_list };
sub new { return bless {}, 'FakeResolver' };
sub get_class {
my $name = join('/', @{ $_[1] });
return ($class_list{ $name }) ? $class_list{ $name }
: warn "no class found for $name";
};
};
};

21
benchmark/XSD/01_anyType.t Normal file
View File

@@ -0,0 +1,21 @@
use strict;
use warnings;
use Benchmark;
use lib '../../lib';
use SOAP::WSDL::XSD::Typelib::Builtin::anyType;
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anyType->new();
timethese 10000, {
'new' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anyType->new() },
'new with params' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anyType->new({
xmlns => 'urn:Test'
}) },
'set_FOO' => sub { $obj->set_xmlns('Test') },
};
my $data;
timethese 1000000, {
'set_FOO' => sub { $obj->set_xmlns('Test') },
'get_FOO' => sub { $data = $obj->get_xmlns() },
};

22
benchmark/XSD/02_anySimpleType.t Normal file
View File

@@ -0,0 +1,22 @@
use strict;
use warnings;
use Benchmark;
use lib '../../lib';
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new();
timethese 10000, {
'new' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new() },
'new + params' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({
xmlns => 'urn:Test',
value => 'Teststring'
}) },
'set_FOO' => sub { $obj->set_xmlns('Test') },
};
my $data;
timethese 1000000, {
'set_FOO' => sub { $obj->set_xmlns('Test') },
'get_FOO' => sub { $data = $obj->get_xmlns() },
};

22
benchmark/XSD/03_string.t Normal file
View File

@@ -0,0 +1,22 @@
use strict;
use warnings;
use Benchmark;
use lib '../../lib';
use SOAP::WSDL::XSD::Typelib::Builtin::string;
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::string->new();
timethese 10000, {
'new' => sub { SOAP::WSDL::XSD::Typelib::Builtin::string->new() },
'new + params' => sub { SOAP::WSDL::XSD::Typelib::Builtin::string->new({
xmlns => 'urn:Test',
value => 'Teststring'
}) },
'set_FOO' => sub { $obj->set_xmlns('Test') },
};
my $data;
timethese 1000000, {
'set_FOO' => sub { $obj->set_xmlns('Test') },
'get_FOO' => sub { $data = $obj->get_xmlns() },
};

324
benchmark/smallprof.out Normal file
View File

@@ -0,0 +1,324 @@
================ SmallProf version 2.02 ================
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 1
=================================================================
count wall tm cpu time line
0 0.00000 0.00000 1:#!/usr/bin/perl
0 0.00000 0.00000 2:package SOAP::WSDL::Expat::MessageParser;
0 0.00000 0.00000 3:use strict;
0 0.00000 0.00000 4:use warnings;
0 0.00000 0.00000 5:use SOAP::WSDL::XSD::Typelib::Builtin;
0 0.00000 0.00000 6:use XML::Parser::Expat;
0 0.00000 0.00000 7:
0 0.00000 0.00000 8:sub new {
1 0.00000 0.00000 9: my ($class, $args) = @_;
0 0.00000 0.00000 10: my $self = {
0 0.00000 0.00000 11: class_resolver => $args->{
1 0.00001 0.00000 12: strict => exists $args->{ strict } ?
0 0.00000 0.00000 13: };
1 0.00001 0.00000 14: bless $self, $class;
1 0.02383 0.02000 15: return $self;
0 0.00000 0.00000 16:}
0 0.00000 0.00000 17:
0 0.00000 0.00000 18:sub class_resolver {
0 0.00000 0.00000 19: my $self = shift;
0 0.00000 0.00000 20: $self->{ class_resolver } = shift;
0 0.00000 0.00000 21: return;
0 0.00000 0.00000 22:}
0 0.00000 0.00000 23:
0 0.00000 0.00000 24:sub _initialize {
1000 0.00098 0.01000 25: my ($self, $parser) = @_;
1000 0.04304 0.02000 26: $self->{ parser } = $parser;
0 0.00000 0.00000 27:
1000 0.00140 0.01000 28: delete $self->{ data };
0 0.00000 0.00000 29:
1000 0.00042 0.03000 30: my $characters;
0 0.00000 0.00000 31: #my @characters_from = ();
1000 0.00059 0.00000 32: my $current = undef;
1000 0.00093 0.00000 33: my $list = []; #
1000 0.00065 0.02000 34: my $path = []; #
1000 0.00064 0.02000 35: my $skip = 0; #
1000 0.00049 0.01000 36: my $current_part = q{}; # are
0 0.00000 0.00000 37:
1000 0.00041 0.00000 38: my $depth = 0;
0 0.00000 0.00000 39:
0 0.00000 0.00000 40: my %content_check = $self->{strict}
0 0.00000 0.00000 41: ? (
0 0.00000 0.00000 42: 0 => sub {
1000 0.00115 0.00000 43: die "Bad top node $_[1]"
1000 0.01666 0.03000 44: die "Bad namespace for
0 0.00000 0.00000 45: if $_[0]-
1000 0.00051 0.02000 46: $depth++;
1000 0.00413 0.01000 47: return;
0 0.00000 0.00000 48: },
0 0.00000 0.00000 49: 1 => sub {
1000 0.00050 0.02000 50: $depth++;
1000 0.03690 0.04000 51: return;
0 0.00000 0.00000 52: }
0 0.00000 0.00000 53: )
1000 0.01120 0.03000 54: : ();
0 0.00000 0.00000 55:
0 0.00000 0.00000 56: my $char_handler = sub {
================ SmallProf version 2.02 ================
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 2
=================================================================
count wall tm cpu time line
0 0.00000 0.00000 57: # push @characters_from, $_[1] if
80000 0.19296 1.00000 58: $characters .= $_[1] if $_[1]
0 0.00000 0.00000 59:
80000 0.27660 0.97000 60: return;
1000 0.00449 0.00000 61: };
0 0.00000 0.00000 62:
0 0.00000 0.00000 63: # use "globals" for speed
1000 0.00162 0.01000 64: my ($_prefix, $_method,
0 0.00000 0.00000 65: $_class) = ();
0 0.00000 0.00000 66:
0 0.00000 0.00000 67: no strict qw(refs);
0 0.00000 0.00000 68: $parser->setHandlers(
0 0.00000 0.00000 69: Start => sub {
0 0.00000 0.00000 70: # my ($parser, $element, %_attrs)
0 0.00000 0.00000 71: # $depth = $parser->depth();
0 0.00000 0.00000 72:
0 0.00000 0.00000 73: # call methods without using
0 0.00000 0.00000 74: # That's slightly faster than
0 0.00000 0.00000 75: # and we don't have to pass $_[1]
0 0.00000 0.00000 76: # Yup, that's dirty.
28000 0.03037 0.32000 77: return &{$content_check{ $depth
0 0.00000 0.00000 78:
26000 0.02735 0.15000 79: push @{ $path }, $_[1]; #
26000 0.01366 0.29000 80: return if $skip; #
0 0.00000 0.00000 81:
0 0.00000 0.00000 82: # resolve class of this element
0 0.00000 0.00000 83: $_class = $self->{ class_resolver
0 0.00000 0.00000 84: or die "Cannot resolve class
26000 0.28196 0.56000 85: . join('/', @{ $path }) .
0 0.00000 0.00000 86:
26000 0.01695 0.35000 87: if ($_class eq '__SKIP__') {
0 0.00000 0.00000 88: $skip = join('/', @{ $path
0 0.00000 0.00000 89: $self->setHandlers( Char =>
0 0.00000 0.00000 90: return;
0 0.00000 0.00000 91: }
0 0.00000 0.00000 92:
26000 0.02064 0.35000 93: push @$list, $current; # step
0 0.00000 0.00000 94:
26000 0.02021 0.23000 95: $characters = q(); # empty
0 0.00000 0.00000 96: #@characters_from = ();
0 0.00000 0.00000 97:
0 0.00000 0.00000 98: # Check whether we have a builtin
0 0.00000 0.00000 99: # We could replace this with
0 0.00000 0.00000 100: # match is a bit faster if the
0 0.00000 0.00000 101: # if $class matches...
26000 0.01676 0.21000 102: if (index $_class,
0 0.00000 0.00000 103: # check wheter there is a
0 0.00000 0.00000 104: # or a "new" method
0 0.00000 0.00000 105: # If not, require it - all
0 0.00000 0.00000 106: # define new()
0 0.00000 0.00000 107: # This is not exactly the
0 0.00000 0.00000 108: defined *{ "$_class\::new" }{
26000 0.07804 0.33000 109: or scalar @{ *{
0 0.00000 0.00000 110: or eval "require $_class"
0 0.00000 0.00000 111: or die $@;
0 0.00000 0.00000 112: }
================ SmallProf version 2.02 ================
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 3
=================================================================
count wall tm cpu time line
0 0.00000 0.00000 113:
26000 0.45038 0.81000 114: $current = $_class->new({
0 0.00000 0.00000 115:
0 0.00000 0.00000 116: # remember top level element
0 0.00000 0.00000 117: exists $self->{ data }
26000 0.02113 0.22000 118: or ($self->{ data } =
26000 0.01267 0.25000 119: $depth++;
26000 0.07978 0.40000 120: return;
0 0.00000 0.00000 121: },
0 0.00000 0.00000 122:
0 0.00000 0.00000 123: Char => $char_handler,
0 0.00000 0.00000 124:
0 0.00000 0.00000 125: End => sub {
0 0.00000 0.00000 126:
28000 0.01974 0.26000 127: pop @{ $path };
0 0.00000 0.00000 128:
28000 0.01197 0.18000 129: if ($skip) {
0 0.00000 0.00000 130: return if $skip ne join '/',
0 0.00000 0.00000 131: $skip = 0;
0 0.00000 0.00000 132: $_[0]->setHandler( Char =>
0 0.00000 0.00000 133: return;
0 0.00000 0.00000 134: }
0 0.00000 0.00000 135:
28000 0.01687 0.25000 136: $depth--;
0 0.00000 0.00000 137:
0 0.00000 0.00000 138: # This one easily handles ignores
28000 0.10769 0.33000 139: return if not ref $list->[-1];
0 0.00000 0.00000 140:
0 0.00000 0.00000 141: # set characters in current if we
0 0.00000 0.00000 142: # we may have characters in
0 0.00000 0.00000 143: # too - maybe we should rely on
0 0.00000 0.00000 144: # may get a speedup by defining a
0 0.00000 0.00000 145: # and looking it up via exists
0 0.00000 0.00000 146:# if ( $current-
0 0.00000 0.00000 147:# $current->set_value(
0 0.00000 0.00000 148:# }
0 0.00000 0.00000 149: # currently doesn't work, as
0 0.00000 0.00000 150: # maybe change ?
25000 0.21156 0.56000 151: $current->set_value( $characters
0 0.00000 0.00000 152: #$current->set_value( join
25000 0.08260 0.32000 153: $characters = q{};
0 0.00000 0.00000 154:# undef @characters_from;
0 0.00000 0.00000 155: # set appropriate attribute in
0 0.00000 0.00000 156: # multiple values must be
0 0.00000 0.00000 157: #$_method = "add_$_localname";
25000 0.01494 0.21000 158: $_method = "add_$_[1]";
25000 0.55155 0.86000 159: $list->[-1]->$_method( $current
0 0.00000 0.00000 160:
25000 0.02121 0.14000 161: $current = pop @$list;
25000 0.07002 0.34000 162: return;
0 0.00000 0.00000 163: }
1000 0.12135 0.08000 164: );
1000 0.13602 0.11000 165: return $parser;
0 0.00000 0.00000 166:}
0 0.00000 0.00000 167:
0 0.00000 0.00000 168:sub parse {
================ SmallProf version 2.02 ================
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 4
=================================================================
count wall tm cpu time line
1000 0.00055 0.03000 169: eval {
1000 0.07420 0.07000 170: $_[0]->_initialize(
0 0.00000 0.00000 171: XML::Parser::Expat->new(
0 0.00000 0.00000 172: Namespaces => 1
0 0.00000 0.00000 173: )
0 0.00000 0.00000 174: )->parse( $_[1] );
1000 0.01030 0.02000 175: $_[0]->{ parser }->release();
0 0.00000 0.00000 176: };
1000 0.00034 0.00000 177: die $@ if $@;
1000 2.73620 2.67000 178: return $_[0]->{ data };
0 0.00000 0.00000 179:}
0 0.00000 0.00000 180:
0 0.00000 0.00000 181:sub parsefile {
0 0.00000 0.00000 182: eval {
0 0.00000 0.00000 183: $_[0]->_initialize(
0 0.00000 0.00000 184: $_[0]->{ parser }->release();
0 0.00000 0.00000 185: };
0 0.00000 0.00000 186: die $@, $_[1] if $@;
0 0.00000 0.00000 187: return $_[0]->{ data };
0 0.00000 0.00000 188:}
0 0.00000 0.00000 189:
0 0.00000 0.00000 190:# SAX-like aliases
0 0.00000 0.00000 191:sub parse_string;
0 0.00000 0.00000 192:*parse_string = \&parse;
0 0.00000 0.00000 193:
0 0.00000 0.00000 194:sub parse_file;
0 0.00000 0.00000 195:*parse_file = \&parsefile;
0 0.00000 0.00000 196:
0 0.00000 0.00000 197:sub get_data {
0 0.00000 0.00000 198: return $_[0]->{ data };
0 0.00000 0.00000 199:}
0 0.00000 0.00000 200:
0 0.00000 0.00000 201:1;
0 0.00000 0.00000 202:
0 0.00000 0.00000 203:=pod
================ SmallProf version 2.02 ================
Profile of 01_expat.t Page 5
=================================================================
count wall tm cpu time line
0 0.00000 0.00000 1:#!/usr/bin/perl -w
1 0.00003 0.00000 2:%DB::packages=(SOAP::WSDL::Expat::MessagePars
0 0.00000 0.00000 3:use strict;
0 0.00000 0.00000 4:use warnings;
0 0.00000 0.00000 5:use lib '../lib';
0 0.00000 0.00000 6:use lib 'lib';
0 0.00000 0.00000 7:use lib '../t/lib';
0 0.00000 0.00000 8:use SOAP::WSDL::SAX::MessageHandler;
0 0.00000 0.00000 9:
0 0.00000 0.00000 10:use Benchmark;
0 0.00000 0.00000 11:use SOAP::WSDL::Expat::MessageParser;
0 0.00000 0.00000 12:use SOAP::WSDL::Expat::Message2Hash;
0 0.00000 0.00000 13:use XML::Simple;
0 0.00000 0.00000 14:use XML::LibXML;
0 0.00000 0.00000 15:use MyComplexType;
0 0.00000 0.00000 16:use MyElement;
0 0.00000 0.00000 17:use MySimpleType;
0 0.00000 0.00000 18:
0 0.00000 0.00000 19:my $xml = q{<SOAP-ENV:Envelope
0 0.00000 0.00000 20: xmlns:SOAP-
0 0.00000 0.00000 21: <SOAP-
0 0.00000 0.00000 22: <test>Test</test>
0 0.00000 0.00000 23: <test2 >Test2</test2>
0 0.00000 0.00000 24: <test2 >Test2</test2>
0 0.00000 0.00000 25: <test2 >Test2</test2>
0 0.00000 0.00000 26: <test2 >Test2</test2>
0 0.00000 0.00000 27: <test2 >Test2</test2>
0 0.00000 0.00000 28: <test2 >Test2</test2>
0 0.00000 0.00000 29: <test2 >Test2</test2>
0 0.00000 0.00000 30: <test2 >Test2</test2>
0 0.00000 0.00000 31: <test2 >Test2</test2>
0 0.00000 0.00000 32: <test2 >Test2</test2>
0 0.00000 0.00000 33: <test2 >Test2</test2>
0 0.00000 0.00000 34: <test2 >Test2</test2>
0 0.00000 0.00000 35: <test2 >Test2</test2>
0 0.00000 0.00000 36: <test>Test</test>
0 0.00000 0.00000 37: <test>Test</test>
0 0.00000 0.00000 38: <test>Test</test>
0 0.00000 0.00000 39: <test>Test</test>
0 0.00000 0.00000 40: <test>Test</test>
0 0.00000 0.00000 41: <test>Test</test>
0 0.00000 0.00000 42: <test>Test</test>
0 0.00000 0.00000 43: <test>Test</test>
0 0.00000 0.00000 44: <test>Test</test>
0 0.00000 0.00000 45: <test>Test</test>
0 0.00000 0.00000 46: <test>Test</test>
0 0.00000 0.00000 47: </MyAtomicComplexTypeElement>
0 0.00000 0.00000 48:</SOAP-ENV:Body></SOAP-ENV:Envelope>};
0 0.00000 0.00000 49:
0 0.00000 0.00000 50:
0 0.00000 0.00000 51:my $parser =
0 0.00000 0.00000 52: class_resolver => 'FakeResolver'
0 0.00000 0.00000 53:});
0 0.00000 0.00000 54:
0 0.00000 0.00000 55:my $hash_parser =
0 0.00000 0.00000 56:
================ SmallProf version 2.02 ================
Profile of 01_expat.t Page 6
=================================================================
count wall tm cpu time line
0 0.00000 0.00000 57:$XML::Simple::PREFERRED_PARSER =
0 0.00000 0.00000 58:
0 0.00000 0.00000 59:my $libxml = XML::LibXML->new();
0 0.00000 0.00000 60:my @data;
0 0.00000 0.00000 61:timethese 1000,
0 0.00000 0.00000 62:{
0 0.00000 0.00000 63: # 'Hash (SOAP:WSDL)' => sub { push @data,
0 0.00000 0.00000 64: 'SOAP::WSDL' => sub { push @data, $parser-
0 0.00000 0.00000 65:# 'XML::Simple (Hash)' => sub { push @data,
0 0.00000 0.00000 66:# 'XML::LibXML (DOM)' => sub { push @data,
0 0.00000 0.00000 67:};
0 0.00000 0.00000 68:
0 0.00000 0.00000 69:# use Test::More tests => 1;
0 0.00000 0.00000 70:#is $parser->get_data(),
0 0.00000 0.00000 71:# . q{<test >Test</test><test2
0 0.00000 0.00000 72:# , 'Content comparison';
0 0.00000 0.00000 73:
0 0.00000 0.00000 74:#$parser->class_resolver( 'FakeResolver2' );
0 0.00000 0.00000 75:
0 0.00000 0.00000 76:
0 0.00000 0.00000 77:# data classes reside in t/lib/Typelib/
0 0.00000 0.00000 78:BEGIN {
0 0.00000 0.00000 79: package FakeResolver;
0 0.00000 0.00000 80: {
0 0.00000 0.00000 81: my %class_list = (
0 0.00000 0.00000 82: 'MyAtomicComplexTypeElement' =>
0 0.00000 0.00000 83: 'MyAtomicComplexTypeElement/test'
0 0.00000 0.00000 84:
0 0.00000 0.00000 85: );
0 0.00000 0.00000 86:
0 0.00000 0.00000 87: sub get_map { return \%class_list };
0 0.00000 0.00000 88:
0 0.00000 0.00000 89: sub new { return bless {},
0 0.00000 0.00000 90:
0 0.00000 0.00000 91: sub get_class {
0 0.00000 0.00000 92: my $name = join('/', @{ $_[1] });
0 0.00000 0.00000 93: return ($class_list{ $name }) ?
0 0.00000 0.00000 94: : warn "no class found for
0 0.00000 0.00000 95: };
0 0.00000 0.00000 96: };
0 0.00000 0.00000 97:};

315
benchmark/smallprof.out-whitespace Normal file
View File

@@ -0,0 +1,315 @@
================ SmallProf version 2.02 ================
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 1
=================================================================
count wall tm cpu time line
0 0.00000 0.00000 1:#!/usr/bin/perl
0 0.00000 0.00000 2:package SOAP::WSDL::Expat::MessageParser;
0 0.00000 0.00000 3:use strict;
0 0.00000 0.00000 4:use warnings;
0 0.00000 0.00000 5:use SOAP::WSDL::XSD::Typelib::Builtin;
0 0.00000 0.00000 6:use XML::Parser::Expat;
0 0.00000 0.00000 7:
0 0.00000 0.00000 8:sub new {
1 0.00000 0.00000 9: my ($class, $args) = @_;
0 0.00000 0.00000 10: my $self = {
0 0.00000 0.00000 11: class_resolver => $args->{
1 0.00001 0.00000 12: strict => exists $args->{ strict } ?
0 0.00000 0.00000 13: };
1 0.00001 0.00000 14: bless $self, $class;
1 0.02309 0.03000 15: return $self;
0 0.00000 0.00000 16:}
0 0.00000 0.00000 17:
0 0.00000 0.00000 18:sub class_resolver {
1 0.00000 0.00000 19: my $self = shift;
1 2.74336 2.69000 20: $self->{ class_resolver } = shift;
0 0.00000 0.00000 21:}
0 0.00000 0.00000 22:
0 0.00000 0.00000 23:sub _initialize {
1000 0.00163 0.01000 24: my ($self, $parser) = @_;
1000 0.03682 0.05000 25: $self->{ parser } = $parser;
0 0.00000 0.00000 26:
1000 0.00138 0.01000 27: delete $self->{ data };
0 0.00000 0.00000 28:
1000 0.00048 0.01000 29: my $characters;
1000 0.00091 0.00000 30: my $current = undef;
1000 0.00097 0.01000 31: my $list = []; #
1000 0.00107 0.01000 32: my $path = []; #
1000 0.00054 0.01000 33: my $skip = 0; #
1000 0.00053 0.01000 34: my $current_part = q{}; # are
0 0.00000 0.00000 35:
1000 0.00041 0.02000 36: my $depth = 0;
0 0.00000 0.00000 37:
0 0.00000 0.00000 38: my %content_check = $self->{strict}
0 0.00000 0.00000 39: ? (
0 0.00000 0.00000 40: 0 => sub {
1000 0.00097 0.02000 41: die "Bad top node $_[1]"
1000 0.01651 0.00000 42: die "Bad namespace for
0 0.00000 0.00000 43: if $_[0]-
1000 0.00068 0.00000 44: $depth++;
1000 0.00441 0.02000 45: return;
0 0.00000 0.00000 46: },
0 0.00000 0.00000 47: 1 => sub {
1000 0.00369 0.02000 48: die "Bad node $_[1].
1000 0.00060 0.00000 49: $depth++;
1000 0.03693 0.03000 50: return;
0 0.00000 0.00000 51: }
0 0.00000 0.00000 52: )
1000 0.01252 0.01000 53: : ();
0 0.00000 0.00000 54:
0 0.00000 0.00000 55: # use "globals" for speed
1000 0.00095 0.01000 56: my ($_prefix, $_method,
================ SmallProf version 2.02 ================
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 2
=================================================================
count wall tm cpu time line
0 0.00000 0.00000 57: $_class) = ();
0 0.00000 0.00000 58:
0 0.00000 0.00000 59: no strict qw(refs);
0 0.00000 0.00000 60: $parser->setHandlers(
0 0.00000 0.00000 61: Start => sub {
0 0.00000 0.00000 62: # my ($parser, $element, %_attrs)
0 0.00000 0.00000 63: # $depth = $parser->depth();
0 0.00000 0.00000 64:
0 0.00000 0.00000 65: # call methods without using
0 0.00000 0.00000 66: # That's slightly faster than
0 0.00000 0.00000 67: # and we don't have to pass $_[1]
0 0.00000 0.00000 68: # Yup, that's dirty.
28000 0.03090 0.31000 69: return &{$content_check{ $depth
0 0.00000 0.00000 70:
26000 0.03309 0.32000 71: push @{ $path }, $_[1]; #
26000 0.01337 0.21000 72: return if $skip; #
0 0.00000 0.00000 73:
0 0.00000 0.00000 74: # resolve class of this element
0 0.00000 0.00000 75: $_class = $self->{ class_resolver
0 0.00000 0.00000 76: or die "Cannot resolve class
26000 0.28467 0.53000 77: . join('/', @{ $path }) .
0 0.00000 0.00000 78:
0 0.00000 0.00000 79: # maybe write as "return $skip =
0 0.00000 0.00000 80: # would save a BLOCK...
26000 0.03919 0.30000 81: return $skip = join('/', @{ $path
0 0.00000 0.00000 82:
26000 0.05079 0.22000 83: push @$list, $current; # step
0 0.00000 0.00000 84:
26000 0.07934 0.26000 85: $characters = q(); # empty
0 0.00000 0.00000 86:
0 0.00000 0.00000 87: # Check whether we have a builtin
0 0.00000 0.00000 88: # We could replace this with
0 0.00000 0.00000 89: # match is a bit faster if the
0 0.00000 0.00000 90: # if $class matches...
26000 0.01981 0.22000 91: if (index $_class,
0 0.00000 0.00000 92: # check wheter there is a
0 0.00000 0.00000 93: # or a "new" method
0 0.00000 0.00000 94: # If not, require it - all
0 0.00000 0.00000 95: # define new()
0 0.00000 0.00000 96: # This is not exactly the
0 0.00000 0.00000 97: defined *{ "$_class\::new" }{
26000 0.08308 0.26000 98: or scalar @{ *{
0 0.00000 0.00000 99: or eval "require $_class"
0 0.00000 0.00000 100: or die $@;
0 0.00000 0.00000 101: }
0 0.00000 0.00000 102:
26000 0.45611 0.64000 103: $current = $_class->new({
0 0.00000 0.00000 104:
0 0.00000 0.00000 105: # remember top level element
0 0.00000 0.00000 106: exists $self->{ data }
26000 0.02518 0.26000 107: or ($self->{ data } =
26000 0.01496 0.32000 108: $depth++;
26000 0.07949 0.39000 109: return;
0 0.00000 0.00000 110: },
0 0.00000 0.00000 111:
0 0.00000 0.00000 112: Char => sub {
================ SmallProf version 2.02 ================
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 3
=================================================================
count wall tm cpu time line
80000 0.05801 0.73000 113: return if $skip;
80000 0.38097 1.05000 114: return if $_[1] =~m{ \A \s* \z
25000 0.01804 0.24000 115: $characters .= $_[1];
25000 0.07404 0.32000 116: return;
0 0.00000 0.00000 117: },
0 0.00000 0.00000 118:
0 0.00000 0.00000 119: End => sub {
0 0.00000 0.00000 120:
28000 0.02209 0.25000 121: pop @{ $path };
0 0.00000 0.00000 122:
28000 0.01658 0.29000 123: if ($skip) {
0 0.00000 0.00000 124: return if $skip ne join '/',
0 0.00000 0.00000 125: $skip = 0;
0 0.00000 0.00000 126: return;
0 0.00000 0.00000 127: }
0 0.00000 0.00000 128:
28000 0.01628 0.26000 129: $depth--;
0 0.00000 0.00000 130:
0 0.00000 0.00000 131: # This one easily handles ignores
28000 0.11185 0.27000 132: return if not ref $list->[-1];
0 0.00000 0.00000 133:
0 0.00000 0.00000 134: # set characters in current if we
0 0.00000 0.00000 135: # we may have characters in
0 0.00000 0.00000 136: # too - maybe we should rely on
0 0.00000 0.00000 137: # may get a speedup by defining a
0 0.00000 0.00000 138: # and looking it up via exists
0 0.00000 0.00000 139:# if ( $current-
0 0.00000 0.00000 140:# $current->set_value(
0 0.00000 0.00000 141:# }
0 0.00000 0.00000 142: # currently doesn't work, as
0 0.00000 0.00000 143: # maybe change ?
25000 0.28121 0.53000 144: $current->set_value( $characters
25000 0.01730 0.20000 145: $characters = q{};
0 0.00000 0.00000 146: # set appropriate attribute in
0 0.00000 0.00000 147: # multiple values must be
0 0.00000 0.00000 148: #$_method = "add_$_localname";
25000 0.01976 0.23000 149: $_method = "add_$_[1]";
25000 0.55083 0.85000 150: $list->[-1]->$_method( $current
0 0.00000 0.00000 151:
25000 0.02277 0.25000 152: $current = pop @$list;
25000 0.06949 0.36000 153: return;
0 0.00000 0.00000 154: }
1000 0.12369 0.12000 155: );
1000 0.13620 0.08000 156: return $parser;
0 0.00000 0.00000 157:}
0 0.00000 0.00000 158:
0 0.00000 0.00000 159:sub parse {
1000 0.00065 0.02000 160: eval {
1000 0.07514 0.09000 161: $_[0]->_initialize(
0 0.00000 0.00000 162: XML::Parser::Expat->new(
0 0.00000 0.00000 163: Namespaces => 1
0 0.00000 0.00000 164: )
0 0.00000 0.00000 165: )->parse( $_[1] );
1000 0.01077 0.02000 166: $_[0]->{ parser }->release();
0 0.00000 0.00000 167: };
1000 0.00051 0.00000 168: die $@ if $@;
================ SmallProf version 2.02 ================
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 4
=================================================================
count wall tm cpu time line
1000 0.01431 0.04000 169: return $_[0]->{ data };
0 0.00000 0.00000 170:}
0 0.00000 0.00000 171:
0 0.00000 0.00000 172:sub parsefile {
0 0.00000 0.00000 173: eval {
0 0.00000 0.00000 174: $_[0]->_initialize(
0 0.00000 0.00000 175: $_[0]->{ parser }->release();
0 0.00000 0.00000 176: };
0 0.00000 0.00000 177: die $@, $_[1] if $@;
0 0.00000 0.00000 178: return $_[0]->{ data };
0 0.00000 0.00000 179:}
0 0.00000 0.00000 180:
0 0.00000 0.00000 181:# SAX-like aliases
0 0.00000 0.00000 182:sub parse_string;
0 0.00000 0.00000 183:*parse_string = \&parse;
0 0.00000 0.00000 184:
0 0.00000 0.00000 185:sub parse_file;
0 0.00000 0.00000 186:*parse_file = \&parsefile;
0 0.00000 0.00000 187:
0 0.00000 0.00000 188:sub get_data {
0 0.00000 0.00000 189: return $_[0]->{ data };
0 0.00000 0.00000 190:}
0 0.00000 0.00000 191:
0 0.00000 0.00000 192:1;
0 0.00000 0.00000 193:
0 0.00000 0.00000 194:=pod
================ SmallProf version 2.02 ================
Profile of 01_expat.t Page 5
=================================================================
count wall tm cpu time line
0 0.00000 0.00000 1:#!/usr/bin/perl -w
1 0.00002 0.00000 2:%DB::packages=(SOAP::WSDL::Expat::MessagePars
0 0.00000 0.00000 3:use strict;
0 0.00000 0.00000 4:use warnings;
0 0.00000 0.00000 5:use lib '../lib';
0 0.00000 0.00000 6:use lib 'lib';
0 0.00000 0.00000 7:use lib '../t/lib';
0 0.00000 0.00000 8:use SOAP::WSDL::SAX::MessageHandler;
0 0.00000 0.00000 9:
0 0.00000 0.00000 10:use Benchmark;
0 0.00000 0.00000 11:use SOAP::WSDL::Expat::MessageParser;
0 0.00000 0.00000 12:use SOAP::WSDL::Expat::Message2Hash;
0 0.00000 0.00000 13:use XML::Simple;
0 0.00000 0.00000 14:use XML::LibXML;
0 0.00000 0.00000 15:use MyComplexType;
0 0.00000 0.00000 16:use MyElement;
0 0.00000 0.00000 17:use MySimpleType;
0 0.00000 0.00000 18:
0 0.00000 0.00000 19:my $xml = q{<SOAP-ENV:Envelope
0 0.00000 0.00000 20: xmlns:SOAP-
0 0.00000 0.00000 21: <SOAP-
0 0.00000 0.00000 22: <test>Test</test>
0 0.00000 0.00000 23: <test2 >Test2</test2>
0 0.00000 0.00000 24: <test2 >Test2</test2>
0 0.00000 0.00000 25: <test2 >Test2</test2>
0 0.00000 0.00000 26: <test2 >Test2</test2>
0 0.00000 0.00000 27: <test2 >Test2</test2>
0 0.00000 0.00000 28: <test2 >Test2</test2>
0 0.00000 0.00000 29: <test2 >Test2</test2>
0 0.00000 0.00000 30: <test2 >Test2</test2>
0 0.00000 0.00000 31: <test2 >Test2</test2>
0 0.00000 0.00000 32: <test2 >Test2</test2>
0 0.00000 0.00000 33: <test2 >Test2</test2>
0 0.00000 0.00000 34: <test2 >Test2</test2>
0 0.00000 0.00000 35: <test2 >Test2</test2>
0 0.00000 0.00000 36: <test>Test</test>
0 0.00000 0.00000 37: <test>Test</test>
0 0.00000 0.00000 38: <test>Test</test>
0 0.00000 0.00000 39: <test>Test</test>
0 0.00000 0.00000 40: <test>Test</test>
0 0.00000 0.00000 41: <test>Test</test>
0 0.00000 0.00000 42: <test>Test</test>
0 0.00000 0.00000 43: <test>Test</test>
0 0.00000 0.00000 44: <test>Test</test>
0 0.00000 0.00000 45: <test>Test</test>
0 0.00000 0.00000 46: <test>Test</test>
0 0.00000 0.00000 47: </MyAtomicComplexTypeElement>
0 0.00000 0.00000 48:</SOAP-ENV:Body></SOAP-ENV:Envelope>};
0 0.00000 0.00000 49:
0 0.00000 0.00000 50:
0 0.00000 0.00000 51:my $parser =
0 0.00000 0.00000 52: class_resolver => 'FakeResolver'
0 0.00000 0.00000 53:});
0 0.00000 0.00000 54:
0 0.00000 0.00000 55:my $hash_parser =
0 0.00000 0.00000 56:
================ SmallProf version 2.02 ================
Profile of 01_expat.t Page 6
=================================================================
count wall tm cpu time line
0 0.00000 0.00000 57:$XML::Simple::PREFERRED_PARSER =
0 0.00000 0.00000 58:
0 0.00000 0.00000 59:my $libxml = XML::LibXML->new();
0 0.00000 0.00000 60:my @data;
0 0.00000 0.00000 61:timethese 1000,
0 0.00000 0.00000 62:{
0 0.00000 0.00000 63:# 'SOAP::WSDL Hash' => sub { push @data,
0 0.00000 0.00000 64: 'SOAP::WSDL' => sub { push @data, $parser-
0 0.00000 0.00000 65:# 'XML::Simple (Hash)' => sub { push @data,
0 0.00000 0.00000 66:# 'XML::LibXML (DOM)' => sub { push @data,
0 0.00000 0.00000 67:};
0 0.00000 0.00000 68:
0 0.00000 0.00000 69:# use Test::More tests => 1;
0 0.00000 0.00000 70:#is $parser->get_data(),
0 0.00000 0.00000 71:# . q{<test >Test</test><test2
0 0.00000 0.00000 72:# , 'Content comparison';
0 0.00000 0.00000 73:
0 0.00000 0.00000 74:$parser->class_resolver( 'FakeResolver2' );
0 0.00000 0.00000 75:
0 0.00000 0.00000 76:
0 0.00000 0.00000 77:# data classes reside in t/lib/Typelib/
0 0.00000 0.00000 78:BEGIN {
0 0.00000 0.00000 79: package FakeResolver;
0 0.00000 0.00000 80: {
0 0.00000 0.00000 81: my %class_list = (
0 0.00000 0.00000 82: 'MyAtomicComplexTypeElement' =>
0 0.00000 0.00000 83: 'MyAtomicComplexTypeElement/test'
0 0.00000 0.00000 84:
0 0.00000 0.00000 85: );
0 0.00000 0.00000 86:
0 0.00000 0.00000 87: sub get_map { return \%class_list };
0 0.00000 0.00000 88:
0 0.00000 0.00000 89: sub new { return bless {},
0 0.00000 0.00000 90:
0 0.00000 0.00000 91: sub get_class {
0 0.00000 0.00000 92: my $name = join('/', @{ $_[1] });
0 0.00000 0.00000 93: return ($class_list{ $name }) ?
0 0.00000 0.00000 94: : warn "no class found for
0 0.00000 0.00000 95: };
0 0.00000 0.00000 96: };
0 0.00000 0.00000 97:};