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
316 lines
18 KiB
Plaintext
316 lines
18 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.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:};
|