lib/Filter/Keyword/Parser.pm

   1 package Filter::Keyword::Parser;
   2 use Moo;
   3
   4 has reader => (is => 'ro', required => 1);
   5
   6 has re_add => (is => 'ro', required => 1);
   7
   8 has keywords => (is => 'ro', default => sub { [] });
   9
  10 sub add_keyword {
  11   push @{$_[0]->keywords}, $_[1];
  12 }
  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   }
  22 }
  23
  24 has current_match => (is => 'rw');
  25
  26 has short_circuit => (is => 'rw');
  27
  28 has code => (is => 'rw', default => sub { '' });
  29
  30 sub get_next {
  31   my ($self) = @_;
  32   if ($self->short_circuit) {
  33     $self->short_circuit(0);
  34     $self->${\$self->re_add};
  35     return ('', 0);
  36   }
  37   for my $keyword (@{$self->keywords}) {
  38     if ($keyword->have_match) {
  39       $keyword->clear_globref;
  40       return $keyword->parser->($keyword, $self);
  41     }
  42   }
  43   return $self->check_match;
  44 }
  45
  46 sub fetch_more {
  47   my ($self) = @_;
  48   my $code = $self->code||'';
  49   my ($extra_code, $not_eof) = $self->reader->();
  50   $code .= $extra_code;
  51   $self->code($code);
  52   return $not_eof;
  53 }
  54
  55 sub match_source {
  56   my ($self, $first, $second) = @_;
  57   $self->fetch_more while $self->code =~ /\A$first\s+\z/;
  58   if (my @match = ($self->code =~ /(.*?${first}\s+${second})(.*\n?)\z/)) {
  59     my $code = pop @match;
  60     $self->code($code);
  61     my $found = shift(@match);
  62     return ($found, \@match);
  63   }
  64   return;
  65 }
  66
  67 sub check_match {
  68   my ($self) = @_;
  69   unless ($self->code) {
  70     $self->fetch_more
  71       or return ('', 0);
  72   }
  73   for my $keyword (@{ $self->keywords }) {
  74     if (
  75       my ($stripped, $matches)
  76         = $self->match_source(
  77             $keyword->keyword_name, qr/(\(|[A-Za-z][A-Za-z_0-9]*|{)/
  78           )
  79     ) {
  80       $keyword->install_matcher($matches->[0]);
  81       $self->current_match($matches);
  82       $self->short_circuit(1);
  83       return ($stripped, 1);
  84     }
  85   }
  86   my $code = $self->code;
  87   $self->code('');
  88   return ($code, 1);
  89 }
  90
  91 1;