← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:11 2010

File /usr/share/perl5/XML/SAX.pm
Statements Executed 168
Total Time 0.0023494 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111291µs291µsXML::SAX::::_parse_ini_fileXML::SAX::_parse_ini_file
11189µs558µsXML::SAX::::load_parsersXML::SAX::load_parsers
11110µs568µsXML::SAX::::parsersXML::SAX::parsers
0000s0sXML::SAX::::BEGINXML::SAX::BEGIN
0000s0sXML::SAX::::add_parserXML::SAX::add_parser
0000s0sXML::SAX::::do_warnXML::SAX::do_warn
0000s0sXML::SAX::::remove_parserXML::SAX::remove_parser
0000s0sXML::SAX::::save_parsersXML::SAX::save_parsers
0000s0sXML::SAX::::save_parsers_debianXML::SAX::save_parsers_debian
LineStmts.Exclusive
Time
Avg.Code
1# $Id: SAX.pm,v 1.29 2007/06/27 09:09:12 grant Exp $
2
3package XML::SAX;
4
5332µs11µsuse strict;
# spent 7µs making 1 call to strict::import
6334µs11µsuse vars qw($VERSION @ISA @EXPORT_OK);
# spent 59µs making 1 call to vars::import
7
81800ns800ns$VERSION = '0.16';
9
10342µs14µsuse Exporter ();
1118µs8µs@ISA = ('Exporter');
12
1311µs1µs@EXPORT_OK = qw(Namespaces Validation);
14
153205µs68µsuse File::Basename qw(dirname);
# spent 67µs making 1 call to Exporter::import
163140µs47µsuse File::Spec ();
17329µs10µsuse Symbol qw(gensym);
# spent 49µs making 1 call to Exporter::import
183127µs42µsuse XML::SAX::ParserFactory (); # loaded for simplicity
19
20344µs15µsuse constant PARSER_DETAILS => "ParserDetails.ini";
# spent 49µs making 1 call to constant::import
21
22325µs8µsuse constant Namespaces => "http://xml.org/sax/features/namespaces";
# spent 35µs making 1 call to constant::import
2331.25ms415µsuse constant Validation => "http://xml.org/sax/features/validation";
# spent 39µs making 1 call to constant::import
24
251400ns400nsmy $known_parsers = undef;
26
27# load_parsers takes the ParserDetails.ini file out of the same directory
28# that XML::SAX is in, and looks at it. Format in POD below
29
30=begin EXAMPLE
31
32[XML::SAX::PurePerl]
33http://xml.org/sax/features/namespaces = 1
34http://xml.org/sax/features/validation = 0
35# a comment
36
37# blank lines ignored
38
39[XML::SAX::AnotherParser]
40http://xml.org/sax/features/namespaces = 0
41http://xml.org/sax/features/validation = 1
42
43=end EXAMPLE
44
45=cut
46
47
# spent 558µs (89+469) within XML::SAX::load_parsers which was called # once (89µs+469µs) by XML::SAX::parsers at line 114
sub load_parsers {
4811µs1µs my $class = shift;
491800ns800ns my $dir = shift;
50
51 # reset parsers
5211µs1µs $known_parsers = [];
53
54 # get directory from wherever XML::SAX is installed
5511µs1µs if (!$dir) {
5612µs2µs $dir = $INC{'XML/SAX.pm'};
5718µs8µs $dir = dirname($dir);
# spent 88µs making 1 call to File::Basename::dirname
58 }
59
60112µs12µs my $fh = gensym();
# spent 21µs making 1 call to Symbol::gensym
61165µs65µs if (!open($fh, File::Spec->catfile($dir, "SAX", PARSER_DETAILS))) {
# spent 69µs making 1 call to File::Spec::Unix::catfile
62 XML::SAX->do_warn("could not find " . PARSER_DETAILS . " in $dir/SAX\n");
63 return $class;
64 }
65
66110µs10µs $known_parsers = $class->_parse_ini_file($fh);
# spent 291µs making 1 call to XML::SAX::_parse_ini_file
67
6814µs4µs return $class;
69}
70
71
# spent 291µs within XML::SAX::_parse_ini_file which was called # once (291µs+0s) by XML::SAX::load_parsers at line 66
sub _parse_ini_file {
7211µs1µs my $class = shift;
7311µs1µs my ($fh) = @_;
74
751400ns400ns my @config;
76
771600ns600ns my $lineno = 0;
78140µs40µs while (defined(my $line = <$fh>)) {
79143µs221ns $lineno++;
80146µs400ns my $original = $line;
81 # strip whitespace
821478µs6µs $line =~ s/\s*$//m;
831414µs1µs $line =~ s/^\s*//m;
84 # strip comments
85149µs636ns $line =~ s/[#;].*$//m;
86 # ignore blanks
87149µs671ns next if $line =~ /^$/m;
88
89 # heading
901067µs7µs if ($line =~ /^\[\s*(.*)\s*\]$/m) {
91414µs3µs push @config, { Name => $1 };
9242µs600ns next;
93 }
94
95 # instruction
96 elsif ($line =~ /^(.*?)\s*?=\s*(.*)$/) {
9763µs483ns unless(@config) {
98 push @config, { Name => '' };
99 }
100634µs6µs $config[-1]{Features}{$1} = $2;
101 }
102
103 # not whitespace, comment, or instruction
104 else {
105 die "Invalid line in ini: $lineno\n>>> $original\n";
106 }
107 }
108
10912µs2µs return \@config;
110}
111
112
# spent 568µs (10+558) within XML::SAX::parsers which was called # once (10µs+558µs) by XML::SAX::ParserFactory::new at line 18 of /usr/share/perl5/XML/SAX/ParserFactory.pm
sub parsers {
1131900ns900ns my $class = shift;
114113µs13µs if (!$known_parsers) {
# spent 558µs making 1 call to XML::SAX::load_parsers
115 $class->load_parsers();
116 }
11711µs1µs return $known_parsers;
118}
119
120sub remove_parser {
121 my $class = shift;
122 my ($parser_module) = @_;
123
124 if (!$known_parsers) {
125 $class->load_parsers();
126 }
127
128 @$known_parsers = grep { $_->{Name} ne $parser_module } @$known_parsers;
129
130 return $class;
131}
132
133sub add_parser {
134 my $class = shift;
135 my ($parser_module) = @_;
136
137 if (!$known_parsers) {
138 $class->load_parsers();
139 }
140
141 # first load module, then query features, then push onto known_parsers,
142
143 my $parser_file = $parser_module;
144 $parser_file =~ s/::/\//g;
145 $parser_file .= ".pm";
146
147 require $parser_file;
148
149 my @features = $parser_module->supported_features();
150
151 my $new = { Name => $parser_module };
152 foreach my $feature (@features) {
153 $new->{Features}{$feature} = 1;
154 }
155
156 # If exists in list already, move to end.
157 my $done = 0;
158 my $pos = undef;
159 for (my $i = 0; $i < @$known_parsers; $i++) {
160 my $p = $known_parsers->[$i];
161 if ($p->{Name} eq $parser_module) {
162 $pos = $i;
163 }
164 }
165 if (defined $pos) {
166 splice(@$known_parsers, $pos, 1);
167 push @$known_parsers, $new;
168 $done++;
169 }
170
171 # Otherwise (not in list), add at end of list.
172 if (!$done) {
173 push @$known_parsers, $new;
174 }
175
176 return $class;
177}
178
179sub save_parsers {
180 my $class = shift;
181
182 ### DEBIAN MODIFICATION
183 print "\n";
184 print "Please use 'update-perl-sax-parsers(8) to register this parser.'\n";
185 print "See /usr/share/doc/libxml-sax-perl/README.Debian.gz for more info.\n";
186 print "\n";
187
188 return $class; # rest of the function is disabled on Debian.
189 ### END DEBIAN MODIFICATION
190
191 # get directory from wherever XML::SAX is installed
192 my $dir = $INC{'XML/SAX.pm'};
193 $dir = dirname($dir);
194
195 my $file = File::Spec->catfile($dir, "SAX", PARSER_DETAILS);
196 chmod 0644, $file;
197 unlink($file);
198
199 my $fh = gensym();
200 open($fh, ">$file") ||
201 die "Cannot write to $file: $!";
202
203 foreach my $p (@$known_parsers) {
204 print $fh "[$p->{Name}]\n";
205 foreach my $key (keys %{$p->{Features}}) {
206 print $fh "$key = $p->{Features}{$key}\n";
207 }
208 print $fh "\n";
209 }
210
211 print $fh "\n";
212
213 close $fh;
214
215 return $class;
216}
217
218sub save_parsers_debian {
219 my $class = shift;
220 my ($parser_module,$directory, $priority) = @_;
221
222 # add parser
223 $known_parsers = [];
224 $class->add_parser($parser_module);
225
226 # get parser's ParserDetails file
227 my $file = $parser_module;
228 $file = "${priority}-$file" if $priority != 0;
229 $file = File::Spec->catfile($directory, $file);
230 chmod 0644, $file;
231 unlink($file);
232
233 my $fh = gensym();
234 open($fh, ">$file") ||
235 die "Cannot write to $file: $!";
236
237 foreach my $p (@$known_parsers) {
238 print $fh "[$p->{Name}]\n";
239 foreach my $key (keys %{$p->{Features}}) {
240 print $fh "$key = $p->{Features}{$key}\n";
241 }
242 print $fh "\n";
243 }
244
245 print $fh "\n";
246
247 close $fh;
248
249 return $class;
250}
251
252sub do_warn {
253 my $class = shift;
254 # Don't output warnings if running under Test::Harness
255 warn(@_) unless $ENV{HARNESS_ACTIVE};
256}
257
258111µs11µs1;
259__END__
260
261=head1 NAME
262
263XML::SAX - Simple API for XML
264
265=head1 SYNOPSIS
266
267 use XML::SAX;
268
269 # get a list of known parsers
270 my $parsers = XML::SAX->parsers();
271
272 # add/update a parser
273 XML::SAX->add_parser(q(XML::SAX::PurePerl));
274
275 # remove parser
276 XML::SAX->remove_parser(q(XML::SAX::Foodelberry));
277
278 # save parsers
279 XML::SAX->save_parsers();
280
281=head1 DESCRIPTION
282
283XML::SAX is a SAX parser access API for Perl. It includes classes
284and APIs required for implementing SAX drivers, along with a factory
285class for returning any SAX parser installed on the user's system.
286
287=head1 USING A SAX2 PARSER
288
289The factory class is XML::SAX::ParserFactory. Please see the
290documentation of that module for how to instantiate a SAX parser:
291L<XML::SAX::ParserFactory>. However if you don't want to load up
292another manual page, here's a short synopsis:
293
294 use XML::SAX::ParserFactory;
295 use XML::SAX::XYZHandler;
296 my $handler = XML::SAX::XYZHandler->new();
297 my $p = XML::SAX::ParserFactory->parser(Handler => $handler);
298 $p->parse_uri("foo.xml");
299 # or $p->parse_string("<foo/>") or $p->parse_file($fh);
300
301This will automatically load a SAX2 parser (defaulting to
302XML::SAX::PurePerl if no others are found) and return it to you.
303
304In order to learn how to use SAX to parse XML, you will need to read
305L<XML::SAX::Intro> and for reference, L<XML::SAX::Specification>.
306
307=head1 WRITING A SAX2 PARSER
308
309The first thing to remember in writing a SAX2 parser is to subclass
310XML::SAX::Base. This will make your life infinitely easier, by providing
311a number of methods automagically for you. See L<XML::SAX::Base> for more
312details.
313
314When writing a SAX2 parser that is compatible with XML::SAX, you need
315to inform XML::SAX of the presence of that driver when you install it.
316In order to do that, XML::SAX contains methods for saving the fact that
317the parser exists on your system to a "INI" file, which is then loaded
318to determine which parsers are installed.
319
320The best way to do this is to follow these rules:
321
322=over 4
323
324=item * Add XML::SAX as a prerequisite in Makefile.PL:
325
326 WriteMakefile(
327 ...
328 PREREQ_PM => { 'XML::SAX' => 0 },
329 ...
330 );
331
332Alternatively you may wish to check for it in other ways that will
333cause more than just a warning.
334
335=item * Add the following code snippet to your Makefile.PL:
336
337 sub MY::install {
338 package MY;
339 my $script = shift->SUPER::install(@_);
340 if (ExtUtils::MakeMaker::prompt(
341 "Do you want to modify ParserDetails.ini?", 'Y')
342 =~ /^y/i) {
343 $script =~ s/install :: (.*)$/install :: $1 install_sax_driver/m;
344 $script .= <<"INSTALL";
345
346 install_sax_driver :
347 \t\@\$(PERL) -MXML::SAX -e "XML::SAX->add_parser(q(\$(NAME)))->save_parsers()"
348
349 INSTALL
350 }
351 return $script;
352 }
353
354Note that you should check the output of this - \$(NAME) will use the name of
355your distribution, which may not be exactly what you want. For example XML::LibXML
356has a driver called XML::LibXML::SAX::Generator, which is used in place of
357\$(NAME) in the above.
358
359=item * Add an XML::SAX test:
360
361A test file should be added to your t/ directory containing something like the
362following:
363
364 use Test;
365 BEGIN { plan tests => 3 }
366 use XML::SAX;
367 use XML::SAX::PurePerl::DebugHandler;
368 XML::SAX->add_parser(q(XML::SAX::MyDriver));
369 local $XML::SAX::ParserPackage = 'XML::SAX::MyDriver';
370 eval {
371 my $handler = XML::SAX::PurePerl::DebugHandler->new();
372 ok($handler);
373 my $parser = XML::SAX::ParserFactory->parser(Handler => $handler);
374 ok($parser);
375 ok($parser->isa('XML::SAX::MyDriver');
376 $parser->parse_string("<tag/>");
377 ok($handler->{seen}{start_element});
378 };
379
380=back
381
382=head1 EXPORTS
383
384By default, XML::SAX exports nothing into the caller's namespace. However you
385can request the symbols C<Namespaces> and C<Validation> which are the
386URIs for those features, allowing an easier way to request those features
387via ParserFactory:
388
389 use XML::SAX qw(Namespaces Validation);
390 my $factory = XML::SAX::ParserFactory->new();
391 $factory->require_feature(Namespaces);
392 $factory->require_feature(Validation);
393 my $parser = $factory->parser();
394
395=head1 AUTHOR
396
397Current maintainer: Grant McLean, grantm@cpan.org
398
399Originally written by:
400
401Matt Sergeant, matt@sergeant.org
402
403Kip Hampton, khampton@totalcinema.com
404
405Robin Berjon, robin@knowscape.com
406
407=head1 LICENSE
408
409This is free software, you may use it and distribute it under
410the same terms as Perl itself.
411
412=head1 SEE ALSO
413
414L<XML::SAX::Base> for writing SAX Filters and Parsers
415
416L<XML::SAX::PurePerl> for an XML parser written in 100%
417pure perl.
418
419L<XML::SAX::Exception> for details on exception handling
420
421=cut
422