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   76697 use v5.12;
  2         8  
4 2     2   568 use Moo;
  2         10812  
  2         12  
5              
6             our $VERSION = '0.04';
7              
8 2     2   1855 use Carp qw(confess);
  2         4  
  2         99  
9 2     2   12 use List::Util qw(pairmap);
  2         4  
  2         149  
10 2     2   456 use Text::TokenStream::Types qw(Identifier LexerRule);
  2         14  
  2         22  
11 2     2   1149 use Types::Standard qw(ArrayRef CycleTuple ScalarRef Str);
  2         3  
  2         13  
12              
13 2     2   2709 use namespace::clean;
  2         9813  
  2         16  
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   105 my ($self) = @_;
29 3 50       8 my @whitespace = map ref() ? $_ : quotemeta, @{ $self->whitespace }
  3 100       55  
30             or return qr/(*FAIL)/;
31 2         7 local $" = '|';
32 2         152 return qr/^(?:@whitespace)/;
33             });
34              
35             has _rules_rx => (is => 'lazy', init_arg => undef, builder => sub {
36 3     3   35 my ($self) = @_;
37 19     19   492 my @annotated_rules = pairmap { qr/$b(*MARK:$a)/ }
38 19 100   19   61 pairmap { $a => (ref $b ? $b : quotemeta $b) }
39 3 100       26 @{ $self->rules }
  3         58  
40             or return qr/(*FAIL)/;
41 2         51 local $" = '|';
42 2         519 qr/^(?|@annotated_rules)/;
43             });
44              
45             sub skip_whitespace {
46 35     35 1 1386 my ($self, $str_ref) = @_;
47 35         104 (ScalarRef[Str])->assert_valid($str_ref);
48              
49 35         16679 my $ret = 0;
50 35         2076 my $whitespace_rx = $self->_whitespace_rx;
51 35         474 $ret = 1 while $$str_ref =~ s/$whitespace_rx//;
52              
53 35         81 return $ret;
54             }
55              
56             sub next_token {
57 35     35 1 2359 my ($self, $str_ref) = @_;
58 35         108 (ScalarRef[Str])->assert_valid($str_ref);
59              
60 35         19661 my $saw_whitespace = $self->skip_whitespace($str_ref);
61              
62 35 100       125 return undef if !length $$str_ref;
63              
64 34 100       601 if ($$str_ref !~ $self->_rules_rx) {
65 1         5 my $text = substr $$str_ref, 0, 30;
66 1         301 confess("No matching rule; next text is: $text");
67             }
68              
69 33         416 my $type = our $REGMARK;
70 2     2   2706 my $captures = { %+ };
  2         824  
  2         202  
  33         219  
71 33         147 my $text = substr($$str_ref, 0, $+[0], '');
72              
73             return {
74 33         225 type => $type,
75             captures => $captures,
76             text => $text,
77             cuddled => 0+!$saw_whitespace,
78             };
79             }
80              
81             1;
82             __END__