Initial Commit

database/perl/vendor/lib/XML/SAX/ParserFactory.pm

@@ -0,0 +1,230 @@
+# $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
+