Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / XML / SAX / PurePerl / Reader / Stream.pm
1 # $Id: Stream.pm,v 1.7 2005-10-14 20:31:20 matt Exp $
2
3 package XML::SAX::PurePerl::Reader::Stream;
4
5 use strict;
6 use vars qw(@ISA);
7
8 use XML::SAX::PurePerl::Reader qw(
9     EOF
10     BUFFER
11     LINE
12     COLUMN
13     ENCODING
14     XML_VERSION
15 );
16 use XML::SAX::Exception;
17
18 @ISA = ('XML::SAX::PurePerl::Reader');
19
20 # subclassed by adding 1 to last element
21 use constant FH => 8;
22 use constant BUFFER_SIZE => 4096;
23
24 sub new {
25     my $class = shift;
26     my $ioref = shift;
27     XML::SAX::PurePerl::Reader::set_raw_stream($ioref);
28     my @parts;
29     @parts[FH, LINE, COLUMN, BUFFER, EOF, XML_VERSION] =
30         ($ioref, 1,   0,      '',     0,   '1.0');
31     return bless \@parts, $class;
32 }
33
34 sub read_more {
35     my $self = shift;
36     my $buf;
37     my $bytesread = read($self->[FH], $buf, BUFFER_SIZE);
38     if ($bytesread) {
39         $self->[BUFFER] .= $buf;
40         return 1;
41     }
42     elsif (defined($bytesread)) {
43         $self->[EOF]++;
44         return 0;
45     }
46     else {
47         throw XML::SAX::Exception::Parse(
48             Message => "Error reading from filehandle: $!",
49         );
50     }
51 }
52
53 sub move_along {
54     my $self = shift;
55     my $discarded = substr($self->[BUFFER], 0, $_[0], '');
56     
57     # Wish I could skip this lot - tells us where we are in the file
58     my $lines = $discarded =~ tr/\n//;
59     $self->[LINE] += $lines;
60     if ($lines) {
61         $discarded =~ /\n([^\n]*)$/;
62         $self->[COLUMN] = length($1);
63     }
64     else {
65         $self->[COLUMN] += $_[0];
66     }
67 }
68
69 sub set_encoding {
70     my $self = shift;
71     my ($encoding) = @_;
72     # warn("set encoding to: $encoding\n");
73     XML::SAX::PurePerl::Reader::switch_encoding_stream($self->[FH], $encoding);
74     XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding);
75     $self->[ENCODING] = $encoding;
76 }
77
78 sub bytepos {
79     my $self = shift;
80     tell($self->[FH]);
81 }
82
83 1;
84