| File | /usr/share/perl5/XML/SAX.pm |
| Statements Executed | 168 |
| Total Time | 0.0023494 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 291µs | 291µs | XML::SAX::_parse_ini_file |
| 1 | 1 | 1 | 89µs | 558µs | XML::SAX::load_parsers |
| 1 | 1 | 1 | 10µs | 568µs | XML::SAX::parsers |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::BEGIN |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::add_parser |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::do_warn |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::remove_parser |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::save_parsers |
| 0 | 0 | 0 | 0s | 0s | XML::SAX::save_parsers_debian |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | # $Id: SAX.pm,v 1.29 2007/06/27 09:09:12 grant Exp $ | |||
| 2 | ||||
| 3 | package XML::SAX; | |||
| 4 | ||||
| 5 | 3 | 32µs | 11µs | use strict; # spent 7µs making 1 call to strict::import |
| 6 | 3 | 34µs | 11µs | use vars qw($VERSION @ISA @EXPORT_OK); # spent 59µs making 1 call to vars::import |
| 7 | ||||
| 8 | 1 | 800ns | 800ns | $VERSION = '0.16'; |
| 9 | ||||
| 10 | 3 | 42µs | 14µs | use Exporter (); |
| 11 | 1 | 8µs | 8µs | @ISA = ('Exporter'); |
| 12 | ||||
| 13 | 1 | 1µs | 1µs | @EXPORT_OK = qw(Namespaces Validation); |
| 14 | ||||
| 15 | 3 | 205µs | 68µs | use File::Basename qw(dirname); # spent 67µs making 1 call to Exporter::import |
| 16 | 3 | 140µs | 47µs | use File::Spec (); |
| 17 | 3 | 29µs | 10µs | use Symbol qw(gensym); # spent 49µs making 1 call to Exporter::import |
| 18 | 3 | 127µs | 42µs | use XML::SAX::ParserFactory (); # loaded for simplicity |
| 19 | ||||
| 20 | 3 | 44µs | 15µs | use constant PARSER_DETAILS => "ParserDetails.ini"; # spent 49µs making 1 call to constant::import |
| 21 | ||||
| 22 | 3 | 25µs | 8µs | use constant Namespaces => "http://xml.org/sax/features/namespaces"; # spent 35µs making 1 call to constant::import |
| 23 | 3 | 1.25ms | 415µs | use constant Validation => "http://xml.org/sax/features/validation"; # spent 39µs making 1 call to constant::import |
| 24 | ||||
| 25 | 1 | 400ns | 400ns | my $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] | |||
| 33 | http://xml.org/sax/features/namespaces = 1 | |||
| 34 | http://xml.org/sax/features/validation = 0 | |||
| 35 | # a comment | |||
| 36 | ||||
| 37 | # blank lines ignored | |||
| 38 | ||||
| 39 | [XML::SAX::AnotherParser] | |||
| 40 | http://xml.org/sax/features/namespaces = 0 | |||
| 41 | http://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 | |||
| 48 | 1 | 1µs | 1µs | my $class = shift; |
| 49 | 1 | 800ns | 800ns | my $dir = shift; |
| 50 | ||||
| 51 | # reset parsers | |||
| 52 | 1 | 1µs | 1µs | $known_parsers = []; |
| 53 | ||||
| 54 | # get directory from wherever XML::SAX is installed | |||
| 55 | 1 | 1µs | 1µs | if (!$dir) { |
| 56 | 1 | 2µs | 2µs | $dir = $INC{'XML/SAX.pm'}; |
| 57 | 1 | 8µs | 8µs | $dir = dirname($dir); # spent 88µs making 1 call to File::Basename::dirname |
| 58 | } | |||
| 59 | ||||
| 60 | 1 | 12µs | 12µs | my $fh = gensym(); # spent 21µs making 1 call to Symbol::gensym |
| 61 | 1 | 65µs | 65µ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 | ||||
| 66 | 1 | 10µs | 10µs | $known_parsers = $class->_parse_ini_file($fh); # spent 291µs making 1 call to XML::SAX::_parse_ini_file |
| 67 | ||||
| 68 | 1 | 4µs | 4µ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 | |||
| 72 | 1 | 1µs | 1µs | my $class = shift; |
| 73 | 1 | 1µs | 1µs | my ($fh) = @_; |
| 74 | ||||
| 75 | 1 | 400ns | 400ns | my @config; |
| 76 | ||||
| 77 | 1 | 600ns | 600ns | my $lineno = 0; |
| 78 | 1 | 40µs | 40µs | while (defined(my $line = <$fh>)) { |
| 79 | 14 | 3µs | 221ns | $lineno++; |
| 80 | 14 | 6µs | 400ns | my $original = $line; |
| 81 | # strip whitespace | |||
| 82 | 14 | 78µs | 6µs | $line =~ s/\s*$//m; |
| 83 | 14 | 14µs | 1µs | $line =~ s/^\s*//m; |
| 84 | # strip comments | |||
| 85 | 14 | 9µs | 636ns | $line =~ s/[#;].*$//m; |
| 86 | # ignore blanks | |||
| 87 | 14 | 9µs | 671ns | next if $line =~ /^$/m; |
| 88 | ||||
| 89 | # heading | |||
| 90 | 10 | 67µs | 7µs | if ($line =~ /^\[\s*(.*)\s*\]$/m) { |
| 91 | 4 | 14µs | 3µs | push @config, { Name => $1 }; |
| 92 | 4 | 2µs | 600ns | next; |
| 93 | } | |||
| 94 | ||||
| 95 | # instruction | |||
| 96 | elsif ($line =~ /^(.*?)\s*?=\s*(.*)$/) { | |||
| 97 | 6 | 3µs | 483ns | unless(@config) { |
| 98 | push @config, { Name => '' }; | |||
| 99 | } | |||
| 100 | 6 | 34µs | 6µ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 | ||||
| 109 | 1 | 2µs | 2µ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 | |||
| 113 | 1 | 900ns | 900ns | my $class = shift; |
| 114 | 1 | 13µs | 13µs | if (!$known_parsers) { # spent 558µs making 1 call to XML::SAX::load_parsers |
| 115 | $class->load_parsers(); | |||
| 116 | } | |||
| 117 | 1 | 1µs | 1µs | return $known_parsers; |
| 118 | } | |||
| 119 | ||||
| 120 | sub 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 | ||||
| 133 | sub 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 | ||||
| 179 | sub 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 | ||||
| 218 | sub 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 | ||||
| 252 | sub do_warn { | |||
| 253 | my $class = shift; | |||
| 254 | # Don't output warnings if running under Test::Harness | |||
| 255 | warn(@_) unless $ENV{HARNESS_ACTIVE}; | |||
| 256 | } | |||
| 257 | ||||
| 258 | 1 | 11µs | 11µs | 1; |
| 259 | __END__ | |||
| 260 | ||||
| 261 | =head1 NAME | |||
| 262 | ||||
| 263 | XML::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 | ||||
| 283 | XML::SAX is a SAX parser access API for Perl. It includes classes | |||
| 284 | and APIs required for implementing SAX drivers, along with a factory | |||
| 285 | class for returning any SAX parser installed on the user's system. | |||
| 286 | ||||
| 287 | =head1 USING A SAX2 PARSER | |||
| 288 | ||||
| 289 | The factory class is XML::SAX::ParserFactory. Please see the | |||
| 290 | documentation of that module for how to instantiate a SAX parser: | |||
| 291 | L<XML::SAX::ParserFactory>. However if you don't want to load up | |||
| 292 | another 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 | ||||
| 301 | This will automatically load a SAX2 parser (defaulting to | |||
| 302 | XML::SAX::PurePerl if no others are found) and return it to you. | |||
| 303 | ||||
| 304 | In order to learn how to use SAX to parse XML, you will need to read | |||
| 305 | L<XML::SAX::Intro> and for reference, L<XML::SAX::Specification>. | |||
| 306 | ||||
| 307 | =head1 WRITING A SAX2 PARSER | |||
| 308 | ||||
| 309 | The first thing to remember in writing a SAX2 parser is to subclass | |||
| 310 | XML::SAX::Base. This will make your life infinitely easier, by providing | |||
| 311 | a number of methods automagically for you. See L<XML::SAX::Base> for more | |||
| 312 | details. | |||
| 313 | ||||
| 314 | When writing a SAX2 parser that is compatible with XML::SAX, you need | |||
| 315 | to inform XML::SAX of the presence of that driver when you install it. | |||
| 316 | In order to do that, XML::SAX contains methods for saving the fact that | |||
| 317 | the parser exists on your system to a "INI" file, which is then loaded | |||
| 318 | to determine which parsers are installed. | |||
| 319 | ||||
| 320 | The 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 | ||||
| 332 | Alternatively you may wish to check for it in other ways that will | |||
| 333 | cause 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 | ||||
| 354 | Note that you should check the output of this - \$(NAME) will use the name of | |||
| 355 | your distribution, which may not be exactly what you want. For example XML::LibXML | |||
| 356 | has 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 | ||||
| 361 | A test file should be added to your t/ directory containing something like the | |||
| 362 | following: | |||
| 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 | ||||
| 384 | By default, XML::SAX exports nothing into the caller's namespace. However you | |||
| 385 | can request the symbols C<Namespaces> and C<Validation> which are the | |||
| 386 | URIs for those features, allowing an easier way to request those features | |||
| 387 | via 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 | ||||
| 397 | Current maintainer: Grant McLean, grantm@cpan.org | |||
| 398 | ||||
| 399 | Originally written by: | |||
| 400 | ||||
| 401 | Matt Sergeant, matt@sergeant.org | |||
| 402 | ||||
| 403 | Kip Hampton, khampton@totalcinema.com | |||
| 404 | ||||
| 405 | Robin Berjon, robin@knowscape.com | |||
| 406 | ||||
| 407 | =head1 LICENSE | |||
| 408 | ||||
| 409 | This is free software, you may use it and distribute it under | |||
| 410 | the same terms as Perl itself. | |||
| 411 | ||||
| 412 | =head1 SEE ALSO | |||
| 413 | ||||
| 414 | L<XML::SAX::Base> for writing SAX Filters and Parsers | |||
| 415 | ||||
| 416 | L<XML::SAX::PurePerl> for an XML parser written in 100% | |||
| 417 | pure perl. | |||
| 418 | ||||
| 419 | L<XML::SAX::Exception> for details on exception handling | |||
| 420 | ||||
| 421 | =cut | |||
| 422 |