008d06b72a
git-cpan-module: SOAP-WSDL git-cpan-version: 2.00_17 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_17.tar.gz
325 lines
19 KiB
Plaintext
325 lines
19 KiB
Plaintext
================ 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:};
|