================ 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{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: # '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{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:};