File Coverage

blib/lib/Text/TokenStream.pm
Criterion Covered Total %
statement 79 81 97.5
branch 11 18 61.1
condition 3 7 42.8
subroutine 19 21 90.4
pod 9 9 100.0
total 121 136 88.9


line stmt bran cond sub pod time code
1             package Text::TokenStream;
2              
3 1     1   75864 use v5.12;
  1         8  
4 1     1   552 use Moo;
  1         10854  
  1         4  
5              
6             our $VERSION = '0.03';
7              
8 1     1   1499 use List::Util qw(max);
  1         2  
  1         95  
9 1     1   535 use Types::Path::Tiny qw(Path);
  1         112985  
  1         8  
10 1     1   421 use Types::Standard qw(ArrayRef Int Maybe ScalarRef Str);
  1         3  
  1         5  
11 1     1   1579 use Text::TokenStream::Token;
  1         5  
  1         49  
12 1     1   8 use Text::TokenStream::Types qw(Lexer Position TokenClass);
  1         2  
  1         9  
13              
14 1     1   772 use namespace::clean;
  1         2  
  1         7  
15              
16             has input_name => (is => 'ro', isa => Maybe[Path], coerce => 1, default => undef);
17              
18             has input => (is => 'ro', isa => Str, required => 1);
19              
20             has lexer => (
21             is => 'ro',
22             isa => Lexer,
23             required => 1,
24             handles => { next_lexer_token => 'next_token' },
25             );
26              
27             has token_class => (
28             is => 'lazy',
29             isa => TokenClass,
30 0     0   0 builder => sub { 'Text::TokenStream::Token' },
31             );
32              
33             has _pending => (is => 'ro', isa => ArrayRef, default => sub { [] });
34              
35             has _input_ref => (is => 'lazy', isa => ScalarRef[Str], builder => sub {
36 1     1   15 my ($self) = @_;
37 1         8 my $copy = $self->input;
38 1         17 return \$copy;
39             });
40              
41             has current_position => (
42             is => 'ro',
43             writer => '_set_current_position',
44             isa => Position,
45             default => 0,
46             init_arg => undef,
47             );
48              
49             with qw(Text::TokenStream::Role::Stream);
50              
51             # Only to be called if the buffer has at least one token
52             sub _next {
53 8     8   17 my ($self) = @_;
54 8         9 my $tok = shift @{ $self->_pending };
  8         19  
55 8         164 $self->_set_current_position( $tok->position + length($tok->text) );
56 8         246 return $tok;
57             }
58              
59             sub next {
60 6     6 1 1906 my ($self) = @_;
61 6 50       14 $self->fill(1) or return undef;
62 6         14 return $self->_next;
63             }
64              
65             sub fill {
66 21     21 1 1498 my ($self, $n) = @_;
67              
68 21         461 my $input_ref = $self->_input_ref;
69 21         201 my $input_len = length($self->input);
70              
71 21         40 my $pending = $self->_pending;
72 21         58 while (@$pending < $n) {
73 11   50     277 my $tok = $self->next_lexer_token($input_ref) // return 0;
74 11         26 my $position = $input_len - length($$input_ref) - length($tok->{text});
75 11         42 push @$pending, $self->create_token(%$tok, position => $position);
76             }
77              
78 21         310 return 1;
79             }
80              
81             sub create_token {
82 11     11 1 38 my ($self, %data) = @_;
83 11         198 return $self->token_class->new(%data);
84             }
85              
86             sub peek {
87 12     12 1 1400 my ($self) = @_;
88 12 50       26 $self->fill(1) or return undef;
89 12         55 return $self->_pending->[0];
90             }
91              
92             sub skip_optional {
93 2     2 1 7 my ($self, $target) = @_;
94 2   50     5 my $tok = $self->peek // return 0;
95 2 100       10 return 0 if !$tok->matches($target);
96 1         4 $self->_next;
97 1         6 return 1;
98             }
99              
100             sub looking_at {
101 2     2 1 1429 my ($self, @targets) = @_;
102              
103 2 50       7 $self->fill(scalar @targets) or return 0;
104              
105 2         13 my $pending = $self->_pending;
106 2         8 for my $i (0 .. $#targets) {
107 3 50       17 return 0 if !$pending->[$i]->matches($targets[$i]);
108             }
109              
110 2         23 return 1;
111             }
112              
113             sub next_of {
114 3     3 1 3316 my ($self, $target, $where) = @_;
115 3   33     9 my $tok = $self->peek
116             // $self->err(join ' ', "Missing token", grep defined, $where);
117 3 100       11 $self->token_err($tok, join ' ', "Unexpected", $tok->type, "token", grep defined, $where)
118             if !$tok->matches($target);
119 1         7 return $self->_next;
120             }
121              
122             sub _err {
123 2     2   8 my ($self, $token, @message) = @_;
124 2 50       9 my $position = $token ? $token->position : $self->current_position;
125 2         14 my $marker = '^' x max(6, map length($_->text), grep defined, $token);
126 2         6 my $input = $self->input;
127 2         6 my $prefix = substr $input, 0, $position;
128 2         15 (my $line_prefix = $prefix) =~ s/^.*\n//s;
129 2         6 (my $space_prefix = $line_prefix) =~ tr/\t/ /c;
130 2         13 (my $line_suffix = substr $input, $position) =~ s/\r?\n.*//s;
131 2         5 my $line_number = 1 + ($prefix =~ tr/\n//);
132 2         4 my $column_number = 1 + length $line_prefix;
133 2         7 my $input_name = $self->input_name;
134 2 50       6 my $file_line = defined $input_name ? "File $input_name, line" : "Line";
135 2 50       6 @message = q[Something's wrong] if !@message;
136 2         10 my $message = join '', (
137             "SORRY! $file_line $line_number, column $column_number: ", @message, "\n",
138             $line_prefix, $line_suffix, "\n",
139             $space_prefix, $marker, "\n",
140             );
141 2         16 die $message;
142             }
143              
144 2     2 1 28 sub token_err { shift->_err( @_) }
145 0     0 1   sub err { shift->_err(undef, @_) }
146              
147             1;
148             __END__