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 |
|