| File | /usr/share/perl5/XML/SAX/ParserFactory.pm |
| Statements Executed | 65 |
| Total Time | 0.0011656 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2 | 2 | 1 | 17.8ms | 25.3ms | XML::SAX::ParserFactory::parser |
| 2 | 1 | 1 | 42µs | 42µs | XML::SAX::ParserFactory::_parser_class |
| 1 | 1 | 1 | 22µs | 591µs | XML::SAX::ParserFactory::new |
| 1 | 1 | 1 | 12µs | 12µs | XML::SAX::ParserFactory::require_feature |
| 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 | 5 | 24µs | 5µs | my $class = shift; |
| 16 | my %params = @_; # TODO : Fix this in spec. | |||
| 17 | my $self = bless \%params, $class; | |||
| 18 | $self->{KnownParsers} = XML::SAX->parsers(); # spent 568µs making 1 call to XML::SAX::parsers | |||
| 19 | 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 | 19 | 110µs | 6µs | my $self = shift; |
| 24 | my @parser_params = @_; | |||
| 25 | if (!ref($self)) { | |||
| 26 | $self = $self->new(); | |||
| 27 | } | |||
| 28 | ||||
| 29 | my $parser_class = $self->_parser_class(); # spent 42µs making 2 calls to XML::SAX::ParserFactory::_parser_class, avg 21µs/call | |||
| 30 | ||||
| 31 | my $version = ''; | |||
| 32 | if ($parser_class =~ s/\s*\(([\d\.]+)\)\s*$//) { | |||
| 33 | $version = " $1"; | |||
| 34 | } | |||
| 35 | ||||
| 36 | { | |||
| 37 | 3 | 458µs | 153µs | no strict 'refs'; # spent 35µs making 1 call to strict::unimport |
| 38 | if (!keys %{"${parser_class}::"}) { | |||
| 39 | 1 | 125µs | 125µs | eval "use $parser_class $version;"; # spent 4µs making 1 call to import |
| 40 | } | |||
| 41 | } | |||
| 42 | ||||
| 43 | 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 | 4 | 6µs | 1µs | my $self = shift; |
| 48 | my ($feature) = @_; | |||
| 49 | $self->{RequiredFeatures}{$feature}++; | |||
| 50 | 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 | 16 | 35µs | 2µs | my $self = shift; |
| 55 | ||||
| 56 | # First try ParserPackage | |||
| 57 | if ($XML::SAX::ParserPackage) { | |||
| 58 | return $XML::SAX::ParserPackage; | |||
| 59 | } | |||
| 60 | ||||
| 61 | # Now check if required/preferred is there | |||
| 62 | if ($self->{RequiredFeatures}) { | |||
| 63 | 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 | foreach my $parser (reverse @{$self->{KnownParsers}}) { | |||
| 69 | foreach my $feature (keys %required) { | |||
| 70 | if (!exists $parser->{Features}{$feature}) { | |||
| 71 | next PARSER; | |||
| 72 | } | |||
| 73 | } | |||
| 74 | # got here - all features must exist! | |||
| 75 | 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 |