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