File | /usr/share/perl5/XML/SAX/ParserFactory.pm |
Statements Executed | 64 |
Total Time | 0.0011656 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 2 | 1 | 17.8ms | 25.3ms | parser | XML::SAX::ParserFactory::
2 | 1 | 1 | 42µs | 42µs | _parser_class | XML::SAX::ParserFactory::
1 | 1 | 1 | 22µs | 591µs | new | XML::SAX::ParserFactory::
1 | 1 | 1 | 12µs | 12µs | require_feature | XML::SAX::ParserFactory::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | # $Id: ParserFactory.pm,v 1.13 2002/11/19 18:25:47 matt Exp $ | |||
2 | ||||
3 | package XML::SAX::ParserFactory; | |||
4 | ||||
5 | 3 | 28µs | 9µs | use strict; # spent 8µs making 1 call to strict::import |
6 | 3 | 39µs | 13µs | use vars qw($VERSION); # spent 25µs making 1 call to vars::import |
7 | ||||
8 | 1 | 800ns | 800ns | $VERSION = '1.01'; |
9 | ||||
10 | 3 | 27µs | 9µs | use Symbol qw(gensym); # spent 44µs making 1 call to Exporter::import |
11 | 3 | 36µs | 12µs | use XML::SAX; # spent 8µs making 1 call to import |
12 | 3 | 275µs | 92µs | use XML::SAX::Exception; # spent 7µs making 1 call to import |
13 | ||||
14 | # spent 591µs (22+568) within XML::SAX::ParserFactory::new which was called
# once (22µs+568µs) at line 21 of /usr/share/perl5/MARC/File/XML.pm | |||
15 | 1 | 1µs | 1µs | my $class = shift; |
16 | 1 | 2µs | 2µs | my %params = @_; # TODO : Fix this in spec. |
17 | 1 | 9µs | 9µs | my $self = bless \%params, $class; |
18 | 1 | 10µs | 10µs | $self->{KnownParsers} = XML::SAX->parsers(); # spent 568µs making 1 call to XML::SAX::parsers |
19 | 1 | 2µs | 2µs | return $self; |
20 | } | |||
21 | ||||
22 | # spent 25.3ms (17.8+7.50) within XML::SAX::ParserFactory::parser which was called 2 times, avg 12.7ms/call:
# once (17.8ms+7.42ms) at line 24 of /usr/share/perl5/MARC/File/XML.pm
# once (22µs+77µs) by MARC::File::XML::import at line 32 of /usr/share/perl5/MARC/File/XML.pm | |||
23 | 2 | 2µs | 1µs | my $self = shift; |
24 | 2 | 7µs | 3µs | my @parser_params = @_; |
25 | 2 | 3µs | 1µs | if (!ref($self)) { |
26 | $self = $self->new(); | |||
27 | } | |||
28 | ||||
29 | 2 | 12µs | 6µs | my $parser_class = $self->_parser_class(); # spent 42µs making 2 calls to XML::SAX::ParserFactory::_parser_class, avg 21µs/call |
30 | ||||
31 | 2 | 2µs | 950ns | my $version = ''; |
32 | 2 | 4µs | 2µs | if ($parser_class =~ s/\s*\(([\d\.]+)\)\s*$//) { |
33 | $version = " $1"; | |||
34 | } | |||
35 | ||||
36 | { | |||
37 | 5 | 460µs | 92µs | no strict 'refs'; # spent 35µs making 1 call to strict::unimport |
38 | 2 | 14µs | 7µs | if (!keys %{"${parser_class}::"}) { |
39 | 1 | 169µs | 169µs | eval "use $parser_class $version;"; # spent 4µs making 1 call to import |
40 | } | |||
41 | } | |||
42 | ||||
43 | 2 | 20µs | 10µs | return $parser_class->new(@parser_params); # spent 155µs making 2 calls to XML::SAX::Base::new, avg 77µs/call |
44 | } | |||
45 | ||||
46 | # spent 12µs within XML::SAX::ParserFactory::require_feature which was called
# once (12µs+0s) at line 22 of /usr/share/perl5/MARC/File/XML.pm | |||
47 | 1 | 900ns | 900ns | my $self = shift; |
48 | 1 | 2µs | 2µs | my ($feature) = @_; |
49 | 1 | 2µs | 2µs | $self->{RequiredFeatures}{$feature}++; |
50 | 1 | 1µs | 1µs | return $self; |
51 | } | |||
52 | ||||
53 | # spent 42µs within XML::SAX::ParserFactory::_parser_class which was called 2 times, avg 21µs/call:
# 2 times (42µs+0s) by XML::SAX::ParserFactory::parser at line 29, avg 21µs/call | |||
54 | 2 | 2µs | 800ns | my $self = shift; |
55 | ||||
56 | # First try ParserPackage | |||
57 | 2 | 1µs | 650ns | if ($XML::SAX::ParserPackage) { |
58 | return $XML::SAX::ParserPackage; | |||
59 | } | |||
60 | ||||
61 | # Now check if required/preferred is there | |||
62 | 2 | 3µs | 2µs | if ($self->{RequiredFeatures}) { |
63 | 2 | 8µs | 4µs | my %required = %{$self->{RequiredFeatures}}; |
64 | # note - we never go onto the next try (ParserDetails.ini), | |||
65 | # because if we can't provide the requested feature | |||
66 | # we need to throw an exception. | |||
67 | PARSER: | |||
68 | 2 | 5µs | 3µs | foreach my $parser (reverse @{$self->{KnownParsers}}) { |
69 | 2 | 4µs | 2µs | foreach my $feature (keys %required) { |
70 | 2 | 5µs | 3µs | if (!exists $parser->{Features}{$feature}) { |
71 | next PARSER; | |||
72 | } | |||
73 | } | |||
74 | # got here - all features must exist! | |||
75 | 2 | 7µs | 3µs | return $parser->{Name}; |
76 | } | |||
77 | # TODO : should this be NotSupported() ? | |||
78 | throw XML::SAX::Exception ( | |||
79 | Message => "Unable to provide required features", | |||
80 | ); | |||
81 | } | |||
82 | ||||
83 | # Next try SAX.ini | |||
84 | for my $dir (@INC) { | |||
85 | my $fh = gensym(); | |||
86 | if (open($fh, "$dir/SAX.ini")) { | |||
87 | my $param_list = XML::SAX->_parse_ini_file($fh); | |||
88 | my $params = $param_list->[0]->{Features}; | |||
89 | if ($params->{ParserPackage}) { | |||
90 | return $params->{ParserPackage}; | |||
91 | } | |||
92 | else { | |||
93 | # we have required features (or nothing?) | |||
94 | PARSER: | |||
95 | foreach my $parser (reverse @{$self->{KnownParsers}}) { | |||
96 | foreach my $feature (keys %$params) { | |||
97 | if (!exists $parser->{Features}{$feature}) { | |||
98 | next PARSER; | |||
99 | } | |||
100 | } | |||
101 | return $parser->{Name}; | |||
102 | } | |||
103 | XML::SAX->do_warn("Unable to provide SAX.ini required features. Using fallback\n"); | |||
104 | } | |||
105 | last; # stop after first INI found | |||
106 | } | |||
107 | } | |||
108 | ||||
109 | if (@{$self->{KnownParsers}}) { | |||
110 | return $self->{KnownParsers}[-1]{Name}; | |||
111 | } | |||
112 | else { | |||
113 | return "XML::SAX::PurePerl"; # backup plan! | |||
114 | } | |||
115 | } | |||
116 | ||||
117 | 1 | 3µs | 3µs | 1; |
118 | __END__ | |||
119 | ||||
120 | =head1 NAME | |||
121 | ||||
122 | XML::SAX::ParserFactory - Obtain a SAX parser | |||
123 | ||||
124 | =head1 SYNOPSIS | |||
125 | ||||
126 | use XML::SAX::ParserFactory; | |||
127 | use XML::SAX::XYZHandler; | |||
128 | my $handler = XML::SAX::XYZHandler->new(); | |||
129 | my $p = XML::SAX::ParserFactory->parser(Handler => $handler); | |||
130 | $p->parse_uri("foo.xml"); | |||
131 | # or $p->parse_string("<foo/>") or $p->parse_file($fh); | |||
132 | ||||
133 | =head1 DESCRIPTION | |||
134 | ||||
135 | XML::SAX::ParserFactory is a factory class for providing an application | |||
136 | with a Perl SAX2 XML parser. It is akin to DBI - a front end for other | |||
137 | parser classes. Each new SAX2 parser installed will register itself | |||
138 | with XML::SAX, and then it will become available to all applications | |||
139 | that use XML::SAX::ParserFactory to obtain a SAX parser. | |||
140 | ||||
141 | Unlike DBI however, XML/SAX parsers almost all work alike (especially | |||
142 | if they subclass XML::SAX::Base, as they should), so rather than | |||
143 | specifying the parser you want in the call to C<parser()>, XML::SAX | |||
144 | has several ways to automatically choose which parser to use: | |||
145 | ||||
146 | =over 4 | |||
147 | ||||
148 | =item * $XML::SAX::ParserPackage | |||
149 | ||||
150 | If this package variable is set, then this package is C<require()>d | |||
151 | and an instance of this package is returned by calling the C<new()> | |||
152 | class method in that package. If it cannot be loaded or there is | |||
153 | an error, an exception will be thrown. The variable can also contain | |||
154 | a version number: | |||
155 | ||||
156 | $XML::SAX::ParserPackage = "XML::SAX::Expat (0.72)"; | |||
157 | ||||
158 | And the number will be treated as a minimum version number. | |||
159 | ||||
160 | =item * Required features | |||
161 | ||||
162 | It is possible to require features from the parsers. For example, you | |||
163 | may wish for a parser that supports validation via a DTD. To do that, | |||
164 | use the following code: | |||
165 | ||||
166 | use XML::SAX::ParserFactory; | |||
167 | my $factory = XML::SAX::ParserFactory->new(); | |||
168 | $factory->require_feature('http://xml.org/sax/features/validation'); | |||
169 | my $parser = $factory->parser(...); | |||
170 | ||||
171 | Alternatively, specify the required features in the call to the | |||
172 | ParserFactory constructor: | |||
173 | ||||
174 | my $factory = XML::SAX::ParserFactory->new( | |||
175 | RequiredFeatures => { | |||
176 | 'http://xml.org/sax/features/validation' => 1, | |||
177 | } | |||
178 | ); | |||
179 | ||||
180 | If the features you have asked for are unavailable (for example the | |||
181 | user might not have a validating parser installed), then an | |||
182 | exception will be thrown. | |||
183 | ||||
184 | The list of known parsers is searched in reverse order, so it will | |||
185 | always return the last installed parser that supports all of your | |||
186 | requested features (Note: this is subject to change if someone | |||
187 | comes up with a better way of making this work). | |||
188 | ||||
189 | =item * SAX.ini | |||
190 | ||||
191 | ParserFactory will search @INC for a file called SAX.ini, which | |||
192 | is in a simple format: | |||
193 | ||||
194 | # a comment looks like this, | |||
195 | ; or like this, and are stripped anywhere in the file | |||
196 | key = value # SAX.in contains key/value pairs. | |||
197 | ||||
198 | All whitespace is non-significant. | |||
199 | ||||
200 | This file can contain either a line: | |||
201 | ||||
202 | ParserPackage = MyParserModule (1.02) | |||
203 | ||||
204 | Where MyParserModule is the module to load and use for the parser, | |||
205 | and the number in brackets is a minimum version to load. | |||
206 | ||||
207 | Or you can list required features: | |||
208 | ||||
209 | http://xml.org/sax/features/validation = 1 | |||
210 | ||||
211 | And each feature with a true value will be required. | |||
212 | ||||
213 | =item * Fallback | |||
214 | ||||
215 | If none of the above works, the last parser installed on the user's | |||
216 | system will be used. The XML::SAX package ships with a pure perl | |||
217 | XML parser, XML::SAX::PurePerl, so that there will always be a | |||
218 | fallback parser. | |||
219 | ||||
220 | =back | |||
221 | ||||
222 | =head1 AUTHOR | |||
223 | ||||
224 | Matt Sergeant, matt@sergeant.org | |||
225 | ||||
226 | =head1 LICENSE | |||
227 | ||||
228 | This is free software, you may use it and distribute it under the same | |||
229 | terms as Perl itself. | |||
230 | ||||
231 | =cut | |||
232 |