line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Spp::Cursor; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
26
|
use 5.012; |
|
2
|
|
|
|
|
6
|
|
4
|
2
|
|
|
2
|
|
9
|
no warnings 'experimental'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
49
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
8
|
use Exporter; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
107
|
|
7
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
8
|
|
|
|
|
|
|
our @EXPORT = |
9
|
|
|
|
|
|
|
qw(new_cursor to_next cache reset_cache get_char pre_char fail_report); |
10
|
|
|
|
|
|
|
|
11
|
2
|
|
|
2
|
|
10
|
use Spp::Builtin; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
995
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub new_cursor { |
14
|
3
|
|
|
3
|
0
|
9
|
my ($str, $ns) = @_; |
15
|
3
|
|
|
|
|
11
|
my $text = add($str, End); |
16
|
3
|
|
|
|
|
8
|
my $len = len($text); |
17
|
|
|
|
|
|
|
return { |
18
|
3
|
|
|
|
|
38
|
'text' => $text, |
19
|
|
|
|
|
|
|
'ns' => $ns, |
20
|
|
|
|
|
|
|
'len' => $len, |
21
|
|
|
|
|
|
|
'off' => 0, |
22
|
|
|
|
|
|
|
'line' => 1, |
23
|
|
|
|
|
|
|
'depth' => 0, |
24
|
|
|
|
|
|
|
'maxoff' => 0, |
25
|
|
|
|
|
|
|
'maxline' => 1 |
26
|
|
|
|
|
|
|
}; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub to_next { |
30
|
39
|
|
|
39
|
0
|
60
|
my $cursor = shift; |
31
|
39
|
50
|
|
|
|
65
|
if (get_char($cursor) eq "\n") { $cursor->{'line'}++ } |
|
0
|
|
|
|
|
0
|
|
32
|
39
|
|
|
|
|
58
|
$cursor->{'off'}++; |
33
|
39
|
100
|
|
|
|
76
|
if ($cursor->{'off'} > $cursor->{'maxoff'}) { |
34
|
36
|
|
|
|
|
46
|
$cursor->{'maxoff'} = $cursor->{'off'}; |
35
|
36
|
|
|
|
|
53
|
$cursor->{'maxline'} = $cursor->{'line'}; |
36
|
|
|
|
|
|
|
} |
37
|
39
|
|
|
|
|
52
|
return True; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub cache { |
41
|
325
|
|
|
325
|
0
|
373
|
my $cursor = shift; |
42
|
325
|
|
|
|
|
383
|
my $off = $cursor->{'off'}; |
43
|
325
|
|
|
|
|
340
|
my $line = $cursor->{'line'}; |
44
|
325
|
|
|
|
|
635
|
return [$off, $line]; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub reset_cache { |
48
|
224
|
|
|
224
|
0
|
300
|
my ($cursor, $cache) = @_; |
49
|
224
|
|
|
|
|
307
|
$cursor->{'off'} = $cache->[0]; |
50
|
224
|
|
|
|
|
288
|
$cursor->{'line'} = $cache->[1]; |
51
|
224
|
|
|
|
|
357
|
return True; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub get_char { |
55
|
273
|
|
|
273
|
0
|
308
|
my $cursor = shift; |
56
|
273
|
|
|
|
|
727
|
return substr($cursor->{'text'}, $cursor->{'off'}, 1); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub pre_char { |
60
|
0
|
|
|
0
|
0
|
|
my $cursor = shift; |
61
|
0
|
|
|
|
|
|
return substr($cursor->{'text'}, $cursor->{'off'} - 1, 1); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub fail_report { |
65
|
0
|
|
|
0
|
0
|
|
my $cursor = shift; |
66
|
0
|
|
|
|
|
|
my $text = $cursor->{'text'}; |
67
|
0
|
|
|
|
|
|
my $off = $cursor->{'maxoff'}; |
68
|
0
|
|
|
|
|
|
my $line = $cursor->{'maxline'}; |
69
|
0
|
|
|
|
|
|
my $line_str = to_end(substr($text, $off)); |
70
|
0
|
|
|
|
|
|
return "line: $line Stop match:\n$line_str\n^"; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
1; |