--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/common/tools/raptor/XML/SAX.pm Tue Aug 04 14:40:11 2009 +0100
@@ -0,0 +1,379 @@
+# $Id: SAX.pm,v 1.27 2007/02/07 09:33:50 grant Exp $
+
+package XML::SAX;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT_OK);
+
+$VERSION = '0.15';
+
+use Exporter ();
+@ISA = ('Exporter');
+
+@EXPORT_OK = qw(Namespaces Validation);
+
+use File::Basename qw(dirname);
+use File::Spec ();
+use Symbol qw(gensym);
+use XML::SAX::ParserFactory (); # loaded for simplicity
+
+use constant PARSER_DETAILS => "ParserDetails.ini";
+
+use constant Namespaces => "http://xml.org/sax/features/namespaces";
+use constant Validation => "http://xml.org/sax/features/validation";
+
+my $known_parsers = undef;
+
+# load_parsers takes the ParserDetails.ini file out of the same directory
+# that XML::SAX is in, and looks at it. Format in POD below
+
+=begin EXAMPLE
+
+[XML::SAX::PurePerl]
+http://xml.org/sax/features/namespaces = 1
+http://xml.org/sax/features/validation = 0
+# a comment
+
+# blank lines ignored
+
+[XML::SAX::AnotherParser]
+http://xml.org/sax/features/namespaces = 0
+http://xml.org/sax/features/validation = 1
+
+=end EXAMPLE
+
+=cut
+
+sub load_parsers {
+ my $class = shift;
+ my $dir = shift;
+
+ # reset parsers
+ $known_parsers = [];
+
+ # get directory from wherever XML::SAX is installed
+ if (!$dir) {
+ $dir = $INC{'XML/SAX.pm'};
+ $dir = dirname($dir);
+ }
+
+ my $fh = gensym();
+ if (!open($fh, File::Spec->catfile($dir, "SAX", PARSER_DETAILS))) {
+ XML::SAX->do_warn("could not find " . PARSER_DETAILS . " in $dir/SAX\n");
+ return $class;
+ }
+
+ $known_parsers = $class->_parse_ini_file($fh);
+
+ return $class;
+}
+
+sub _parse_ini_file {
+ my $class = shift;
+ my ($fh) = @_;
+
+ my @config;
+
+ my $lineno = 0;
+ while (defined(my $line = <$fh>)) {
+ $lineno++;
+ my $original = $line;
+ # strip whitespace
+ $line =~ s/\s*$//m;
+ $line =~ s/^\s*//m;
+ # strip comments
+ $line =~ s/[#;].*$//m;
+ # ignore blanks
+ next if $line =~ /^$/m;
+
+ # heading
+ if ($line =~ /^\[\s*(.*)\s*\]$/m) {
+ push @config, { Name => $1 };
+ next;
+ }
+
+ # instruction
+ elsif ($line =~ /^(.*?)\s*?=\s*(.*)$/) {
+ unless(@config) {
+ push @config, { Name => '' };
+ }
+ $config[-1]{Features}{$1} = $2;
+ }
+
+ # not whitespace, comment, or instruction
+ else {
+ die "Invalid line in ini: $lineno\n>>> $original\n";
+ }
+ }
+
+ return \@config;
+}
+
+sub parsers {
+ my $class = shift;
+ if (!$known_parsers) {
+ $class->load_parsers();
+ }
+ return $known_parsers;
+}
+
+sub remove_parser {
+ my $class = shift;
+ my ($parser_module) = @_;
+
+ if (!$known_parsers) {
+ $class->load_parsers();
+ }
+
+ @$known_parsers = grep { $_->{Name} ne $parser_module } @$known_parsers;
+
+ return $class;
+}
+
+sub add_parser {
+ my $class = shift;
+ my ($parser_module) = @_;
+
+ if (!$known_parsers) {
+ $class->load_parsers();
+ }
+
+ # first load module, then query features, then push onto known_parsers,
+
+ my $parser_file = $parser_module;
+ $parser_file =~ s/::/\//g;
+ $parser_file .= ".pm";
+
+ require $parser_file;
+
+ my @features = $parser_module->supported_features();
+
+ my $new = { Name => $parser_module };
+ foreach my $feature (@features) {
+ $new->{Features}{$feature} = 1;
+ }
+
+ # If exists in list already, move to end.
+ my $done = 0;
+ my $pos = undef;
+ for (my $i = 0; $i < @$known_parsers; $i++) {
+ my $p = $known_parsers->[$i];
+ if ($p->{Name} eq $parser_module) {
+ $pos = $i;
+ }
+ }
+ if (defined $pos) {
+ splice(@$known_parsers, $pos, 1);
+ push @$known_parsers, $new;
+ $done++;
+ }
+
+ # Otherwise (not in list), add at end of list.
+ if (!$done) {
+ push @$known_parsers, $new;
+ }
+
+ return $class;
+}
+
+sub save_parsers {
+ my $class = shift;
+
+ # get directory from wherever XML::SAX is installed
+ my $dir = $INC{'XML/SAX.pm'};
+ $dir = dirname($dir);
+
+ my $file = File::Spec->catfile($dir, "SAX", PARSER_DETAILS);
+ chmod 0644, $file;
+ unlink($file);
+
+ my $fh = gensym();
+ open($fh, ">$file") ||
+ die "Cannot write to $file: $!";
+
+ foreach my $p (@$known_parsers) {
+ print $fh "[$p->{Name}]\n";
+ foreach my $key (keys %{$p->{Features}}) {
+ print $fh "$key = $p->{Features}{$key}\n";
+ }
+ print $fh "\n";
+ }
+
+ print $fh "\n";
+
+ close $fh;
+
+ return $class;
+}
+
+sub do_warn {
+ my $class = shift;
+ # Don't output warnings if running under Test::Harness
+ warn(@_) unless $ENV{HARNESS_ACTIVE};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+XML::SAX - Simple API for XML
+
+=head1 SYNOPSIS
+
+ use XML::SAX;
+
+ # get a list of known parsers
+ my $parsers = XML::SAX->parsers();
+
+ # add/update a parser
+ XML::SAX->add_parser(q(XML::SAX::PurePerl));
+
+ # remove parser
+ XML::SAX->remove_parser(q(XML::SAX::Foodelberry));
+
+ # save parsers
+ XML::SAX->save_parsers();
+
+=head1 DESCRIPTION
+
+XML::SAX is a SAX parser access API for Perl. It includes classes
+and APIs required for implementing SAX drivers, along with a factory
+class for returning any SAX parser installed on the user's system.
+
+=head1 USING A SAX2 PARSER
+
+The factory class is XML::SAX::ParserFactory. Please see the
+documentation of that module for how to instantiate a SAX parser:
+L<XML::SAX::ParserFactory>. However if you don't want to load up
+another manual page, here's a short 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);
+
+This will automatically load a SAX2 parser (defaulting to
+XML::SAX::PurePerl if no others are found) and return it to you.
+
+In order to learn how to use SAX to parse XML, you will need to read
+L<XML::SAX::Intro> and for reference, L<XML::SAX::Specification>.
+
+=head1 WRITING A SAX2 PARSER
+
+The first thing to remember in writing a SAX2 parser is to subclass
+XML::SAX::Base. This will make your life infinitely easier, by providing
+a number of methods automagically for you. See L<XML::SAX::Base> for more
+details.
+
+When writing a SAX2 parser that is compatible with XML::SAX, you need
+to inform XML::SAX of the presence of that driver when you install it.
+In order to do that, XML::SAX contains methods for saving the fact that
+the parser exists on your system to a "INI" file, which is then loaded
+to determine which parsers are installed.
+
+The best way to do this is to follow these rules:
+
+=over 4
+
+=item * Add XML::SAX as a prerequisite in Makefile.PL:
+
+ WriteMakefile(
+ ...
+ PREREQ_PM => { 'XML::SAX' => 0 },
+ ...
+ );
+
+Alternatively you may wish to check for it in other ways that will
+cause more than just a warning.
+
+=item * Add the following code snippet to your Makefile.PL:
+
+ sub MY::install {
+ package MY;
+ my $script = shift->SUPER::install(@_);
+ if (ExtUtils::MakeMaker::prompt(
+ "Do you want to modify ParserDetails.ini?", 'Y')
+ =~ /^y/i) {
+ $script =~ s/install :: (.*)$/install :: $1 install_sax_driver/m;
+ $script .= <<"INSTALL";
+
+ install_sax_driver :
+ \t\@\$(PERL) -MXML::SAX -e "XML::SAX->add_parser(q(\$(NAME)))->save_parsers()"
+
+ INSTALL
+ }
+ return $script;
+ }
+
+Note that you should check the output of this - \$(NAME) will use the name of
+your distribution, which may not be exactly what you want. For example XML::LibXML
+has a driver called XML::LibXML::SAX::Generator, which is used in place of
+\$(NAME) in the above.
+
+=item * Add an XML::SAX test:
+
+A test file should be added to your t/ directory containing something like the
+following:
+
+ use Test;
+ BEGIN { plan tests => 3 }
+ use XML::SAX;
+ use XML::SAX::PurePerl::DebugHandler;
+ XML::SAX->add_parser(q(XML::SAX::MyDriver));
+ local $XML::SAX::ParserPackage = 'XML::SAX::MyDriver';
+ eval {
+ my $handler = XML::SAX::PurePerl::DebugHandler->new();
+ ok($handler);
+ my $parser = XML::SAX::ParserFactory->parser(Handler => $handler);
+ ok($parser);
+ ok($parser->isa('XML::SAX::MyDriver');
+ $parser->parse_string("<tag/>");
+ ok($handler->{seen}{start_element});
+ };
+
+=back
+
+=head1 EXPORTS
+
+By default, XML::SAX exports nothing into the caller's namespace. However you
+can request the symbols C<Namespaces> and C<Validation> which are the
+URIs for those features, allowing an easier way to request those features
+via ParserFactory:
+
+ use XML::SAX qw(Namespaces Validation);
+ my $factory = XML::SAX::ParserFactory->new();
+ $factory->require_feature(Namespaces);
+ $factory->require_feature(Validation);
+ my $parser = $factory->parser();
+
+=head1 AUTHOR
+
+Current maintainer: Grant McLean, grantm@cpan.org
+
+Originally written by:
+
+Matt Sergeant, matt@sergeant.org
+
+Kip Hampton, khampton@totalcinema.com
+
+Robin Berjon, robin@knowscape.com
+
+=head1 LICENSE
+
+This is free software, you may use it and distribute it under
+the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<XML::SAX::Base> for writing SAX Filters and Parsers
+
+L<XML::SAX::PurePerl> for an XML parser written in 100%
+pure perl.
+
+L<XML::SAX::Exception> for details on exception handling
+
+=cut
+