XML::SAX::ExpatXS - Perl SAX 2 XS extension to Expat parser

 use XML::SAX::ExpatXS;

 $handler = MyHandler->new();
 $parser = XML::SAX::ExpatXS->new( Handler => $handler );
 $parser->parse_uri($uri);
  #or
 $parser->parse_string($xml);

 $parser->set_feature(FEATURE, VALUE);

 Petr Cimprich <petr AT gingerall DOT org> (maintainer)
 Matt Sergeant <matt AT sergeant DOT org>

package XML::SAX::ExpatXS;
use strict;
use vars qw($VERSION @ISA);

use XML::SAX::ExpatXS::Encoding;
use XML::SAX::ExpatXS::Preload;
use XML::SAX::Base;
use DynaLoader ();
use Carp;
use IO::File;

$VERSION = '1.32';
@ISA = qw(DynaLoader XML::SAX::Base XML::SAX::ExpatXS::Preload);

XML::SAX::ExpatXS->bootstrap($VERSION);

my @features = (
	['http://xml.org/sax/features/namespaces', 1],
	['http://xml.org/sax/features/external-general-entities', 1],
	['http://xml.org/sax/features/external-parameter-entities', 0],
    ['http://xml.org/sax/features/xmlns-uris', 0],
    ['http://xmlns.perl.org/sax/xmlns-uris', 1],
    ['http://xmlns.perl.org/sax/version-2.1', 1],
	['http://xmlns.perl.org/sax/join-character-data', 1],
	['http://xmlns.perl.org/sax/ns-attributes', 1],
	['http://xmlns.perl.org/sax/locator', 1],
	['http://xmlns.perl.org/sax/recstring', 0]
			 );
my @supported_features = map($_->[0], @features);


#------------------------------------------------------------
# API methods
#------------------------------------------------------------

sub new {
    my $proto = shift;
    my $options = ($#_ == 0) ? shift : { @_ };

    foreach (@features) {
	$options->{Features}->{$_->[0]} = $_->[1];
    }

    $options->{ExpatVersion} = ExpatVersion();

    return $proto->SUPER::new($options);
}

sub get_feature {
    my ($self, $feat) = @_;
      if (exists $self->{Features}->{$feat}) {
	  return $self->{Features}->{$feat};
      }
      else {
          return $self->SUPER::get_feature($feat);
      }
  }

sub set_feature {
    my ($self, $feat, $val) = @_;
      if (exists $self->{Features}->{$feat}) {
	  return $self->{Features}->{$feat} = $val;
      }
      else {
          return $self->SUPER::set_feature($feat, $val);
      }
  }

sub get_features {
    my $self = shift;
    return %{$self->{Features}};
}

sub supported_features {
    my $self = shift;

    return @supported_features;
}

#------------------------------------------------------------
# internal methods
#------------------------------------------------------------

sub _parse_characterstream {
    my ($self, $fh) = @_;
    $self->{ParseOptions}->{ParseFunc} = \&ParseStream;
    $self->{ParseOptions}->{ParseFuncParam} = $fh;
    $self->_parse;
}

sub _parse_bytestream {
    my ($self, $fh) = @_;
    $self->{ParseOptions}->{ParseFunc} = \&ParseStream;
    $self->{ParseOptions}->{ParseFuncParam} = $fh;
    $self->_parse;
}

sub _parse_string {
    my ($self, $str) = @_;
    $self->{ParseOptions}->{ParseFunc} = \&ParseString;
    $self->{ParseOptions}->{ParseFuncParam} = $str;
    $self->_parse;
}

sub _parse_systemid {
    my ($self, $uri) = @_;
    my $fh = IO::File->new($uri) or croak "ExpatXS: Can't open $uri ($!)";
    $self->{ParseOptions}->{ParseFunc} = \&ParseStream;
    $self->{ParseOptions}->{ParseFuncParam} = $fh;
    $self->_parse;
}

sub _parse {
    my $self = shift;

    my $args = bless $self->{ParseOptions}, ref($self);
    delete $args->{ParseOptions};

    # copy handlers over
    $args->{Handler} = $self->{Handler};
    $args->{DocumentHandler} = $self->{DocumentHandler};
    $args->{ContentHandler} = $self->{ContentHandler};
    $args->{DTDHandler} = $self->{DTDHandler};
    $args->{LexicalHandler} = $self->{LexicalHandler};
    $args->{DeclHandler} = $self->{DeclHandler};
    $args->{ErrorHandler} = $self->{ErrorHandler};
    $args->{EntityResolver} = $self->{EntityResolver};

    $args->{_State_} = 0;
    $args->{Context} = [];
    $args->{ErrorMessage} ||= '';
    $args->{Namespace_Stack} = [[ xml => 'http://www.w3.org/XML/1998/namespace' ]];
    $args->{Parser} = ParserCreate($args, 
				   $args->{Source}{Encoding} 
				   || $args->{ProtocolEncoding}, 
				   1);
    $args->{Locator} = GetLocator($args->{Parser}, 
				  $args->{Source}{PublicId} || '',
				  $args->{Source}{SystemId} || '',
				  $args->{Source}{Encoding} || '',
				 );
    $args->{RecognizedString} = GetRecognizedString($args->{Parser});
    $args->{ExternEnt} = GetExternEnt($args->{Parser});

    $args->{Methods} = {};
    $args->get_start_element();
    $args->get_end_element();
    $args->get_characters();
    $args->get_comment();

    # the most common handlers are available as refs
    SetCallbacks($args->{Parser}, 
		 $args->{Methods}->{start_element},
		 $args->{Methods}->{end_element},
		 $args->{Methods}->{characters},
		 $args->{Methods}->{comment},
  		);

    $args->set_document_locator($args->{Locator});
    $args->start_document({});
   
    my $result;
    $result = $args->{ParseFunc}->($args->{Parser}, $args->{ParseFuncParam});

    ParserFree($args->{Parser});

    my $rv = $args->end_document({});   # end_document is still called on error

    croak($args->{ErrorMessage}) unless $result;
    return $rv;
}

sub _get_external_entity {
    my ($self, $base, $sysid, $pubid) = @_;

    # resolving with the base URI
    if ($base and $sysid and $sysid !~ /^[a-zA-Z]+[a-zA-Z\d\+\-\.]*:/) {
	$base =~ s/[^\/]+$//;
	$sysid = $base . $sysid;
    }

    # user defined resolution
    my $src = $self->resolve_entity({PublicId => $pubid, 
				     SystemId => $sysid});
    my $fh;
    my $result;
    my $string;
    if (ref($src) eq 'CODE') {
	$fh = IO::File->new($sysid)
	  or croak("Can't open external entity: $sysid\n");

    } elsif (ref($src) eq 'HASH') {
	if (defined $src->{CharacterStream}) {
	    $fh = $src->{CharacterStream};

	} elsif (defined $src->{ByteStream}) {
	    $fh = $src->{ByteStream};

	} elsif (defined $src->{String}) {
	    $result = $src->{String};
	    $string = 1;

	} else {
	    $fh = IO::File->new($src->{SystemId})
	      or croak("Can't open external entity: $src->{SystemId}\n");
	}

    } else {
	croak ("Invalid object returned by EntityResolver: $src\n");
    }

    unless ($string) {
	local $/;
	undef $/;
	$result = <$fh>;
	close($fh);
    }
    return $result;
}

sub _get_handler_methods {
    my $self = shift;


}

1;
__END__