177
|
1 |
# $Id: ParserFactory.pm,v 1.13 2002/11/19 18:25:47 matt Exp $
|
|
2 |
|
|
3 |
package XML::SAX::ParserFactory;
|
|
4 |
|
|
5 |
use strict;
|
|
6 |
use vars qw($VERSION);
|
|
7 |
|
|
8 |
$VERSION = '1.01';
|
|
9 |
|
|
10 |
use Symbol qw(gensym);
|
|
11 |
use XML::SAX;
|
|
12 |
use XML::SAX::Exception;
|
|
13 |
|
|
14 |
sub new {
|
|
15 |
my $class = shift;
|
|
16 |
my %params = @_; # TODO : Fix this in spec.
|
|
17 |
my $self = bless \%params, $class;
|
|
18 |
$self->{KnownParsers} = XML::SAX->parsers();
|
|
19 |
return $self;
|
|
20 |
}
|
|
21 |
|
|
22 |
sub parser {
|
|
23 |
my $self = shift;
|
|
24 |
my @parser_params = @_;
|
|
25 |
if (!ref($self)) {
|
|
26 |
$self = $self->new();
|
|
27 |
}
|
|
28 |
|
|
29 |
my $parser_class = $self->_parser_class();
|
|
30 |
|
|
31 |
my $version = '';
|
|
32 |
if ($parser_class =~ s/\s*\(([\d\.]+)\)\s*$//) {
|
|
33 |
$version = " $1";
|
|
34 |
}
|
|
35 |
|
|
36 |
{
|
|
37 |
no strict 'refs';
|
|
38 |
if (!keys %{"${parser_class}::"}) {
|
|
39 |
eval "use $parser_class $version;";
|
|
40 |
}
|
|
41 |
}
|
|
42 |
|
|
43 |
return $parser_class->new(@parser_params);
|
|
44 |
}
|
|
45 |
|
|
46 |
sub require_feature {
|
|
47 |
my $self = shift;
|
|
48 |
my ($feature) = @_;
|
|
49 |
$self->{RequiredFeatures}{$feature}++;
|
|
50 |
return $self;
|
|
51 |
}
|
|
52 |
|
|
53 |
sub _parser_class {
|
|
54 |
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;
|
|
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 |
|