================ 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{Test 0 0.00000 0.00000 23: Test2 0 0.00000 0.00000 24: Test2 0 0.00000 0.00000 25: Test2 0 0.00000 0.00000 26: Test2 0 0.00000 0.00000 27: Test2 0 0.00000 0.00000 28: Test2 0 0.00000 0.00000 29: Test2 0 0.00000 0.00000 30: Test2 0 0.00000 0.00000 31: Test2 0 0.00000 0.00000 32: Test2 0 0.00000 0.00000 33: Test2 0 0.00000 0.00000 34: Test2 0 0.00000 0.00000 35: Test2 0 0.00000 0.00000 36: Test 0 0.00000 0.00000 37: Test 0 0.00000 0.00000 38: Test 0 0.00000 0.00000 39: Test 0 0.00000 0.00000 40: Test 0 0.00000 0.00000 41: Test 0 0.00000 0.00000 42: Test 0 0.00000 0.00000 43: Test 0 0.00000 0.00000 44: Test 0 0.00000 0.00000 45: Test 0 0.00000 0.00000 46: Test 0 0.00000 0.00000 47: 0 0.00000 0.00000 48:}; 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{Testclass_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:};