Reader.pm   [plain text]

package XML::LibXML::Reader;
use XML::LibXML;

use strict;
use warnings;

use vars qw ($VERSION);
$VERSION = "1.65"; # VERSION TEMPLATE: DO NOT CHANGE

use Carp;
use 5.8.0;
use base qw(Exporter);
use constant {
    XML_READER_TYPE_NONE => 0,
    XML_READER_TYPE_ELEMENT => 1,
    XML_READER_TYPE_ATTRIBUTE => 2,
    XML_READER_TYPE_TEXT => 3,
    XML_READER_TYPE_CDATA => 4,
    XML_READER_TYPE_ENTITY_REFERENCE => 5,
    XML_READER_TYPE_ENTITY => 6,
    XML_READER_TYPE_PROCESSING_INSTRUCTION => 7,
    XML_READER_TYPE_COMMENT => 8,
    XML_READER_TYPE_DOCUMENT => 9,
    XML_READER_TYPE_DOCUMENT_TYPE => 10,
    XML_READER_TYPE_DOCUMENT_FRAGMENT => 11,
    XML_READER_TYPE_NOTATION => 12,
    XML_READER_TYPE_WHITESPACE => 13,
    XML_READER_TYPE_SIGNIFICANT_WHITESPACE => 14,
    XML_READER_TYPE_END_ELEMENT => 15,
    XML_READER_TYPE_END_ENTITY => 16,
    XML_READER_TYPE_XML_DECLARATION => 17,

    XML_READER_NONE      => -1,
    XML_READER_START     =>  0,
    XML_READER_ELEMENT   =>  1,
    XML_READER_END       =>  2,
    XML_READER_EMPTY     =>  3,
    XML_READER_BACKTRACK =>  4,
    XML_READER_DONE      =>  5,
    XML_READER_ERROR     =>  6
};
use vars qw( @EXPORT @EXPORT_OK %EXPORT_TAGS );

BEGIN {

%EXPORT_TAGS = (
  types =>
  [qw(
    XML_READER_TYPE_NONE
    XML_READER_TYPE_ELEMENT
    XML_READER_TYPE_ATTRIBUTE
    XML_READER_TYPE_TEXT
    XML_READER_TYPE_CDATA
    XML_READER_TYPE_ENTITY_REFERENCE
    XML_READER_TYPE_ENTITY
    XML_READER_TYPE_PROCESSING_INSTRUCTION
    XML_READER_TYPE_COMMENT
    XML_READER_TYPE_DOCUMENT
    XML_READER_TYPE_DOCUMENT_TYPE
    XML_READER_TYPE_DOCUMENT_FRAGMENT
    XML_READER_TYPE_NOTATION
    XML_READER_TYPE_WHITESPACE
    XML_READER_TYPE_SIGNIFICANT_WHITESPACE
    XML_READER_TYPE_END_ELEMENT
    XML_READER_TYPE_END_ENTITY
    XML_READER_TYPE_XML_DECLARATION
    )],
  states =>
  [qw(
    XML_READER_NONE
    XML_READER_START
    XML_READER_ELEMENT
    XML_READER_END
    XML_READER_EMPTY
    XML_READER_BACKTRACK
    XML_READER_DONE
    XML_READER_ERROR
   )]
);
@EXPORT    = (@{$EXPORT_TAGS{types}},@{$EXPORT_TAGS{states}});
@EXPORT_OK = @EXPORT;
$EXPORT_TAGS{all}=\@EXPORT_OK;
}

