File Coverage

blib/lib/Text/TokenStream/Lexer.pm
Criterion Covered Total %
statement 52 52 100.0
branch 11 12 91.6
condition n/a
subroutine 14 14 100.0
pod 2 2 100.0
total 79 80 98.7


line stmt bran cond sub pod time code
1             package Text::TokenStream::Lexer;
2              
3 2     2   87925 use v5.12;
  2         9  
4 2     2   668 use Moo;
  2         12244  
  2         14  
5              
6             our $VERSION = '0.03';
7              
8 2     2   2064 use Carp qw(confess);
  2         4  
  2         175  
9 2     2   16 use List::Util qw(pairmap);
  2         5  
  2         180  
10 2     2   692 use Text::TokenStream::Types qw(Identifier LexerRule);
  2         6  
  2         24  
11 2     2   1279 use Types::Standard qw(ArrayRef CycleTuple ScalarRef Str);
  2         7  
  2         14  
12              
13 2     2   3027 use namespace::clean;
  2         11910  
  2         17  
14              
15             has rules => (
16             is => 'ro',
17             isa => CycleTuple[Identifier, LexerRule],
18             required => 1,
19             );
20              
21             has whitespace => (
22             is => 'ro',
23             isa => ArrayRef[LexerRule],
24             default => sub { [] },
25             );
26              
27             has _whitespace_rx => (is => 'lazy', init_arg => undef, builder => sub {
28 3     3   38 my ($self) = @_;
29 3 50       8 my @whitespace = map ref() ? $_ : quotemeta, @{ $self->whitespace }
  3 100       50  
30             or return qr/(*FAIL)/;
31 2         7 local $" = '|';
32 2         92 return qr/^(?:@whitespace)/;
33             });
34              
35             has _rules_rx => (is => 'lazy', init_arg => undef, builder => sub {
36 3     3   44 my ($self) = @_;
37 19     19   510 my @annotated_rules = pairmap { qr/$b(*MARK:$a)/ }
38 19 100   19   66 pairmap { $a => (ref $b ? $b : quotemeta $b) }
39 3 100       21 @{ $self->rules }
  3         56  
40             or return qr/(*FAIL)/;
41 2         19 local $" = '|';
42 2         514 qr/^(?|@annotated_rules)/;
43             });
44              
45             sub skip_whitespace {
46 35     35 1 1459 my ($self, $str_ref) = @_;
47 35         125 (ScalarRef[Str])->assert_valid($str_ref);
48              
49 35         16918 my $ret = 0;
50 35         2113 my $whitespace_rx = $self->_whitespace_rx;
51 35         482 $ret = 1 while $$str_ref =~ s/$whitespace_rx//;
52              
53 35         88 return $ret;
54             }
55              
56             sub next_token {
57 35     35 1 2484 my ($self, $str_ref) = @_;
58 35         114 (ScalarRef[Str])->assert_valid($str_ref);
59              
60 35         20813 my $saw_whitespace = $self->skip_whitespace($str_ref);
61              
62 35 100       125 return undef if !length $$str_ref;
63              
64 34 100       596 if ($$str_ref !~ $self->_rules_rx) {
65 1         5 my $text = substr $$str_ref, 0, 30;
66 1         326 confess("No matching rule; next text is: $text");
67             }
68              
69 33         420 my $type = our $REGMARK;
70 2     2   3185 my $captures = { %+ };
  2         952  
  2         212  
  33         235  
71 33         156 my $text = substr($$str_ref, 0, $+[0], '');
72              
73             return {
74 33         227 type => $type,
75             captures => $captures,
76             text => $text,
77             cuddled => 0+!$saw_whitespace,
78             };
79             }
80              
81             1;
82             __END__