← 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/share/perl5/XML/NamespaceSupport.pm
StatementsExecuted 7682068 statements in 17.0s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
479680218.30s8.30sXML::NamespaceSupport::::_get_ns_detailsXML::NamespaceSupport::_get_ns_details
294381113.16s8.28sXML::NamespaceSupport::::process_attribute_nameXML::NamespaceSupport::process_attribute_name
185299111.97s5.14sXML::NamespaceSupport::::process_element_nameXML::NamespaceSupport::process_element_name
185299111.59s1.59sXML::NamespaceSupport::::push_contextXML::NamespaceSupport::push_context
185299111.12s1.12sXML::NamespaceSupport::::pop_contextXML::NamespaceSupport::pop_context
500011103ms103msXML::NamespaceSupport::::newXML::NamespaceSupport::new
11121µs27µsXML::NamespaceSupport::::BEGIN@8XML::NamespaceSupport::BEGIN@8
11119µs43µsXML::NamespaceSupport::::BEGIN@110XML::NamespaceSupport::BEGIN@110
11119µs83µsXML::NamespaceSupport::::BEGIN@12XML::NamespaceSupport::BEGIN@12
11118µs45µsXML::NamespaceSupport::::BEGIN@99XML::NamespaceSupport::BEGIN@99
11118µs115µsXML::NamespaceSupport::::BEGIN@18XML::NamespaceSupport::BEGIN@18
11117µs82µsXML::NamespaceSupport::::BEGIN@13XML::NamespaceSupport::BEGIN@13
11115µs97µsXML::NamespaceSupport::::BEGIN@9XML::NamespaceSupport::BEGIN@9
11114µs75µsXML::NamespaceSupport::::BEGIN@16XML::NamespaceSupport::BEGIN@16
11114µs77µsXML::NamespaceSupport::::BEGIN@15XML::NamespaceSupport::BEGIN@15
11113µs85µsXML::NamespaceSupport::::BEGIN@11XML::NamespaceSupport::BEGIN@11
11113µs80µsXML::NamespaceSupport::::BEGIN@14XML::NamespaceSupport::BEGIN@14
11112µs84µsXML::NamespaceSupport::::BEGIN@10XML::NamespaceSupport::BEGIN@10
0000s0sXML::NamespaceSupport::::declare_prefixXML::NamespaceSupport::declare_prefix
0000s0sXML::NamespaceSupport::::declare_prefixesXML::NamespaceSupport::declare_prefixes
0000s0sXML::NamespaceSupport::::get_declared_prefixesXML::NamespaceSupport::get_declared_prefixes
0000s0sXML::NamespaceSupport::::get_prefixXML::NamespaceSupport::get_prefix
0000s0sXML::NamespaceSupport::::get_prefixesXML::NamespaceSupport::get_prefixes
0000s0sXML::NamespaceSupport::::get_uriXML::NamespaceSupport::get_uri
0000s0sXML::NamespaceSupport::::parse_jclark_notationXML::NamespaceSupport::parse_jclark_notation
0000s0sXML::NamespaceSupport::::process_nameXML::NamespaceSupport::process_name
0000s0sXML::NamespaceSupport::::resetXML::NamespaceSupport::reset
0000s0sXML::NamespaceSupport::::undeclare_prefixXML::NamespaceSupport::undeclare_prefix
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1
2###
3# XML::NamespaceSupport - a simple generic namespace processor
4# Robin Berjon <robin@knowscape.com>
5###
6
7package XML::NamespaceSupport;
8341µs233µs
# spent 27µs (21+6) within XML::NamespaceSupport::BEGIN@8 which was called: # once (21µs+6µs) by XML::SAX::Expat::BEGIN@10 at line 8
use strict;
# spent 27µs making 1 call to XML::NamespaceSupport::BEGIN@8 # spent 6µs making 1 call to strict::import
9344µs2179µs
# spent 97µs (15+82) within XML::NamespaceSupport::BEGIN@9 which was called: # once (15µs+82µs) by XML::SAX::Expat::BEGIN@10 at line 9
use constant FATALS => 0; # root object
# spent 97µs making 1 call to XML::NamespaceSupport::BEGIN@9 # spent 82µs making 1 call to constant::import
10340µs2156µs
# spent 84µs (12+72) within XML::NamespaceSupport::BEGIN@10 which was called: # once (12µs+72µs) by XML::SAX::Expat::BEGIN@10 at line 10
use constant NSMAP => 1;
# spent 84µs making 1 call to XML::NamespaceSupport::BEGIN@10 # spent 72µs making 1 call to constant::import
11347µs2157µs
# spent 85µs (13+72) within XML::NamespaceSupport::BEGIN@11 which was called: # once (13µs+72µs) by XML::SAX::Expat::BEGIN@10 at line 11
use constant UNKNOWN_PREF => 2;
# spent 85µs making 1 call to XML::NamespaceSupport::BEGIN@11 # spent 72µs making 1 call to constant::import
12339µs2147µs
# spent 83µs (19+64) within XML::NamespaceSupport::BEGIN@12 which was called: # once (19µs+64µs) by XML::SAX::Expat::BEGIN@10 at line 12
use constant AUTO_PREFIX => 3;
# spent 83µs making 1 call to XML::NamespaceSupport::BEGIN@12 # spent 64µs making 1 call to constant::import
13342µs2147µs
# spent 82µs (17+65) within XML::NamespaceSupport::BEGIN@13 which was called: # once (17µs+65µs) by XML::SAX::Expat::BEGIN@10 at line 13
use constant XMLNS_11 => 4;
# spent 82µs making 1 call to XML::NamespaceSupport::BEGIN@13 # spent 65µs making 1 call to constant::import
14340µs2147µs
# spent 80µs (13+67) within XML::NamespaceSupport::BEGIN@14 which was called: # once (13µs+67µs) by XML::SAX::Expat::BEGIN@10 at line 14
use constant DEFAULT => 0; # maps
# spent 80µs making 1 call to XML::NamespaceSupport::BEGIN@14 # spent 67µs making 1 call to constant::import
15342µs2140µs
# spent 77µs (14+63) within XML::NamespaceSupport::BEGIN@15 which was called: # once (14µs+63µs) by XML::SAX::Expat::BEGIN@10 at line 15
use constant PREFIX_MAP => 1;
# spent 77µs making 1 call to XML::NamespaceSupport::BEGIN@15 # spent 63µs making 1 call to constant::import
16343µs2136µs
# spent 75µs (14+61) within XML::NamespaceSupport::BEGIN@16 which was called: # once (14µs+61µs) by XML::SAX::Expat::BEGIN@10 at line 16
use constant DECLARATIONS => 2;
# spent 75µs making 1 call to XML::NamespaceSupport::BEGIN@16 # spent 61µs making 1 call to constant::import
17
183462µs2212µs
# spent 115µs (18+97) within XML::NamespaceSupport::BEGIN@18 which was called: # once (18µs+97µs) by XML::SAX::Expat::BEGIN@10 at line 18
use vars qw($VERSION $NS_XMLNS $NS_XML);
# spent 115µs making 1 call to XML::NamespaceSupport::BEGIN@18 # spent 97µs making 1 call to vars::import
1912µs$VERSION = '1.09';
2011µs$NS_XMLNS = 'http://www.w3.org/2000/xmlns/';
2111µs$NS_XML = 'http://www.w3.org/XML/1998/namespace';
22
23
24# add the ns stuff that baud wants based on Java's xml-writer
25
26
27#-------------------------------------------------------------------#
28# constructor
29#-------------------------------------------------------------------#
30
# spent 103ms within XML::NamespaceSupport::new which was called 5000 times, avg 21µs/call: # 5000 times (103ms+0s) by XML::SAX::Expat::_create_parser at line 123 of XML/SAX/Expat.pm, avg 21µs/call
sub new {
3140000108ms my $class = ref($_[0]) ? ref(shift) : shift;
32 my $options = shift;
33 my $self = [
34 1, # FATALS
35 [[ # NSMAP
36 undef, # DEFAULT
37 { xml => $NS_XML }, # PREFIX_MAP
38 undef, # DECLARATIONS
39 ]],
40 'aaa', # UNKNOWN_PREF
41 0, # AUTO_PREFIX
42 1, # XML_11
43 ];
44 $self->[NSMAP]->[0]->[PREFIX_MAP]->{xmlns} = $NS_XMLNS if $options->{xmlns};
45 $self->[FATALS] = $options->{fatal_errors} if defined $options->{fatal_errors};
46 $self->[AUTO_PREFIX] = $options->{auto_prefix} if defined $options->{auto_prefix};
47 $self->[XMLNS_11] = $options->{xmlns_11} if defined $options->{xmlns_11};
48 return bless $self, $class;
49}
50#-------------------------------------------------------------------#
51
52#-------------------------------------------------------------------#
53# reset() - return to the original state (for reuse)
54#-------------------------------------------------------------------#
55sub reset {
56 my $self = shift;
57 $#{$self->[NSMAP]} = 0;
58}
59#-------------------------------------------------------------------#
60
61#-------------------------------------------------------------------#
62# push_context() - add a new empty context to the stack
63#-------------------------------------------------------------------#
64
# spent 1.59s within XML::NamespaceSupport::push_context which was called 185299 times, avg 9µs/call: # 185299 times (1.59s+0s) by XML::SAX::Expat::_handle_start at line 184 of XML/SAX/Expat.pm, avg 9µs/call
sub push_context {
653705981.89s my $self = shift;
66 push @{$self->[NSMAP]}, [
67 $self->[NSMAP]->[-1]->[DEFAULT],
68 { %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} },
69 [],
70 ];
71}
72#-------------------------------------------------------------------#
73
74#-------------------------------------------------------------------#
75# pop_context() - remove the topmost context fromt the stack
76#-------------------------------------------------------------------#
77
# spent 1.12s within XML::NamespaceSupport::pop_context which was called 185299 times, avg 6µs/call: # 185299 times (1.12s+0s) by XML::SAX::Expat::_handle_end at line 243 of XML/SAX/Expat.pm, avg 6µs/call
sub pop_context {
785558971.31s my $self = shift;
79 die 'Trying to pop context without push context' unless @{$self->[NSMAP]} > 1;
80 pop @{$self->[NSMAP]};
81}
82#-------------------------------------------------------------------#
83
84#-------------------------------------------------------------------#
85# declare_prefix() - declare a prefix in the current scope
86#-------------------------------------------------------------------#
87sub declare_prefix {
88 my $self = shift;
89 my $prefix = shift;
90 my $value = shift;
91
92 warn <<' EOWARN' unless defined $prefix or $self->[AUTO_PREFIX];
93 Prefix was undefined.
94 If you wish to set the default namespace, use the empty string ''.
95 If you wish to autogenerate prefixes, set the auto_prefix option
96 to a true value.
97 EOWARN
98
993139µs272µs
# spent 45µs (18+27) within XML::NamespaceSupport::BEGIN@99 which was called: # once (18µs+27µs) by XML::SAX::Expat::BEGIN@10 at line 99
no warnings 'uninitialized';
# spent 45µs making 1 call to XML::NamespaceSupport::BEGIN@99 # spent 27µs making 1 call to warnings::unimport
100 if ($prefix eq 'xml' and $value ne $NS_XML) {
101 die "The xml prefix can only be bound to the $NS_XML namespace."
102 }
103 elsif ($value eq $NS_XML and $prefix ne 'xml') {
104 die "the $NS_XML namespace can only be bound to the xml prefix.";
105 }
106 elsif ($value eq $NS_XML and $prefix eq 'xml') {
107 return 1;
108 }
109 return 0 if index(lc($prefix), 'xml') == 0;
11031.55ms267µs
# spent 43µs (19+24) within XML::NamespaceSupport::BEGIN@110 which was called: # once (19µs+24µs) by XML::SAX::Expat::BEGIN@10 at line 110
use warnings 'uninitialized';
# spent 43µs making 1 call to XML::NamespaceSupport::BEGIN@110 # spent 24µs making 1 call to warnings::import
111
112 if (defined $prefix and $prefix eq '') {
113 $self->[NSMAP]->[-1]->[DEFAULT] = $value;
114 }
115 else {
116 die "Cannot undeclare prefix $prefix" if $value eq '' and not $self->[XMLNS_11];
117 if (not defined $prefix and $self->[AUTO_PREFIX]) {
118 while (1) {
119 $prefix = $self->[UNKNOWN_PREF]++;
120 last if not exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
121 }
122 }
123 elsif (not defined $prefix and not $self->[AUTO_PREFIX]) {
124 return 0;
125 }
126 $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} = $value;
127 }
128 push @{$self->[NSMAP]->[-1]->[DECLARATIONS]}, $prefix;
129 return 1;
130}
131#-------------------------------------------------------------------#
132
133#-------------------------------------------------------------------#
134# declare_prefixes() - declare several prefixes in the current scope
135#-------------------------------------------------------------------#
136sub declare_prefixes {
137 my $self = shift;
138 my %prefixes = @_;
139 while (my ($k,$v) = each %prefixes) {
140 $self->declare_prefix($k,$v);
141 }
142}
143#-------------------------------------------------------------------#
144
145#-------------------------------------------------------------------#
146# undeclare_prefix
147#-------------------------------------------------------------------#
148sub undeclare_prefix {
149 my $self = shift;
150 my $prefix = shift;
151 return unless not defined $prefix or $prefix eq '';
152 return unless exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
153
154 my ( $tfix ) = grep { $_ eq $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]};
155 if ( not defined $tfix ) {
156 die "prefix $prefix not declared in this context\n";
157 }
158
159 @{$self->[NSMAP]->[-1]->[DECLARATIONS]} = grep { $_ ne $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]};
160 delete $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
161}
162#-------------------------------------------------------------------#
163
164#-------------------------------------------------------------------#
165# get_prefix() - get a (random) prefix for a given URI
166#-------------------------------------------------------------------#
167sub get_prefix {
168 my $self = shift;
169 my $uri = shift;
170
171 # we have to iterate over the whole hash here because if we don't
172 # the iterator isn't reset and the next pass will fail
173 my $pref;
174 while (my ($k, $v) = each %{$self->[NSMAP]->[-1]->[PREFIX_MAP]}) {
175 $pref = $k if $v eq $uri;
176 }
177 return $pref;
178}
179#-------------------------------------------------------------------#
180
181#-------------------------------------------------------------------#
182# get_prefixes() - get all the prefixes for a given URI
183#-------------------------------------------------------------------#
184sub get_prefixes {
185 my $self = shift;
186 my $uri = shift;
187
188 return keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} unless defined $uri;
189 return grep { $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$_} eq $uri } keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]};
190}
191#-------------------------------------------------------------------#
192
193#-------------------------------------------------------------------#
194# get_declared_prefixes() - get all prefixes declared in the last context
195#-------------------------------------------------------------------#
196sub get_declared_prefixes {
197 return @{$_[0]->[NSMAP]->[-1]->[DECLARATIONS]};
198}
199#-------------------------------------------------------------------#
200
201#-------------------------------------------------------------------#
202# get_uri() - get an URI given a prefix
203#-------------------------------------------------------------------#
204sub get_uri {
205 my $self = shift;
206 my $prefix = shift;
207
208 warn "Prefix must not be undef in get_uri(). The emtpy prefix must be ''" unless defined $prefix;
209
210 return $self->[NSMAP]->[-1]->[DEFAULT] if $prefix eq '';
211 return $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} if exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
212 return undef;
213}
214#-------------------------------------------------------------------#
215
216#-------------------------------------------------------------------#
217# process_name() - provide details on a name
218#-------------------------------------------------------------------#
219sub process_name {
220 my $self = shift;
221 my $qname = shift;
222 my $aflag = shift;
223
224 if ($self->[FATALS]) {
225 return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname );
226 }
227 else {
228 eval { return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname ); }
229 }
230}
231#-------------------------------------------------------------------#
232
233#-------------------------------------------------------------------#
234# process_element_name() - provide details on a element's name
235#-------------------------------------------------------------------#
236
# spent 5.14s (1.97+3.18) within XML::NamespaceSupport::process_element_name which was called 185299 times, avg 28µs/call: # 185299 times (1.97s+3.18s) by XML::SAX::Expat::_handle_start at line 215 of XML/SAX/Expat.pm, avg 28µs/call
sub process_element_name {
2375558971.76s my $self = shift;
238 my $qname = shift;
239
2401852993.18s if ($self->[FATALS]) {
# spent 3.18s making 185299 calls to XML::NamespaceSupport::_get_ns_details, avg 17µs/call
241 return $self->_get_ns_details($qname, 0);
242 }
243 else {
244 eval { return $self->_get_ns_details($qname, 0); }
245 }
246}
247#-------------------------------------------------------------------#
248
249
250#-------------------------------------------------------------------#
251# process_attribute_name() - provide details on a attribute's name
252#-------------------------------------------------------------------#
253
# spent 8.28s (3.16+5.12) within XML::NamespaceSupport::process_attribute_name which was called 294381 times, avg 28µs/call: # 294381 times (3.16s+5.12s) by XML::SAX::Expat::_handle_start at line 202 of XML/SAX/Expat.pm, avg 28µs/call
sub process_attribute_name {
2548831432.80s my $self = shift;
255 my $qname = shift;
256
2572943815.12s if ($self->[FATALS]) {
# spent 5.12s making 294381 calls to XML::NamespaceSupport::_get_ns_details, avg 17µs/call
258 return $self->_get_ns_details($qname, 1);
259 }
260 else {
261 eval { return $self->_get_ns_details($qname, 1); }
262 }
263}
264#-------------------------------------------------------------------#
265
266
267#-------------------------------------------------------------------#
268# ($ns, $prefix, $lname) = $self->_get_ns_details($qname, $f_attr)
269# returns ns, prefix, and lname for a given attribute name
270# >> the $f_attr flag, if set to one, will work for an attribute
271#-------------------------------------------------------------------#
272
# spent 8.30s within XML::NamespaceSupport::_get_ns_details which was called 479680 times, avg 17µs/call: # 294381 times (5.12s+0s) by XML::NamespaceSupport::process_attribute_name at line 257, avg 17µs/call # 185299 times (3.18s+0s) by XML::NamespaceSupport::process_element_name at line 240, avg 17µs/call
sub _get_ns_details {
27352764809.18s my $self = shift;
274 my $qname = shift;
275 my $aflag = shift;
276
277 my ($ns, $prefix, $lname);
278 (my ($tmp_prefix, $tmp_lname) = split /:/, $qname, 3)
279 < 3 or die "Invalid QName: $qname";
280
281 # no prefix
282 my $cur_map = $self->[NSMAP]->[-1];
283 if (not defined($tmp_lname)) {
284 $prefix = undef;
285 $lname = $qname;
286 # attr don't have a default namespace
287 $ns = ($aflag) ? undef : $cur_map->[DEFAULT];
288 }
289
290 # prefix
291 else {
292 if (exists $cur_map->[PREFIX_MAP]->{$tmp_prefix}) {
293 $prefix = $tmp_prefix;
294 $lname = $tmp_lname;
295 $ns = $cur_map->[PREFIX_MAP]->{$prefix}
296 }
297 else { # no ns -> lname == name, all rest undef
298 die "Undeclared prefix: $tmp_prefix";
299 }
300 }
301
302 return ($ns, $prefix, $lname);
303}
304#-------------------------------------------------------------------#
305
306#-------------------------------------------------------------------#
307# parse_jclark_notation() - parse the Clarkian notation
308#-------------------------------------------------------------------#
309sub parse_jclark_notation {
310 shift;
311 my $jc = shift;
312 $jc =~ m/^\{(.*)\}([^}]+)$/;
313 return $1, $2;
314}
315#-------------------------------------------------------------------#
316
317
318#-------------------------------------------------------------------#
319# Java names mapping
320#-------------------------------------------------------------------#
32112µs*XML::NamespaceSupport::pushContext = \&push_context;
32211µs*XML::NamespaceSupport::popContext = \&pop_context;
32312µs*XML::NamespaceSupport::declarePrefix = \&declare_prefix;
32411µs*XML::NamespaceSupport::declarePrefixes = \&declare_prefixes;
32511µs*XML::NamespaceSupport::getPrefix = \&get_prefix;
32611µs*XML::NamespaceSupport::getPrefixes = \&get_prefixes;
32711µs*XML::NamespaceSupport::getDeclaredPrefixes = \&get_declared_prefixes;
32812µs*XML::NamespaceSupport::getURI = \&get_uri;
32911µs*XML::NamespaceSupport::processName = \&process_name;
33011µs*XML::NamespaceSupport::processElementName = \&process_element_name;
33112µs*XML::NamespaceSupport::processAttributeName = \&process_attribute_name;
33211µs*XML::NamespaceSupport::parseJClarkNotation = \&parse_jclark_notation;
33311µs*XML::NamespaceSupport::undeclarePrefix = \&undeclare_prefix;
334#-------------------------------------------------------------------#
335
336
337118µs1;
338#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,#
339#`,`, Documentation `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,#
340#```````````````````````````````````````````````````````````````````#
341
342=pod
343
- -
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.