diff -r 996297fad800 -r 5ccf9d5ab663 common/tools/raptor/XML/SAX.pm --- a/common/tools/raptor/XML/SAX.pm Thu Mar 11 13:20:26 2010 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,379 +0,0 @@ -# $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. 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("") 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 and for reference, L. - -=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 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(""); - 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 and C 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 for writing SAX Filters and Parsers - -L for an XML parser written in 100% -pure perl. - -L for details on exception handling - -=cut -