← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:47 2015

Filename/usr/lib/x86_64-linux-gnu/perl5/5.20/XML/Parser.pm
StatementsExecuted 319 statements in 2.10ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.36ms5.59msXML::Parser::::BEGIN@17XML::Parser::BEGIN@17
211106µs16.2msXML::Parser::::parseXML::Parser::parse
21158µs58µsXML::Parser::::setHandlersXML::Parser::setHandlers
21140µs40µsXML::Parser::::newXML::Parser::new
21139µs16.3msXML::Parser::::parsefileXML::Parser::parsefile
21126µs26µsXML::Parser::::CORE:openXML::Parser::CORE:open (opcode)
11111µs22µsXML::Parser::::BEGIN@11XML::Parser::BEGIN@11
21110µs10µsXML::Parser::::CORE:closeXML::Parser::CORE:close (opcode)
1118µs43µsXML::Parser::::BEGIN@15XML::Parser::BEGIN@15
1116µs32µsXML::Parser::::BEGIN@13XML::Parser::BEGIN@13
2115µs5µsXML::Parser::::CORE:binmodeXML::Parser::CORE:binmode (opcode)
0000s0sXML::Parser::::file_ext_ent_cleanupXML::Parser::file_ext_ent_cleanup
0000s0sXML::Parser::::file_ext_ent_handlerXML::Parser::file_ext_ent_handler
0000s0sXML::Parser::::initial_ext_ent_handlerXML::Parser::initial_ext_ent_handler
0000s0sXML::Parser::::parse_startXML::Parser::parse_start
0000s0sXML::Parser::::parsestringXML::Parser::parsestring
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# XML::Parser
2#
3# Copyright (c) 1998-2000 Larry Wall and Clark Cooper
4# All rights reserved.
5#
6# This program is free software; you can redistribute it and/or
7# modify it under the same terms as Perl itself.
8
9package XML::Parser;
10
11228µs233µs
# spent 22µs (11+11) within XML::Parser::BEGIN@11 which was called: # once (11µs+11µs) by XML::SAX::Expat::BEGIN@11 at line 11
use strict;
# spent 22µs making 1 call to XML::Parser::BEGIN@11 # spent 11µs making 1 call to strict::import
12
13223µs257µs
# spent 32µs (6+25) within XML::Parser::BEGIN@13 which was called: # once (6µs+25µs) by XML::SAX::Expat::BEGIN@11 at line 13
use vars qw($VERSION $LWP_load_failed);
# spent 32µs making 1 call to XML::Parser::BEGIN@13 # spent 25µs making 1 call to vars::import
14
15243µs278µs
# spent 43µs (8+35) within XML::Parser::BEGIN@15 which was called: # once (8µs+35µs) by XML::SAX::Expat::BEGIN@11 at line 15
use Carp;
# spent 43µs making 1 call to XML::Parser::BEGIN@15 # spent 35µs making 1 call to Exporter::import
16
17
# spent 5.59ms (3.36+2.23) within XML::Parser::BEGIN@17 which was called: # once (3.36ms+2.23ms) by XML::SAX::Expat::BEGIN@11 at line 22
BEGIN {
181620µs require XML::Parser::Expat;
191200ns $VERSION = '2.41';
2013µs die "Parser.pm and Expat.pm versions don't match"
21 unless $VERSION eq $XML::Parser::Expat::VERSION;
2211.11ms15.59ms}
# spent 5.59ms making 1 call to XML::Parser::BEGIN@17
23
241300ns$LWP_load_failed = 0;
25
26
# spent 40µs within XML::Parser::new which was called 2 times, avg 20µs/call: # 2 times (40µs+0s) by XML::SAX::Expat::_create_parser at line 96 of XML/SAX/Expat.pm, avg 20µs/call
sub new {
2722µs my ($class, %args) = @_;
2821µs my $style = $args{Style};
29
3022µs my $nonexopt = $args{Non_Expat_Options} ||= {};
31
3221µs $nonexopt->{Style} = 1;
332600ns $nonexopt->{Non_Expat_Options} = 1;
342700ns $nonexopt->{Handlers} = 1;
3521µs $nonexopt->{_HNDL_TYPES} = 1;
362800ns $nonexopt->{NoLWP} = 1;
37
38216µs $args{_HNDL_TYPES} = {%XML::Parser::Expat::Handler_Setters};
3921µs $args{_HNDL_TYPES}->{Init} = 1;
4022µs $args{_HNDL_TYPES}->{Final} = 1;
41
422900ns $args{Handlers} ||= {};
432600ns my $handlers = $args{Handlers};
44
452600ns if (defined($style)) {
46 my $stylepkg = $style;
47
48 if ($stylepkg !~ /::/) {
49 $stylepkg = "\u$style";
50
51 eval {
52 my $fullpkg = 'XML::Parser::Style::' . $stylepkg;
53 my $stylefile = $fullpkg;
54 $stylefile =~ s/::/\//g;
55 require "$stylefile.pm";
56 $stylepkg = $fullpkg;
57 };
58 if ($@) {
59 # fallback to old behaviour
60 $stylepkg = 'XML::Parser::' . $stylepkg;
61 }
62 }
63
64 my $htype;
65 foreach $htype (keys %{$args{_HNDL_TYPES}}) {
66 # Handlers explicity given override
67 # handlers from the Style package
68 unless (defined($handlers->{$htype})) {
69
70 # A handler in the style package must either have
71 # exactly the right case as the type name or a
72 # completely lower case version of it.
73
74 my $hname = "${stylepkg}::$htype";
75 if (defined(&$hname)) {
76 $handlers->{$htype} = \&$hname;
77 next;
78 }
79
80 $hname = "${stylepkg}::\L$htype";
81 if (defined(&$hname)) {
82 $handlers->{$htype} = \&$hname;
83 next;
84 }
85 }
86 }
87 }
88
8921µs unless (defined($handlers->{ExternEnt})
90 or defined ($handlers->{ExternEntFin})) {
91
9221µs if ($args{NoLWP} or $LWP_load_failed) {
93 $handlers->{ExternEnt} = \&file_ext_ent_handler;
94 $handlers->{ExternEntFin} = \&file_ext_ent_cleanup;
95 }
96 else {
97 # The following just bootstraps the real LWP external entity
98 # handler
99
10022µs $handlers->{ExternEnt} = \&initial_ext_ent_handler;
101
102 # No cleanup function available until LWPExternEnt.pl loaded
103 }
104 }
105
10622µs $args{Pkg} ||= caller;
10727µs bless \%args, $class;
108} # End of new
109
110
# spent 58µs within XML::Parser::setHandlers which was called 2 times, avg 29µs/call: # 2 times (58µs+0s) by XML::SAX::Expat::_create_parser at line 98 of XML/SAX/Expat.pm, avg 29µs/call
sub setHandlers {
11128µs my ($self, @handler_pairs) = @_;
112
11322µs croak("Uneven number of arguments to setHandlers method")
114 if (int(@handler_pairs) & 1);
115
1162400ns my @ret;
11721µs while (@handler_pairs) {
118345µs my $type = shift @handler_pairs;
119343µs my $handler = shift @handler_pairs;
120347µs unless (defined($self->{_HNDL_TYPES}->{$type})) {
121 my @types = sort keys %{$self->{_HNDL_TYPES}};
122
123 croak("Unknown Parser handler type: $type\n Valid types: @types");
124 }
1253410µs push(@ret, $type, $self->{Handlers}->{$type});
1263417µs $self->{Handlers}->{$type} = $handler;
127 }
128
12926µs return @ret;
130}
131
132sub parse_start {
133 my $self = shift;
134 my @expat_options = ();
135
136 my ($key, $val);
137 while (($key, $val) = each %{$self}) {
138 push (@expat_options, $key, $val)
139 unless exists $self->{Non_Expat_Options}->{$key};
140 }
141
142 my %handlers = %{$self->{Handlers}};
143 my $init = delete $handlers{Init};
144 my $final = delete $handlers{Final};
145
146 my $expatnb = XML::Parser::ExpatNB->new(@expat_options, @_);
147 $expatnb->setHandlers(%handlers);
148
149 &$init($expatnb)
150 if defined($init);
151
152 $expatnb->{_State_} = 1;
153
154 $expatnb->{FinalHandler} = $final
155 if defined($final);
156
157 return $expatnb;
158}
159
160
# spent 16.2ms (106µs+16.1) within XML::Parser::parse which was called 2 times, avg 8.10ms/call: # 2 times (106µs+16.1ms) by XML::Parser::parsefile at line 233, avg 8.10ms/call
sub parse {
1612800ns my $self = shift;
16222µs my $arg = shift;
16321µs my @expat_options = ();
1642200ns my ($key, $val);
16524µs while (($key, $val) = each %{$self}) {
1661412µs push(@expat_options, $key, $val)
167 unless exists $self->{Non_Expat_Options}->{$key};
168 }
169
17028µs254µs my $expat = XML::Parser::Expat->new(@expat_options, @_);
# spent 54µs making 2 calls to XML::Parser::Expat::new, avg 27µs/call
171210µs my %handlers = %{$self->{Handlers}};
17222µs my $init = delete $handlers{Init};
1732700ns my $final = delete $handlers{Final};
174
17526µs2209µs $expat->setHandlers(%handlers);
# spent 209µs making 2 calls to XML::Parser::Expat::setHandlers, avg 105µs/call
176
17724µs221µs if ($self->{Base}) {
# spent 21µs making 2 calls to XML::Parser::Expat::base, avg 11µs/call
178 $expat->base($self->{Base});
179 }
180
18124µs23µs &$init($expat)
# spent 3µs making 2 calls to XML::SAX::Expat::_handle_init, avg 1µs/call
182 if defined($init);
183
18421µs my @result = ();
1852300ns my $result;
18621µs eval {
18725µs215.7ms $result = $expat->parse($arg);
# spent 15.7ms making 2 calls to XML::Parser::Expat::parse, avg 7.86ms/call
188 };
1892800ns my $err = $@;
1902300ns if ($err) {
191 $expat->release;
192 die $err;
193 }
194
19522µs if ($result and defined($final)) {
196 if (wantarray) {
197 @result = &$final($expat);
198 }
199 else {
20023µs252µs $result = &$final($expat);
# spent 52µs making 2 calls to XML::SAX::Expat::_handle_final, avg 26µs/call
201 }
202 }
203
20424µs211µs $expat->release;
# spent 11µs making 2 calls to XML::Parser::Expat::release, avg 5µs/call
205
2062800ns return unless defined wantarray;
20729µs return wantarray ? @result : $result;
208}
209
210sub parsestring {
211 my $self = shift;
212 $self->parse(@_);
213}
214
215
# spent 16.3ms (39µs+16.2) within XML::Parser::parsefile which was called 2 times, avg 8.14ms/call: # 2 times (39µs+16.2ms) by XML::SAX::Expat::_parse_systemid at line 75 of XML/SAX/Expat.pm, avg 8.14ms/call
sub parsefile {
2162500ns my $self = shift;
2172500ns my $file = shift;
21822µs local(*FILE);
219234µs226µs open(FILE, $file) or croak "Couldn't open $file:\n$!";
# spent 26µs making 2 calls to XML::Parser::CORE:open, avg 13µs/call
220210µs25µs binmode(FILE);
# spent 5µs making 2 calls to XML::Parser::CORE:binmode, avg 3µs/call
2212500ns my @ret;
222 my $ret;
223
22421µs $self->{Base} = $file;
225
22621µs if (wantarray) {
227 eval {
228 @ret = $self->parse(*FILE, @_);
229 };
230 }
231 else {
23221µs eval {
233214µs416.2ms $ret = $self->parse(*FILE, @_);
# spent 16.2ms making 2 calls to XML::Parser::parse, avg 8.10ms/call # spent 20µs making 2 calls to XML::Parser::Expat::DESTROY, avg 10µs/call
234 };
235 }
2362700ns my $err = $@;
237216µs210µs close(FILE);
# spent 10µs making 2 calls to XML::Parser::CORE:close, avg 5µs/call
2382500ns die $err if $err;
239
2402700ns return unless defined wantarray;
24127µs return wantarray ? @ret : $ret;
242}
243
244sub initial_ext_ent_handler {
245 # This just bootstraps in the real lwp_ext_ent_handler which
246 # also loads the URI and LWP modules.
247
248 unless ($LWP_load_failed) {
249 local($^W) = 0;
250
251 my $stat =
252 eval {
253 require('XML/Parser/LWPExternEnt.pl');
254 };
255
256 if ($stat) {
257 $_[0]->setHandlers(ExternEnt => \&lwp_ext_ent_handler,
258 ExternEntFin => \&lwp_ext_ent_cleanup);
259
260 goto &lwp_ext_ent_handler;
261 }
262
263 # Failed to load lwp handler, act as if NoLWP
264
265 $LWP_load_failed = 1;
266
267 my $cmsg = "Couldn't load LWP based external entity handler\n";
268 $cmsg .= "Switching to file-based external entity handler\n";
269 $cmsg .= " (To avoid this message, use NoLWP option to XML::Parser)\n";
270 warn($cmsg);
271 }
272
273 $_[0]->setHandlers(ExternEnt => \&file_ext_ent_handler,
274 ExternEntFin => \&file_ext_ent_cleanup);
275 goto &file_ext_ent_handler;
276
277}
278
279sub file_ext_ent_handler {
280 my ($xp, $base, $path) = @_;
281
282 # Prepend base only for relative paths
283
284 if (defined($base)
285 and not ($path =~ m!^(?:[\\/]|\w+:)!))
286 {
287 my $newpath = $base;
288 $newpath =~ s![^\\/:]*$!$path!;
289 $path = $newpath;
290 }
291
292 if ($path =~ /^\s*[|>+]/
293 or $path =~ /\|\s*$/) {
294 $xp->{ErrorMessage}
295 .= "System ID ($path) contains Perl IO control characters";
296 return undef;
297 }
298
299 require IO::File;
300 my $fh = IO::File->new($path);
301 unless (defined $fh) {
302 $xp->{ErrorMessage}
303 .= "Failed to open $path:\n$!";
304 return undef;
305 }
306
307 $xp->{_BaseStack} ||= [];
308 $xp->{_FhStack} ||= [];
309
310 push(@{$xp->{_BaseStack}}, $base);
311 push(@{$xp->{_FhStack}}, $fh);
312
313 $xp->base($path);
314
315 return $fh;
316}
317
318sub file_ext_ent_cleanup {
319 my ($xp) = @_;
320
321 my $fh = pop(@{$xp->{_FhStack}});
322 $fh->close;
323
324 my $base = pop(@{$xp->{_BaseStack}});
325 $xp->base($base);
326}
327
32812µs1;
329
330__END__
 
# spent 5µs within XML::Parser::CORE:binmode which was called 2 times, avg 3µs/call: # 2 times (5µs+0s) by XML::Parser::parsefile at line 220, avg 3µs/call
sub XML::Parser::CORE:binmode; # opcode
# spent 10µs within XML::Parser::CORE:close which was called 2 times, avg 5µs/call: # 2 times (10µs+0s) by XML::Parser::parsefile at line 237, avg 5µs/call
sub XML::Parser::CORE:close; # opcode
# spent 26µs within XML::Parser::CORE:open which was called 2 times, avg 13µs/call: # 2 times (26µs+0s) by XML::Parser::parsefile at line 219, avg 13µs/call
sub XML::Parser::CORE:open; # opcode
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.