|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
  
 
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # $Id$  | 
| 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package XML::SAX::PurePerl::Reader::String;  | 
| 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
5
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
82
 | 
 use strict;  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
377
 | 
    | 
| 
6
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
61
 | 
 use vars qw(@ISA);  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
589
 | 
    | 
| 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
8
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
767
 | 
 use XML::SAX::PurePerl::Reader qw(  | 
| 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     LINE  | 
| 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     COLUMN  | 
| 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     BUFFER  | 
| 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     ENCODING  | 
| 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     EOF  | 
| 
14
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
71
 | 
 );  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
    | 
| 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = ('XML::SAX::PurePerl::Reader');  | 
| 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
18
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
88
 | 
 use constant DISCARDED  => 8;  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
736
 | 
    | 
| 
19
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
81
 | 
 use constant STRING     => 9;  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
647
 | 
    | 
| 
20
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
72
 | 
 use constant USED       => 10;  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
32
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
617
 | 
    | 
| 
21
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
72
 | 
 use constant CHUNK_SIZE => 2048;  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5601
 | 
    | 
| 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
24
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
  
0
  
 | 
10
 | 
     my $class = shift;  | 
| 
25
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
     my $string = shift;  | 
| 
26
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
     my @parts;  | 
| 
27
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
     @parts[BUFFER, EOF, LINE, COLUMN, DISCARDED, STRING, USED] =  | 
| 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         ('',   0,   1,    0,       0, $string, 0);  | 
| 
29
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
     return bless \@parts, $class;  | 
| 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub read_more () {  | 
| 
33
 | 
12
 | 
 
 | 
 
 | 
  
12
  
 | 
  
0
  
 | 
20
 | 
     my $self = shift;  | 
| 
34
 | 
12
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
35
 | 
     if ($self->[USED] >= length($self->[STRING])) {  | 
| 
35
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
         $self->[EOF]++;  | 
| 
36
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
         return 0;  | 
| 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
38
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
     my $bytes = CHUNK_SIZE;  | 
| 
39
 | 
4
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
25
 | 
     if ($bytes > (length($self->[STRING]) - $self->[USED])) {  | 
| 
40
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
        $bytes = (length($self->[STRING]) - $self->[USED]);  | 
| 
41
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
42
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
     $self->[BUFFER] .= substr($self->[STRING], $self->[USED], $bytes);  | 
| 
43
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
     $self->[USED] += $bytes;  | 
| 
44
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
     return 1;  | 
| 
45
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  }  | 
| 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub move_along {  | 
| 
49
 | 
46
 | 
 
 | 
 
 | 
  
46
  
 | 
  
0
  
 | 
74
 | 
     my($self, $bytes) = @_;  | 
| 
50
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
137
 | 
     my $discarded = substr($self->[BUFFER], 0, $bytes, '');  | 
| 
51
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
70
 | 
     $self->[DISCARDED] += length($discarded);  | 
| 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       | 
| 
53
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # Wish I could skip this lot - tells us where we are in the file  | 
| 
54
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
104
 | 
     my $lines = $discarded =~ tr/\n//;  | 
| 
55
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
59
 | 
     $self->[LINE] += $lines;  | 
| 
56
 | 
46
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
87
 | 
     if ($lines) {  | 
| 
57
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
         $discarded =~ /\n([^\n]*)$/;  | 
| 
58
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
         $self->[COLUMN] = length($1);  | 
| 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
60
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
61
 | 
43
 | 
 
 | 
 
 | 
 
 | 
 
 | 
94
 | 
         $self->[COLUMN] += $_[0];  | 
| 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
63
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
65
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub set_encoding {  | 
| 
66
 | 
3
 | 
 
 | 
 
 | 
  
3
  
 | 
  
0
  
 | 
7
 | 
     my $self = shift;  | 
| 
67
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
     my ($encoding) = @_;  | 
| 
68
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
69
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
46
 | 
     XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding, "utf-8");  | 
| 
70
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
768
 | 
     $self->[ENCODING] = $encoding;  | 
| 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
73
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub bytepos {  | 
| 
74
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
  
0
  
 | 
 
 | 
     my $self = shift;  | 
| 
75
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $self->[DISCARDED];  | 
| 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
77
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
78
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  |