File Coverage

blib/lib/XML/SAX/PurePerl/Reader.pm
Criterion Covered Total %
statement 59 84 70.2
branch 8 18 44.4
condition 0 3 0.0
subroutine 20 23 86.9
pod 0 10 0.0
total 87 138 63.0


line stmt bran cond sub pod time code
1             # $Id$
2              
3             package XML::SAX::PurePerl::Reader;
4              
5 14     14   82 use strict;
  14         28  
  14         386  
6 14     14   4775 use XML::SAX::PurePerl::Reader::URI;
  14         42  
  14         420  
7 14     14   99 use Exporter ();
  14         25  
  14         245  
8              
9 14     14   61 use vars qw(@ISA @EXPORT_OK);
  14         25  
  14         921  
10             @ISA = qw(Exporter);
11             @EXPORT_OK = qw(
12             EOF
13             BUFFER
14             LINE
15             COLUMN
16             ENCODING
17             XML_VERSION
18             );
19              
20 14     14   73 use constant EOF => 0;
  14         30  
  14         802  
21 14     14   240 use constant BUFFER => 1;
  14         41  
  14         586  
22 14     14   71 use constant LINE => 2;
  14         23  
  14         588  
23 14     14   69 use constant COLUMN => 3;
  14         23  
  14         601  
24 14     14   71 use constant ENCODING => 4;
  14         36  
  14         682  
25 14     14   75 use constant SYSTEM_ID => 5;
  14         21  
  14         677  
26 14     14   72 use constant PUBLIC_ID => 6;
  14         22  
  14         604  
27 14     14   72 use constant XML_VERSION => 7;
  14         23  
  14         2128  
28              
29             require XML::SAX::PurePerl::Reader::Stream;
30             require XML::SAX::PurePerl::Reader::String;
31              
32             if ($] >= 5.007002) {
33             require XML::SAX::PurePerl::Reader::UnicodeExt;
34             }
35             else {
36             require XML::SAX::PurePerl::Reader::NoUnicodeExt;
37             }
38              
39             sub new {
40 0     0 0 0 my $class = shift;
41 0         0 my $thing = shift;
42            
43             # try to figure if this $thing is a handle of some sort
44 0 0 0     0 if (ref($thing) && UNIVERSAL::isa($thing, 'IO::Handle')) {
45 0         0 return XML::SAX::PurePerl::Reader::Stream->new($thing)->init;
46             }
47 0         0 my $ioref;
48 0 0       0 if (tied($thing)) {
49 0         0 my $class = ref($thing);
50 14     14   86 no strict 'refs';
  14         22  
  14         6450  
51 0 0       0 $ioref = $thing if defined &{"${class}::TIEHANDLE"};
  0         0  
52             }
53             else {
54 0         0 eval {
55 0         0 $ioref = *{$thing}{IO};
  0         0  
56             };
57 0         0 undef $@;
58             }
59 0 0       0 if ($ioref) {
60 0         0 return XML::SAX::PurePerl::Reader::Stream->new($thing)->init;
61             }
62            
63 0 0       0 if ($thing =~ /
64             # assume it's a string
65 0         0 return XML::SAX::PurePerl::Reader::String->new($thing)->init;
66             }
67            
68             # assume it is a uri
69 0         0 return XML::SAX::PurePerl::Reader::URI->new($thing)->init;
70             }
71              
72             sub init {
73 0     0 0 0 my $self = shift;
74 0         0 $self->[LINE] = 1;
75 0         0 $self->[COLUMN] = 1;
76 0         0 $self->read_more;
77 0         0 return $self;
78             }
79              
80             sub data {
81 24713     24713 0 32048 my ($self, $min_length) = (@_, 1);
82 24713 100       152680 if (length($self->[BUFFER]) < $min_length) {
83 123         265 $self->read_more;
84             }
85 24713         79866 return $self->[BUFFER];
86             }
87              
88             sub match {
89 3009     3009 0 4073 my ($self, $char) = @_;
90 3009         3890 my $data = $self->data;
91 3009 100       30922 if (substr($data, 0, 1) eq $char) {
92 3008         6199 $self->move_along(1);
93 3008         6969 return 1;
94             }
95 1         4 return 0;
96             }
97              
98             sub public_id {
99 28     28 0 46 my $self = shift;
100 28 100       148 @_ and $self->[PUBLIC_ID] = shift;
101 28         59 $self->[PUBLIC_ID];
102             }
103              
104             sub system_id {
105 28     28 0 52 my $self = shift;
106 28 100       73 @_ and $self->[SYSTEM_ID] = shift;
107 28         69 $self->[SYSTEM_ID];
108             }
109              
110             sub line {
111 3     3 0 9 shift->[LINE];
112             }
113              
114             sub column {
115 3     3 0 11 shift->[COLUMN];
116             }
117              
118             sub get_encoding {
119 12     12 0 22 my $self = shift;
120 12         41 return $self->[ENCODING];
121             }
122              
123             sub get_xml_version {
124 0     0 0   my $self = shift;
125 0           return $self->[XML_VERSION];
126             }
127              
128             1;
129              
130             __END__