晋太元中,武陵人捕鱼为业。缘溪行,忘路之远近。忽逢桃花林,夹岸数百步,中无杂树,芳草鲜美,落英缤纷。渔人甚异之,复前行,欲穷其林。 林尽水源,便得一山,山有小口,仿佛若有光。便舍船,从口入。初极狭,才通人。复行数十步,豁然开朗。土地平旷,屋舍俨然,有良田、美池、桑竹之属。阡陌交通,鸡犬相闻。其中往来种作,男女衣着,悉如外人。黄发垂髫,并怡然自乐。 见渔人,乃大惊,问所从来。具答之。便要还家,设酒杀鸡作食。村中闻有此人,咸来问讯。自云先世避秦时乱,率妻子邑人来此绝境,不复出焉,遂与外人间隔。问今是何世,乃不知有汉,无论魏晋。此人一一为具言所闻,皆叹惋。余人各复延至其家,皆出酒食。停数日,辞去。此中人语云:“不足为外人道也。”(间隔 一作:隔绝) 既出,得其船,便扶向路,处处志之。及郡下,诣太守,说如此。太守即遣人随其往,寻向所志,遂迷,不复得路。 南阳刘子骥,高尚士也,闻之,欣然规往。未果,寻病终。后遂无问津者。
| DIR:/usr/local/share/perl5/XML/SAX/ |
| Current File : //usr/local/share/perl5/XML/SAX/ParserFactory.pm |
# $Id$
package XML::SAX::ParserFactory;
use strict;
use vars qw($VERSION);
$VERSION = '1.02';
use Symbol qw(gensym);
use XML::SAX;
use XML::SAX::Exception;
sub new {
my $class = shift;
my %params = @_; # TODO : Fix this in spec.
my $self = bless \%params, $class;
$self->{KnownParsers} = XML::SAX->parsers();
return $self;
}
sub parser {
my $self = shift;
my @parser_params = @_;
if (!ref($self)) {
$self = $self->new();
}
my $parser_class = $self->_parser_class();
my $version = '';
if ($parser_class =~ s/\s*\(([\d\.]+)\)\s*$//) {
$version = " $1";
}
if (!$parser_class->can('new')) {
eval "require $parser_class $version;";
die $@ if $@;
}
return $parser_class->new(@parser_params);
}
sub require_feature {
my $self = shift;
my ($feature) = @_;
$self->{RequiredFeatures}{$feature}++;
return $self;
}
sub _parser_class {
my $self = shift;
# First try ParserPackage
if ($XML::SAX::ParserPackage) {
return $XML::SAX::ParserPackage;
}
# Now check if required/preferred is there
if ($self->{RequiredFeatures}) {
my %required = %{$self->{RequiredFeatures}};
# note - we never go onto the next try (ParserDetails.ini),
# because if we can't provide the requested feature
# we need to throw an exception.
PARSER:
foreach my $parser (reverse @{$self->{KnownParsers}}) {
foreach my $feature (keys %required) {
if (!exists $parser->{Features}{$feature}) {
next PARSER;
}
}
# got here - all features must exist!
return $parser->{Name};
}
# TODO : should this be NotSupported() ?
throw XML::SAX::Exception (
Message => "Unable to provide required features",
);
}
# Next try SAX.ini
for my $dir (@INC) {
my $fh = gensym();
if (open($fh, "$dir/SAX.ini")) {
my $param_list = XML::SAX->_parse_ini_file($fh);
my $params = $param_list->[0]->{Features};
if ($params->{ParserPackage}) {
return $params->{ParserPackage};
}
else {
# we have required features (or nothing?)
PARSER:
foreach my $parser (reverse @{$self->{KnownParsers}}) {
foreach my $feature (keys %$params) {
if (!exists $parser->{Features}{$feature}) {
next PARSER;
}
}
return $parser->{Name};
}
XML::SAX->do_warn("Unable to provide SAX.ini required features. Using fallback\n");
}
last; # stop after first INI found
}
}
if (@{$self->{KnownParsers}}) {
return $self->{KnownParsers}[-1]{Name};
}
else {
return "XML::SAX::PurePerl"; # backup plan!
}
}
1;
__END__
=head1 NAME
XML::SAX::ParserFactory - Obtain a SAX parser
=head1 SYNOPSIS
use XML::SAX::ParserFactory;
use XML::SAX::XYZHandler;
my $handler = XML::SAX::XYZHandler->new();
my $p = XML::SAX::ParserFactory->parser(Handler => $handler);
$p->parse_uri("foo.xml");
# or $p->parse_string("<foo/>") or $p->parse_file($fh);
=head1 DESCRIPTION
XML::SAX::ParserFactory is a factory class for providing an application
with a Perl SAX2 XML parser. It is akin to DBI - a front end for other
parser classes. Each new SAX2 parser installed will register itself
with XML::SAX, and then it will become available to all applications
that use XML::SAX::ParserFactory to obtain a SAX parser.
Unlike DBI however, XML/SAX parsers almost all work alike (especially
if they subclass XML::SAX::Base, as they should), so rather than
specifying the parser you want in the call to C<parser()>, XML::SAX
has several ways to automatically choose which parser to use:
=over 4
=item * $XML::SAX::ParserPackage
If this package variable is set, then this package is C<require()>d
and an instance of this package is returned by calling the C<new()>
class method in that package. If it cannot be loaded or there is
an error, an exception will be thrown. The variable can also contain
a version number:
$XML::SAX::ParserPackage = "XML::SAX::Expat (0.72)";
And the number will be treated as a minimum version number.
=item * Required features
It is possible to require features from the parsers. For example, you
may wish for a parser that supports validation via a DTD. To do that,
use the following code:
use XML::SAX::ParserFactory;
my $factory = XML::SAX::ParserFactory->new();
$factory->require_feature('http://xml.org/sax/features/validation');
my $parser = $factory->parser(...);
Alternatively, specify the required features in the call to the
ParserFactory constructor:
my $factory = XML::SAX::ParserFactory->new(
RequiredFeatures => {
'http://xml.org/sax/features/validation' => 1,
}
);
If the features you have asked for are unavailable (for example the
user might not have a validating parser installed), then an
exception will be thrown.
The list of known parsers is searched in reverse order, so it will
always return the last installed parser that supports all of your
requested features (Note: this is subject to change if someone
comes up with a better way of making this work).
=item * SAX.ini
ParserFactory will search @INC for a file called SAX.ini, which
is in a simple format:
# a comment looks like this,
; or like this, and are stripped anywhere in the file
key = value # SAX.in contains key/value pairs.
All whitespace is non-significant.
This file can contain either a line:
ParserPackage = MyParserModule (1.02)
Where MyParserModule is the module to load and use for the parser,
and the number in brackets is a minimum version to load.
Or you can list required features:
http://xml.org/sax/features/validation = 1
And each feature with a true value will be required.
=item * Fallback
If none of the above works, the last parser installed on the user's
system will be used. The XML::SAX package ships with a pure perl
XML parser, XML::SAX::PurePerl, so that there will always be a
fallback parser.
=back
=head1 AUTHOR
Matt Sergeant, matt@sergeant.org
=head1 LICENSE
This is free software, you may use it and distribute it under the same
terms as Perl itself.
=cut
|