← Index
NYTProf Performance Profile   « block view • line view • sub view »
For conv.pl
  Run on Sun Nov 14 21:14:18 2010
Reported on Sun Nov 14 21:17:51 2010

Filename/usr/lib/perl5/XML/Parser.pm
StatementsExecuted 690014 statements in 1.61s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
500011791ms791msXML::Parser::::setHandlersXML::Parser::setHandlers
500011588ms86.2sXML::Parser::::parseXML::Parser::parse
500011273ms273msXML::Parser::::newXML::Parser::new
1115.06ms6.93msXML::Parser::::BEGIN@13XML::Parser::BEGIN@13
11124µs109µsXML::Parser::::BEGIN@11XML::Parser::BEGIN@11
11116µs24µsXML::Parser::::BEGIN@20XML::Parser::BEGIN@20
11115µs82µsXML::Parser::::BEGIN@22XML::Parser::BEGIN@22
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
11376µs2194µs
# spent 109µs (24+85) within XML::Parser::BEGIN@11 which was called: # once (24µs+85µs) by XML::SAX::Expat::BEGIN@11 at line 11
use Carp;
# spent 109µs making 1 call to XML::Parser::BEGIN@11 # spent 85µs making 1 call to Exporter::import
12
13
# spent 6.93ms (5.06+1.87) within XML::Parser::BEGIN@13 which was called: # once (5.06ms+1.87ms) by XML::SAX::Expat::BEGIN@11 at line 18
BEGIN {
143122µs require XML::Parser::Expat;
15 $VERSION = '2.36';
16 die "Parser.pm and Expat.pm versions don't match"
17 unless $VERSION eq $XML::Parser::Expat::VERSION;
18136µs16.93ms}
# spent 6.93ms making 1 call to XML::Parser::BEGIN@13
19
20344µs232µs
# spent 24µs (16+8) within XML::Parser::BEGIN@20 which was called: # once (16µs+8µs) by XML::SAX::Expat::BEGIN@11 at line 20
use strict;
# spent 24µs making 1 call to XML::Parser::BEGIN@20 # spent 8µs making 1 call to strict::import
21
2231.80ms2149µs
# spent 82µs (15+67) within XML::Parser::BEGIN@22 which was called: # once (15µs+67µs) by XML::SAX::Expat::BEGIN@11 at line 22
use vars qw($VERSION $LWP_load_failed);
# spent 82µs making 1 call to XML::Parser::BEGIN@22 # spent 67µs making 1 call to vars::import
23
2411µs$LWP_load_failed = 0;
25
26
# spent 273ms within XML::Parser::new which was called 5000 times, avg 55µs/call: # 5000 times (273ms+0s) by XML::SAX::Expat::_create_parser at line 96 of XML/SAX/Expat.pm, avg 55µs/call
sub new {
2795000278ms my ($class, %args) = @_;
28 my $style = $args{Style};
29
30 my $nonexopt = $args{Non_Expat_Options} ||= {};
31
32 $nonexopt->{Style} = 1;
33 $nonexopt->{Non_Expat_Options} = 1;
34 $nonexopt->{Handlers} = 1;
35 $nonexopt->{_HNDL_TYPES} = 1;
36 $nonexopt->{NoLWP} = 1;
37
38 $args{_HNDL_TYPES} = {%XML::Parser::Expat::Handler_Setters};
39 $args{_HNDL_TYPES}->{Init} = 1;
40 $args{_HNDL_TYPES}->{Final} = 1;
41
42 $args{Handlers} ||= {};
43 my $handlers = $args{Handlers};
44
45 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
89 unless (defined($handlers->{ExternEnt})
90 or defined ($handlers->{ExternEntFin})) {
91
92 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
100 $handlers->{ExternEnt} = \&initial_ext_ent_handler;
101
102 # No cleanup function available until LWPExternEnt.pl loaded
103 }
104 }
105
106 $args{Pkg} ||= caller;
107 bless \%args, $class;
108} # End of new
109
110
# spent 791ms within XML::Parser::setHandlers which was called 5000 times, avg 158µs/call: # 5000 times (791ms+0s) by XML::SAX::Expat::_create_parser at line 98 of XML/SAX/Expat.pm, avg 158µs/call
sub setHandlers {
111450000795ms my ($self, @handler_pairs) = @_;
112
113 croak("Uneven number of arguments to setHandlers method")
114 if (int(@handler_pairs) & 1);
115
116 my @ret;
117 while (@handler_pairs) {
118 my $type = shift @handler_pairs;
119 my $handler = shift @handler_pairs;
120 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 }
125 push(@ret, $type, $self->{Handlers}->{$type});
126 $self->{Handlers}->{$type} = $handler;
127 }
128
129 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 = new XML::Parser::ExpatNB(@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 86.2s (588ms+85.6) within XML::Parser::parse which was called 5000 times, avg 17.2ms/call: # 5000 times (588ms+85.6s) by XML::SAX::Expat::_parse_string at line 60 of XML/SAX/Expat.pm, avg 17.2ms/call
sub parse {
161145000535ms my $self = shift;
162 my $arg = shift;
163 my @expat_options = ();
164 my ($key, $val);
165 while (($key, $val) = each %{$self}) {
166 push(@expat_options, $key, $val)
167 unless exists $self->{Non_Expat_Options}->{$key};
168 }
169
1705000198ms my $expat = new XML::Parser::Expat(@expat_options, @_);
# spent 198ms making 5000 calls to XML::Parser::Expat::new, avg 40µs/call
171 my %handlers = %{$self->{Handlers}};
172 my $init = delete $handlers{Init};
173 my $final = delete $handlers{Final};
174
17550001.47s $expat->setHandlers(%handlers);
# spent 1.47s making 5000 calls to XML::Parser::Expat::setHandlers, avg 293µs/call
176
177 if ($self->{Base}) {
178 $expat->base($self->{Base});
179 }
180
181500017.1ms &$init($expat)
# spent 17.1ms making 5000 calls to XML::SAX::Expat::_handle_init, avg 3µs/call
182 if defined($init);
183
184 my @result = ();
185 my $result;
186 eval {
187500083.4s $result = $expat->parse($arg);
# spent 83.4s making 5000 calls to XML::Parser::Expat::parse, avg 16.7ms/call
188 };
189 my $err = $@;
190 if ($err) {
191 $expat->release;
192 die $err;
193 }
194
195 if ($result and defined($final)) {
196 if (wantarray) {
197 @result = &$final($expat);
198 }
199 else {
2005000365ms $result = &$final($expat);
# spent 365ms making 5000 calls to XML::SAX::Expat::_handle_final, avg 73µs/call
201 }
202 }
203
204500061.0ms $expat->release;
# spent 61.0ms making 5000 calls to XML::Parser::Expat::release, avg 12µs/call
205
206 return unless defined wantarray;
207 return wantarray ? @result : $result;
208}
209
210sub parsestring {
211 my $self = shift;
212 $self->parse(@_);
213}
214
215sub parsefile {
216 my $self = shift;
217 my $file = shift;
218 local(*FILE);
219 open(FILE, $file) or croak "Couldn't open $file:\n$!";
220 binmode(FILE);
221 my @ret;
222 my $ret;
223
224 $self->{Base} = $file;
225
226 if (wantarray) {
227 eval {
228 @ret = $self->parse(*FILE, @_);
229 };
230 }
231 else {
232 eval {
233 $ret = $self->parse(*FILE, @_);
234 };
235 }
236 my $err = $@;
237 close(FILE);
238 die $err if $err;
239
240 return unless defined wantarray;
241 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 = new IO::File($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
32814µs1;
329
330__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.