{
  my %flags = (
    recover => 1,		 # recover on errors
    expand_entities => 2,	 # substitute entities
    load_ext_dtd => 4,		 # load the external subset
    complete_attributes => 8,	 # default DTD attributes
    validation => 16,		 # validate with the DTD
    suppress_errors => 32,	 # suppress error reports
    suppress_warnings => 64,	 # suppress warning reports
    pedantic_parser => 128,	 # pedantic error reporting
    no_blanks => 256,		 # remove blank nodes
    expand_xinclude => 1024,	 # Implement XInclude substitition
    xinclude => 1024,		 # ... alias
    no_network => 2048,		 # Forbid network access
    clean_namespaces => 8192,    # remove redundant namespaces declarations
    no_cdata => 16384,		 # merge CDATA as text nodes
    no_xinclude_nodes => 32768,	 # do not generate XINCLUDE START/END nodes
  );
  sub _parser_options {
    my ($opts) = @_;

    # currently dictionaries break XML::LibXML memory management
    my $no_dict = 4096;
    my $flags = $no_dict;     # safety precaution

    my ($key, $value);
    while (($key,$value) = each %$opts) {
      my $f = $flags{ $key };
      if (defined $f) {
	if ($value) {
	  $flags |= $f
	} else {
	  $flags &= ~$f;
	}
      }
    }
    return $flags;
  }
  my %props = (
    load_ext_dtd => 1,		 # load the external subset
    complete_attributes => 2,	 # default DTD attributes
    validation => 3,		 # validate with the DTD
    expand_entities => 4,	 # substitute entities
  );
  sub getParserProp {
    my ($self, $name) = @_;
    my $prop = $props{$name};
    return undef unless defined $prop;
    return $self->_getParserProp($prop);
  }
  sub setParserProp {
    my $self = shift;
    my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_;
    my ($key, $value);
    while (($key,$value) = each %args) {
      my $prop = $props{ $key };
      $self->_setParserProp($prop,$value);
    }
    return;
  }

  my (%string_pool,%rng_pool,%xsd_pool); # used to preserve data passed to the reader
  sub new {
    my ($class) = shift;
    my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_;
    my $encoding = $args{encoding};
    my $URI = $args{URI};
    my $options = _parser_options(\%args);

    my $self = undef;
    if ( defined $args{location} ) {
      $self = $class->_newForFile( $args{location}, $encoding, $options );
    }
    elsif ( defined $args{string} ) {
      $self = $class->_newForString( $args{string}, $URI, $encoding, $options );
      $string_pool{$self} = \$args{string};
    }
    elsif ( defined $args{IO} ) {
      $self = $class->_newForIO( $args{IO}, $URI, $encoding, $options  );
    }
    elsif ( defined $args{DOM} ) {
      croak("DOM must be a XML::LibXML::Document node")
	unless UNIVERSAL::isa($args{DOM}, 'XML::LibXML::Document');
      $self = $class->_newForDOM( $args{DOM} );
    }
    elsif ( defined $args{FD} ) {
      my $fd = fileno($args{FD});
      $self = $class->_newForFd( $fd, $URI, $encoding, $options  );
    }
    else {
      croak("XML::LibXML::Reader->new: specify location, string, IO, DOM, or FD");
    }
    if ($args{RelaxNG}) {
      if (ref($args{RelaxNG})) {
	$rng_pool{$self} = \$args{RelaxNG};
	$self->_setRelaxNG($args{RelaxNG});
      } else {
	$self->_setRelaxNGFile($args{RelaxNG});
      }
    }
    if ($args{Schema}) {
      if (ref($args{Schema})) {
	$xsd_pool{$self} = \$args{Schema};
	$self->_setXSD($args{Schema});
      } else {
	$self->_setXSDFile($args{Schema});
      }
    }
    return $self;
  }
  sub DESTROY {
    my $self = shift;
    delete $string_pool{$self};
    delete $rng_pool{$self};
    delete $xsd_pool{$self};
    $self->_DESTROY;
  }
}
sub close {
    my ($reader) = @_;
    # _close return -1 on failure, 0 on success
    # perl close returns 0 on failure, 1 on success
    return $reader->_close == 0 ? 1 : 0;
}

sub preservePattern {
  my $reader=shift;
  my ($pattern,$ns_map)=@_;
  if (ref($ns_map) eq 'HASH') {
    # translate prefix=>URL hash to a (URL,prefix) list
    $reader->_preservePattern($pattern,[reverse %$ns_map]);
  } else {
    $reader->_preservePattern(@_);
  }
}

1;
__END__