← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/x86_64-linux/XML/Parser.pm
StatementsExecuted 1157 statements in 1.52ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1112.19ms2.51msXML::Parser::::BEGIN@17XML::Parser::BEGIN@17
711292µs70.4sXML::Parser::::parseXML::Parser::parse
1431141µs141µsXML::Parser::::setHandlersXML::Parser::setHandlers
71182µs82µsXML::Parser::::newXML::Parser::new
11110µs11µsXML::Parser::::BEGIN@11XML::Parser::BEGIN@11
1114µs24µsXML::Parser::::BEGIN@15XML::Parser::BEGIN@15
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::::parsefileXML::Parser::parsefile
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
11231µs213µs
# spent 11µs (10+2) within XML::Parser::BEGIN@11 which was called: # once (10µs+2µs) by XML::Twig::BEGIN@151 at line 11
use strict;
# spent 11µs making 1 call to XML::Parser::BEGIN@11 # spent 2µs making 1 call to strict::import
12
13our ( $VERSION, $LWP_load_failed );
14
15231µs245µs
# spent 24µs (4+21) within XML::Parser::BEGIN@15 which was called: # once (4µs+21µs) by XML::Twig::BEGIN@151 at line 15
use Carp;
# spent 24µs making 1 call to XML::Parser::BEGIN@15 # spent 21µs making 1 call to Exporter::import
16
17
# spent 2.51ms (2.19+321µs) within XML::Parser::BEGIN@17 which was called: # once (2.19ms+321µs) by XML::Twig::BEGIN@151 at line 22
BEGIN {
18154µs require XML::Parser::Expat;
191200ns $VERSION = '2.47';
2012µs die "Parser.pm and Expat.pm versions don't match"
21 unless $VERSION eq $XML::Parser::Expat::VERSION;
221888µs12.51ms}
# spent 2.51ms making 1 call to XML::Parser::BEGIN@17
23
241200ns$LWP_load_failed = 0;
25
26
# spent 82µs within XML::Parser::new which was called 7 times, avg 12µs/call: # 7 times (82µs+0s) by XML::Twig::new at line 465 of XML/Twig.pm, avg 12µs/call
sub new {
2774µs my ( $class, %args ) = @_;
2872µs my $style = $args{Style};
29
3074µs my $nonexopt = $args{Non_Expat_Options} ||= {};
31
3273µs $nonexopt->{Style} = 1;
3372µs $nonexopt->{Non_Expat_Options} = 1;
3472µs $nonexopt->{Handlers} = 1;
3572µs $nonexopt->{_HNDL_TYPES} = 1;
3672µs $nonexopt->{NoLWP} = 1;
37
38722µs $args{_HNDL_TYPES} = {%XML::Parser::Expat::Handler_Setters};
3973µs $args{_HNDL_TYPES}->{Init} = 1;
4072µs $args{_HNDL_TYPES}->{Final} = 1;
41
4274µs $args{Handlers} ||= {};
4371µs my $handlers = $args{Handlers};
44
4571µs 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
60 # fallback to old behaviour
61 $stylepkg = "XML::Parser::$stylepkg";
62 }
63 }
64
65 foreach my $htype ( keys %{ $args{_HNDL_TYPES} } ) {
66
67 # Handlers explicitly given override
68 # handlers from the Style package
69 unless ( defined( $handlers->{$htype} ) ) {
70
71 # A handler in the style package must either have
72 # exactly the right case as the type name or a
73 # completely lower case version of it.
74
75 my $hname = "${stylepkg}::$htype";
76 if ( defined(&$hname) ) {
77 $handlers->{$htype} = \&$hname;
78 next;
79 }
80
81 $hname = "${stylepkg}::\L$htype";
82 if ( defined(&$hname) ) {
83 $handlers->{$htype} = \&$hname;
84 next;
85 }
86 }
87 }
88 }
89
9074µs unless ( defined( $handlers->{ExternEnt} )
91 or defined( $handlers->{ExternEntFin} ) ) {
92
9373µs if ( $args{NoLWP} or $LWP_load_failed ) {
94 $handlers->{ExternEnt} = \&file_ext_ent_handler;
95 $handlers->{ExternEntFin} = \&file_ext_ent_cleanup;
96 }
97 else {
98 # The following just bootstraps the real LWP external entity
99 # handler
100
10176µs $handlers->{ExternEnt} = \&initial_ext_ent_handler;
102
103 # No cleanup function available until LWPExternEnt.pl loaded
104 }
105 }
106
10775µs $args{Pkg} ||= caller;
108711µs bless \%args, $class;
109} # End of new
110
111
# spent 141µs within XML::Parser::setHandlers which was called 14 times, avg 10µs/call: # 7 times (22µs+0s) by XML::Twig::new at line 740 of XML/Twig.pm, avg 3µs/call # 6 times (104µs+0s) by XML::Twig::new at line 734 of XML/Twig.pm, avg 17µs/call # once (16µs+0s) by XML::Twig::new at line 731 of XML/Twig.pm
sub setHandlers {
1121415µs my ( $self, @handler_pairs ) = @_;
113
114145µs croak('Uneven number of arguments to setHandlers method')
115 if ( int(@handler_pairs) & 1 );
116
117141µs my @ret;
118143µs while (@handler_pairs) {
11911815µs my $type = shift @handler_pairs;
12011810µs my $handler = shift @handler_pairs;
12111818µs unless ( defined( $self->{_HNDL_TYPES}->{$type} ) ) {
122 my @types = sort keys %{ $self->{_HNDL_TYPES} };
123
124 croak("Unknown Parser handler type: $type\n Valid types: @types");
125 }
12611826µs push( @ret, $type, $self->{Handlers}->{$type} );
12711838µs $self->{Handlers}->{$type} = $handler;
128 }
129
1301418µs return @ret;
131}
132
133sub parse_start {
134 my $self = shift;
135 my @expat_options = ();
136
137 my ( $key, $val );
138 while ( ( $key, $val ) = each %{$self} ) {
139 push( @expat_options, $key, $val )
140 unless exists $self->{Non_Expat_Options}->{$key};
141 }
142
143 my %handlers = %{ $self->{Handlers} };
144 my $init = delete $handlers{Init};
145 my $final = delete $handlers{Final};
146
147 my $expatnb = XML::Parser::ExpatNB->new( @expat_options, @_ );
148 $expatnb->setHandlers(%handlers);
149
150 &$init($expatnb)
151 if defined($init);
152
153 $expatnb->{_State_} = 1;
154
155 $expatnb->{FinalHandler} = $final
156 if defined($final);
157
158 return $expatnb;
159}
160
161
# spent 70.4s (292µs+70.4) within XML::Parser::parse which was called 7 times, avg 10.1s/call: # 7 times (292µs+70.4s) by XML::Twig::parse at line 770 of XML/Twig.pm, avg 10.1s/call
sub parse {
16271µs my $self = shift;
16371µs my $arg = shift;
16472µs my @expat_options = ();
16571µs my ( $key, $val );
16677µs while ( ( $key, $val ) = each %{$self} ) {
167 push( @expat_options, $key, $val )
16819491µs unless exists $self->{Non_Expat_Options}->{$key};
169 }
170
171716µs7126µs my $expat = XML::Parser::Expat->new( @expat_options, @_ );
# spent 126µs making 7 calls to XML::Parser::Expat::new, avg 18µs/call
172721µs my %handlers = %{ $self->{Handlers} };
17373µs my $init = delete $handlers{Init};
17472µs my $final = delete $handlers{Final};
175
176712µs7263µs $expat->setHandlers(%handlers);
# spent 263µs making 7 calls to XML::Parser::Expat::setHandlers, avg 38µs/call
177
17872µs if ( $self->{Base} ) {
179 $expat->base( $self->{Base} );
180 }
181
18276µs744µs &$init($expat)
# spent 44µs making 7 calls to XML::Twig::_twig_init, avg 6µs/call
183 if defined($init);
184
18572µs my @result = ();
1867700ns my $result;
1871425µs770.4s eval { $result = $expat->parse($arg); };
# spent 70.4s making 7 calls to XML::Parser::Expat::parse, avg 10.1s/call
18872µs my $err = $@;
18971µs if ($err) {
190 $expat->release;
191 die $err;
192 }
193
19474µs if ( $result and defined($final) ) {
195 if (wantarray) {
196 @result = &$final($expat);
197 }
198 else {
19977µs788µs $result = &$final($expat);
# spent 88µs making 7 calls to XML::Twig::_twig_final, avg 13µs/call
200 }
201 }
202
20377µs718µs $expat->release;
# spent 18µs making 7 calls to XML::Parser::Expat::release, avg 3µs/call
204
20572µs return unless defined wantarray;
206758µs7632µs return wantarray ? @result : $result;
# spent 632µs making 7 calls to XML::Parser::Expat::DESTROY, avg 90µs/call
207}
208
209sub parsestring {
210 my $self = shift;
211 $self->parse(@_);
212}
213
214sub parsefile {
215 my $self = shift;
216 my $file = shift;
217
218 open( my $fh, '<', $file ) or croak "Couldn't open $file:\n$!";
219 binmode($fh);
220 my @ret;
221 my $ret;
222
223 $self->{Base} = $file;
224
225 if (wantarray) {
226 eval { @ret = $self->parse( $fh, @_ ); };
227 }
228 else {
229 eval { $ret = $self->parse( $fh, @_ ); };
230 }
231 my $err = $@;
232 close($fh);
233 die $err if $err;
234
235 return unless defined wantarray;
236 return wantarray ? @ret : $ret;
237}
238
239sub initial_ext_ent_handler {
240
241 # This just bootstraps in the real lwp_ext_ent_handler which
242 # also loads the URI and LWP modules.
243
244 unless ($LWP_load_failed) {
245 local ($^W) = 0;
246
247 my $stat = eval { require('XML/Parser/LWPExternEnt.pl'); };
248
249 if ($stat) {
250 $_[0]->setHandlers(
251 ExternEnt => \&lwp_ext_ent_handler,
252 ExternEntFin => \&lwp_ext_ent_cleanup
253 );
254
255 goto &lwp_ext_ent_handler;
256 }
257
258 # Failed to load lwp handler, act as if NoLWP
259
260 $LWP_load_failed = 1;
261
262 my $cmsg = "Couldn't load LWP based external entity handler\n" . "Switching to file-based external entity handler\n" . " (To avoid this message, use NoLWP option to XML::Parser)\n";
263 warn($cmsg);
264 }
265
266 $_[0]->setHandlers(
267 ExternEnt => \&file_ext_ent_handler,
268 ExternEntFin => \&file_ext_ent_cleanup
269 );
270 goto &file_ext_ent_handler;
271
272}
273
274sub file_ext_ent_handler {
275 my ( $xp, $base, $path ) = @_;
276
277 # Prepend base only for relative paths
278
279 if ( defined($base)
280 and not( $path =~ m!^(?:[\\/]|\w+:)! ) ) {
281 my $newpath = $base;
282 $newpath =~ s![^\\/:]*$!$path!;
283 $path = $newpath;
284 }
285
286 if ( $path =~ /^\s*[|>+]/
287 or $path =~ /\|\s*$/ ) {
288 $xp->{ErrorMessage} .= "System ID ($path) contains Perl IO control characters";
289 return undef;
290 }
291
292 require IO::File;
293 my $fh = IO::File->new($path);
294 unless ( defined $fh ) {
295 $xp->{ErrorMessage} .= "Failed to open $path:\n$!";
296 return undef;
297 }
298
299 $xp->{_BaseStack} ||= [];
300 $xp->{_FhStack} ||= [];
301
302 push( @{ $xp->{_BaseStack} }, $base );
303 push( @{ $xp->{_FhStack} }, $fh );
304
305 $xp->base($path);
306
307 return $fh;
308}
309
310sub file_ext_ent_cleanup {
311 my ($xp) = @_;
312
313 my $fh = pop( @{ $xp->{_FhStack} } );
314 $fh->close;
315
316 my $base = pop( @{ $xp->{_BaseStack} } );
317 $xp->base($base);
318}
319
32012µs1;
321
322__END__