local-lib5/lib/perl5/i486-linux-gnu-thread-multi/XML/LibXML/Reader.pm

   1 # $Id: Reader.pm,v 1.1.2.1 2004/04/20 20:09:48 pajas Exp $
   2 #
   3 # This is free software, you may use it and distribute it under the same terms as
   4 # Perl itself.
   5 #
   6 # Copyright 2001-2003 AxKit.com Ltd., 2002-2006 Christian Glahn, 2006-2009 Petr Pajas
   7 #
   8 #
   9 package XML::LibXML::Reader;
  10
  11 use XML::LibXML;
  12 use Carp;
  13 use strict;
  14 use warnings;
  15
  16 use vars qw ($VERSION);
  17 $VERSION = "1.70"; # VERSION TEMPLATE: DO NOT CHANGE
  18
  19 use 5.008_000;
  20
  21 BEGIN {
  22   UNIVERSAL::can('XML::LibXML::Reader','_newForFile') or
  23       croak("Cannot use XML::LibXML::Reader module - ".
  24             "your libxml2 is compiled without reader support!");
  25 }
  26
  27 use base qw(Exporter);
  28 use constant {
  29     XML_READER_TYPE_NONE => 0,
  30     XML_READER_TYPE_ELEMENT => 1,
  31     XML_READER_TYPE_ATTRIBUTE => 2,
  32     XML_READER_TYPE_TEXT => 3,
  33     XML_READER_TYPE_CDATA => 4,
  34     XML_READER_TYPE_ENTITY_REFERENCE => 5,
  35     XML_READER_TYPE_ENTITY => 6,
  36     XML_READER_TYPE_PROCESSING_INSTRUCTION => 7,
  37     XML_READER_TYPE_COMMENT => 8,
  38     XML_READER_TYPE_DOCUMENT => 9,
  39     XML_READER_TYPE_DOCUMENT_TYPE => 10,
  40     XML_READER_TYPE_DOCUMENT_FRAGMENT => 11,
  41     XML_READER_TYPE_NOTATION => 12,
  42     XML_READER_TYPE_WHITESPACE => 13,
  43     XML_READER_TYPE_SIGNIFICANT_WHITESPACE => 14,
  44     XML_READER_TYPE_END_ELEMENT => 15,
  45     XML_READER_TYPE_END_ENTITY => 16,
  46     XML_READER_TYPE_XML_DECLARATION => 17,
  47
  48     XML_READER_NONE      => -1,
  49     XML_READER_START     =>  0,
  50     XML_READER_ELEMENT   =>  1,
  51     XML_READER_END       =>  2,
  52     XML_READER_EMPTY     =>  3,
  53     XML_READER_BACKTRACK =>  4,
  54     XML_READER_DONE      =>  5,
  55     XML_READER_ERROR     =>  6
  56 };
  57 use vars qw( @EXPORT @EXPORT_OK %EXPORT_TAGS );
  58
  59 sub CLONE_SKIP { 1 }
  60
  61 BEGIN {
  62
  63 %EXPORT_TAGS = (
  64   types =>
  65   [qw(
  66     XML_READER_TYPE_NONE
  67     XML_READER_TYPE_ELEMENT
  68     XML_READER_TYPE_ATTRIBUTE
  69     XML_READER_TYPE_TEXT
  70     XML_READER_TYPE_CDATA
  71     XML_READER_TYPE_ENTITY_REFERENCE
  72     XML_READER_TYPE_ENTITY
  73     XML_READER_TYPE_PROCESSING_INSTRUCTION
  74     XML_READER_TYPE_COMMENT
  75     XML_READER_TYPE_DOCUMENT
  76     XML_READER_TYPE_DOCUMENT_TYPE
  77     XML_READER_TYPE_DOCUMENT_FRAGMENT
  78     XML_READER_TYPE_NOTATION
  79     XML_READER_TYPE_WHITESPACE
  80     XML_READER_TYPE_SIGNIFICANT_WHITESPACE
  81     XML_READER_TYPE_END_ELEMENT
  82     XML_READER_TYPE_END_ENTITY
  83     XML_READER_TYPE_XML_DECLARATION
  84     )],
  85   states =>
  86   [qw(
  87     XML_READER_NONE
  88     XML_READER_START
  89     XML_READER_ELEMENT
  90     XML_READER_END
  91     XML_READER_EMPTY
  92     XML_READER_BACKTRACK
  93     XML_READER_DONE
  94     XML_READER_ERROR
  95    )]
  96 );
  97 @EXPORT    = (@{$EXPORT_TAGS{types}},@{$EXPORT_TAGS{states}});
  98 @EXPORT_OK = @EXPORT;
  99 $EXPORT_TAGS{all}=\@EXPORT_OK;
 100 }
 101
 102 {
 103   my %props = (
 104     load_ext_dtd => 1,           # load the external subset
 105     complete_attributes => 2,    # default DTD attributes
 106     validation => 3,             # validate with the DTD
 107     expand_entities => 4,        # substitute entities
 108   );
 109   sub getParserProp {
 110     my ($self, $name) = @_;
 111     my $prop = $props{$name};
 112     return undef unless defined $prop;
 113     return $self->_getParserProp($prop);
 114   }
 115   sub setParserProp {
 116     my $self = shift;
 117     my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_;
 118     my ($key, $value);
 119     while (($key,$value) = each %args) {
 120       my $prop = $props{ $key };
 121       $self->_setParserProp($prop,$value);
 122     }
 123     return;
 124   }
 125
 126   my (%string_pool,%rng_pool,%xsd_pool); # used to preserve data passed to the reader
 127   sub new {
 128     my ($class) = shift;
 129     my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_;
 130     my $encoding = $args{encoding};
 131     my $URI = $args{URI};
 132     $URI="$URI" if defined $URI; # stringify in case it is an URI object
 133     my $options = XML::LibXML->_parser_options(\%args);
 134
 135     my $self = undef;
 136     if ( defined $args{location} ) {
 137       $self = $class->_newForFile( $args{location}, $encoding, $options );
 138     }
 139     elsif ( defined $args{string} ) {
 140       $self = $class->_newForString( $args{string}, $URI, $encoding, $options );
 141       $string_pool{$self} = \$args{string};
 142     }
 143     elsif ( defined $args{IO} ) {
 144       $self = $class->_newForIO( $args{IO}, $URI, $encoding, $options  );
 145     }
 146     elsif ( defined $args{DOM} ) {
 147       croak("DOM must be a XML::LibXML::Document node")
 148         unless UNIVERSAL::isa($args{DOM}, 'XML::LibXML::Document');
 149       $self = $class->_newForDOM( $args{DOM} );
 150     }
 151     elsif ( defined $args{FD} ) {
 152       my $fd = fileno($args{FD});
 153       $self = $class->_newForFd( $fd, $URI, $encoding, $options  );
 154     }
 155     else {
 156       croak("XML::LibXML::Reader->new: specify location, string, IO, DOM, or FD");
 157     }
 158     if ($args{RelaxNG}) {
 159       if (ref($args{RelaxNG})) {
 160         $rng_pool{$self} = \$args{RelaxNG};
 161         $self->_setRelaxNG($args{RelaxNG});
 162       } else {
 163         $self->_setRelaxNGFile($args{RelaxNG});
 164       }
 165     }
 166     if ($args{Schema}) {
 167       if (ref($args{Schema})) {
 168         $xsd_pool{$self} = \$args{Schema};
 169         $self->_setXSD($args{Schema});
 170       } else {
 171         $self->_setXSDFile($args{Schema});
 172       }
 173     }
 174     return $self;
 175   }
 176   sub DESTROY {
 177     my $self = shift;
 178     delete $string_pool{$self};
 179     delete $rng_pool{$self};
 180     delete $xsd_pool{$self};
 181     $self->_DESTROY;
 182   }
 183 }
 184 sub close {
 185     my ($reader) = @_;
 186     # _close return -1 on failure, 0 on success
 187     # perl close returns 0 on failure, 1 on success
 188     return $reader->_close == 0 ? 1 : 0;
 189 }
 190
 191 sub preservePattern {
 192   my $reader=shift;
 193   my ($pattern,$ns_map)=@_;
 194   if (ref($ns_map) eq 'HASH') {
 195     # translate prefix=>URL hash to a (URL,prefix) list
 196     $reader->_preservePattern($pattern,[reverse %$ns_map]);
 197   } else {
 198     $reader->_preservePattern(@_);
 199   }
 200 }
 201
 202 sub nodePath {
 203   my $reader=shift;
 204   my $path = $reader->_nodePath;
 205   $path=~s/\[\d+\]//g; # make /foo[1]/bar[1] just /foo/bar, since
 206                        # sibling count in the buffered fragment is
 207                        # basically random and generally misleading
 208   return $path;
 209 }
 210
 211 1;
 212 __END__