File | /usr/share/perl5/XML/SAX.pm |
Statements Executed | 170 |
Total Time | 0.0023494 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 291µs | 291µs | _parse_ini_file | XML::SAX::
1 | 1 | 1 | 89µs | 558µs | load_parsers | XML::SAX::
1 | 1 | 1 | 10µs | 568µs | parsers | XML::SAX::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::SAX::
0 | 0 | 0 | 0s | 0s | add_parser | XML::SAX::
0 | 0 | 0 | 0s | 0s | do_warn | XML::SAX::
0 | 0 | 0 | 0s | 0s | remove_parser | XML::SAX::
0 | 0 | 0 | 0s | 0s | save_parsers | XML::SAX::
0 | 0 | 0 | 0s | 0s | save_parsers_debian | XML::SAX::
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 | 8 | 95µs | 12µs | my $class = shift; |
49 | my $dir = shift; | |||
50 | ||||
51 | # reset parsers | |||
52 | $known_parsers = []; | |||
53 | ||||
54 | # get directory from wherever XML::SAX is installed | |||
55 | 2 | 10µs | 5µs | if (!$dir) { |
56 | $dir = $INC{'XML/SAX.pm'}; | |||
57 | $dir = dirname($dir); # spent 88µs making 1 call to File::Basename::dirname | |||
58 | } | |||
59 | ||||
60 | my $fh = gensym(); # spent 21µs making 1 call to Symbol::gensym | |||
61 | 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 | $known_parsers = $class->_parse_ini_file($fh); # spent 291µs making 1 call to XML::SAX::_parse_ini_file | |||
67 | ||||
68 | 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 | 6 | 26µs | 4µs | my $class = shift; |
73 | my ($fh) = @_; | |||
74 | ||||
75 | my @config; | |||
76 | ||||
77 | my $lineno = 0; | |||
78 | 94 | 187µs | 2µs | while (defined(my $line = <$fh>)) { |
79 | 1 | 20µs | 20µs | $lineno++; |
80 | my $original = $line; | |||
81 | # strip whitespace | |||
82 | $line =~ s/\s*$//m; | |||
83 | $line =~ s/^\s*//m; | |||
84 | # strip comments | |||
85 | $line =~ s/[#;].*$//m; | |||
86 | # ignore blanks | |||
87 | next if $line =~ /^$/m; | |||
88 | ||||
89 | # heading | |||
90 | 20 | 53µs | 3µs | if ($line =~ /^\[\s*(.*)\s*\]$/m) { |
91 | push @config, { Name => $1 }; | |||
92 | next; | |||
93 | } | |||
94 | ||||
95 | # instruction | |||
96 | elsif ($line =~ /^(.*?)\s*?=\s*(.*)$/) { | |||
97 | unless(@config) { | |||
98 | push @config, { Name => '' }; | |||
99 | } | |||
100 | $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 | 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 | 3 | 9µs | 3µs | my $class = shift; |
114 | 1 | 6µs | 6µs | if (!$known_parsers) { # spent 558µs making 1 call to XML::SAX::load_parsers |
115 | $class->load_parsers(); | |||
116 | } | |||
117 | 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 |