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