home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / ParserFactory.pm < prev    next >
Encoding:
Perl POD Document  |  2002-11-19  |  6.7 KB  |  233 lines
  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.  
  233.