Commit | Line | Data |
c46d1069 |
1 | package Filter::Keyword::Parser; |
c46d1069 |
2 | use Moo; |
3 | |
c46d1069 |
4 | has reader => (is => 'ro', required => 1); |
5 | |
6 | has re_add => (is => 'ro', required => 1); |
7 | |
c15f7959 |
8 | has keywords => (is => 'ro', default => sub { [] }); |
c46d1069 |
9 | |
c15f7959 |
10 | sub add_keyword { |
11 | push @{$_[0]->keywords}, $_[1]; |
c46d1069 |
12 | } |
c15f7959 |
13 | sub remove_keyword { |
14 | my ($self, $keyword) = @_; |
15 | my $keywords = $self->keywords; |
16 | for my $idx (0 .. $#$keywords) { |
17 | if ($keywords->[$idx] eq $keyword) { |
18 | splice @$keywords, $idx, 1; |
19 | last; |
20 | } |
21 | } |
c46d1069 |
22 | } |
23 | |
24 | has current_match => (is => 'rw'); |
25 | |
26 | has short_circuit => (is => 'rw'); |
27 | |
28 | has code => (is => 'rw', default => sub { '' }); |
29 | |
b40e1ccd |
30 | has active_keyword => (is => 'rw', clearer => 1); |
31 | |
c46d1069 |
32 | sub get_next { |
33 | my ($self) = @_; |
34 | if ($self->short_circuit) { |
35 | $self->short_circuit(0); |
36 | $self->${\$self->re_add}; |
37 | return ('', 0); |
38 | } |
b40e1ccd |
39 | if (my $keyword = $self->active_keyword) { |
40 | $self->clear_active_keyword; |
41 | $keyword->clear_globref; |
42 | return $keyword->parse($self); |
43 | } |
c15f7959 |
44 | for my $keyword (@{$self->keywords}) { |
45 | if ($keyword->have_match) { |
b40e1ccd |
46 | $self->active_keyword($keyword); |
47 | $self->short_circuit(1); |
48 | my $match = $self->current_match->[0]; |
49 | my $end = $match eq '{' ? '}' |
50 | : $match eq '(' ? ')' |
51 | : ''; |
52 | return ("$end;", 1); |
c15f7959 |
53 | } |
c46d1069 |
54 | } |
55 | return $self->check_match; |
56 | } |
57 | |
58 | sub fetch_more { |
59 | my ($self) = @_; |
60 | my $code = $self->code||''; |
c15f7959 |
61 | my ($extra_code, $not_eof) = $self->reader->(); |
c46d1069 |
62 | $code .= $extra_code; |
63 | $self->code($code); |
64 | return $not_eof; |
65 | } |
66 | |
67 | sub match_source { |
68 | my ($self, $first, $second) = @_; |
87f45e42 |
69 | $self->fetch_more while $self->code =~ /\A$first\s+\z/; |
70 | if (my @match = ($self->code =~ /(.*?${first}\s+${second})(.*\n?)\z/)) { |
71 | my $code = pop @match; |
72 | $self->code($code); |
c46d1069 |
73 | my $found = shift(@match); |
74 | return ($found, \@match); |
75 | } |
76 | return; |
77 | } |
78 | |
79 | sub check_match { |
80 | my ($self) = @_; |
81 | unless ($self->code) { |
82 | $self->fetch_more |
83 | or return ('', 0); |
84 | } |
c15f7959 |
85 | for my $keyword (@{ $self->keywords }) { |
86 | if ( |
87 | my ($stripped, $matches) |
88 | = $self->match_source( |
89 | $keyword->keyword_name, qr/(\(|[A-Za-z][A-Za-z_0-9]*|{)/ |
90 | ) |
91 | ) { |
68363889 |
92 | $keyword->install_matcher($matches->[0]); |
c15f7959 |
93 | $self->current_match($matches); |
94 | $self->short_circuit(1); |
95 | return ($stripped, 1); |
96 | } |
c46d1069 |
97 | } |
98 | my $code = $self->code; |
99 | $self->code(''); |
100 | return ($code, 1); |
101 | } |
102 | |
103 | 1; |