File Coverage

blib/lib/XML/LibXML/Reader.pm
Criterion Covered Total %
statement 82 92 89.1
branch 28 36 77.7
condition n/a
subroutine 17 19 89.4
pod 5 6 83.3
total 132 153 86.2


line stmt bran cond sub pod time code
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 3     3   98619 use XML::LibXML;
  3         6  
  3         15  
12 3     3   17 use Carp;
  3         6  
  3         134  
13 3     3   13 use strict;
  3         5  
  3         49  
14 3     3   12 use warnings;
  3         5  
  3         86  
15              
16 3     3   13 use vars qw ($VERSION);
  3         5  
  3         185  
17             $VERSION = "2.0208"; # VERSION TEMPLATE: DO NOT CHANGE
18              
19 3     3   61 use 5.008_000;
  3         14  
20              
21             BEGIN {
22 3 50   3   89 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 3     3   24 use base qw(Exporter);
  3         4  
  3         447  
28             use constant {
29 3         686 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 3     3   18 };
  3         5  
57 3     3   17 use vars qw( @EXPORT @EXPORT_OK %EXPORT_TAGS );
  3         5  
  3         429  
58              
59 0     0   0 sub CLONE_SKIP { 1 }
60              
61             BEGIN {
62              
63 3     3   34 %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 3         7 @EXPORT = (@{$EXPORT_TAGS{types}},@{$EXPORT_TAGS{states}});
  3         13  
  3         13  
98 3         19 @EXPORT_OK = @EXPORT;
99 3         2161 $EXPORT_TAGS{all}=\@EXPORT_OK;
100             }
101              
102             our %_preserve_flag;
103              
104             {
105             my %props = (
106             load_ext_dtd => 1, # load the external subset
107             complete_attributes => 2, # default DTD attributes
108             validation => 3, # validate with the DTD
109             expand_entities => 4, # substitute entities
110             );
111             sub getParserProp {
112 1     1 1 17458 my ($self, $name) = @_;
113 1         3 my $prop = $props{$name};
114 1 50       4 return undef unless defined $prop;
115 1         8 return $self->_getParserProp($prop);
116             }
117             sub setParserProp {
118 0     0 1 0 my $self = shift;
119 0 0       0 my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_;
  0         0  
120 0         0 my ($key, $value);
121 0         0 while (($key,$value) = each %args) {
122 0         0 my $prop = $props{ $key };
123 0         0 $self->_setParserProp($prop,$value);
124             }
125 0         0 return;
126             }
127              
128             my (%string_pool,%rng_pool,%xsd_pool); # used to preserve data passed to the reader
129             sub new {
130 20     20 0 949 my ($class) = shift;
131 20 100       43 my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_;
  77         187  
132 20         44 my $encoding = $args{encoding};
133 20         36 my $URI = $args{URI};
134 20 100       47 $URI="$URI" if defined $URI; # stringify in case it is an URI object
135 20         78 my $options = XML::LibXML->_parser_options(\%args);
136              
137 20         47 my $self = undef;
138 20 100       61 if ( defined $args{location} ) {
    100          
    100          
    100          
    50          
139 9         646 $self = $class->_newForFile( $args{location}, $encoding, $options );
140             }
141             elsif ( defined $args{string} ) {
142 8         280 $self = $class->_newForString( $args{string}, $URI, $encoding, $options );
143 8 50       35 if (defined($self)) {
144 8         41 $string_pool{$self} = \$args{string};
145             }
146             }
147             elsif ( defined $args{IO} ) {
148 1         19 $self = $class->_newForIO( $args{IO}, $URI, $encoding, $options );
149             }
150             elsif ( defined $args{DOM} ) {
151             croak("DOM must be a XML::LibXML::Document node")
152 1 50       7 unless UNIVERSAL::isa($args{DOM}, 'XML::LibXML::Document');
153 1         7 $self = $class->_newForDOM( $args{DOM} );
154             }
155             elsif ( defined $args{FD} ) {
156 1         4 my $fd = fileno($args{FD});
157 1         53 $self = $class->_newForFd( $fd, $URI, $encoding, $options );
158             }
159             else {
160 0         0 croak("XML::LibXML::Reader->new: specify location, string, IO, DOM, or FD");
161             }
162 20 100       80 if ($args{RelaxNG}) {
163 4 100       10 if (ref($args{RelaxNG})) {
164 2         7 $rng_pool{$self} = \$args{RelaxNG};
165 2         8 $self->_setRelaxNG($args{RelaxNG});
166             } else {
167 2         273 $self->_setRelaxNGFile($args{RelaxNG});
168             }
169             }
170 20 100       53 if ($args{Schema}) {
171 4 100       12 if (ref($args{Schema})) {
172 2         7 $xsd_pool{$self} = \$args{Schema};
173 2         12 $self->_setXSD($args{Schema});
174             } else {
175 2         413 $self->_setXSDFile($args{Schema});
176             }
177             }
178 20         88 return $self;
179             }
180             sub DESTROY {
181 20     20   11084 my $self = shift;
182 20         59 delete $string_pool{$self};
183 20         27 delete $rng_pool{$self};
184 20         33 delete $xsd_pool{$self};
185 20         593 $self->_DESTROY;
186             }
187             }
188             sub close {
189 1     1 1 2 my ($reader) = @_;
190             # _close return -1 on failure, 0 on success
191             # perl close returns 0 on failure, 1 on success
192 1 50       43 return $reader->_close == 0 ? 1 : 0;
193             }
194              
195             sub preservePattern {
196 2     2 1 9 my $reader=shift;
197 2         4 my ($pattern,$ns_map)=@_;
198 2 100       6 if (ref($ns_map) eq 'HASH') {
199             # translate prefix=>URL hash to a (URL,prefix) list
200 1         8 $reader->_preservePattern($pattern,[reverse %$ns_map]);
201             } else {
202 1         11 $reader->_preservePattern(@_);
203             }
204             }
205              
206             sub nodePath {
207 8     8 1 647 my $reader=shift;
208 8         34 my $path = $reader->_nodePath;
209 8         20 $path=~s/\[\d+\]//g; # make /foo[1]/bar[1] just /foo/bar, since
210             # sibling count in the buffered fragment is
211             # basically random and generally misleading
212 8         38 return $path;
213             }
214              
215             1;
216             __END__