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 has current_keyword => (is => 'rw', clearer => 1);
  31 has keyword_matched => (is => 'rw');
  32 has keyword_parsed => (is => 'rw');
  33
  34 sub get_next {
  35   my ($self) = @_;
  36   if ($self->short_circuit) {
  37     $self->short_circuit(0);
  38     $self->${\$self->re_add};
  39     return ('', 0);
  40   }
  41   if (my $keyword = $self->current_keyword) {
  42     if ($self->keyword_parsed) {
  43       $keyword->clear_globref;
  44       $self->clear_current_keyword;
  45       $self->keyword_parsed(0);
  46     }
  47     elsif ($self->keyword_matched) {
  48       $keyword->clear_globref;
  49       $self->short_circuit(1);
  50       $self->keyword_parsed(1);
  51       return $keyword->parse($self);
  52     }
  53     elsif ($keyword->have_match) {
  54       $self->keyword_matched(1);
  55       $self->short_circuit(1);
  56       my $match = $self->current_match;
  57       my $end = $match eq '{' ? '}'
  58               : $match eq '(' ? ')'
  59                               : '';
  60       return ("$end;", 1);
  61     }
  62     else {
  63       $keyword->restore_shadow;
  64       $self->clear_current_keyword;
  65     }
  66   }
  67   return $self->check_match;
  68 }
  69
  70 sub fetch_more {
  71   my ($self) = @_;
  72   my $code = $self->code||'';
  73   my ($extra_code, $not_eof) = $self->reader->();
  74   $code .= $extra_code;
  75   $self->code($code);
  76   return $not_eof;
  77 }
  78
  79 sub match_source {
  80   my ($self, $first, $second) = @_;
  81   $self->fetch_more while $self->code =~ /\A$first\s+\z/;
  82   if (my @match = ($self->code =~ /(.*?${first}\s+${second})(.*\n?)\z/)) {
  83     my $code = pop @match;
  84     $self->code($code);
  85     my $found = shift(@match);
  86     return ($found, \@match);
  87   }
  88   return;
  89 }
  90
  91 sub check_match {
  92   my ($self) = @_;
  93   unless ($self->code) {
  94     $self->fetch_more
  95       or return ('', 0);
  96   }
  97   for my $keyword (@{ $self->keywords }) {
  98     if (
  99       my ($stripped, $matches)
 100         = $self->match_source(
 101             $keyword->keyword_name, qr/(\(|[A-Za-z][A-Za-z_0-9]*|{)/
 102           )
 103     ) {
 104       $keyword->install_matcher($matches->[0]);
 105       $self->current_match($matches->[0]);
 106       $self->current_keyword($keyword);
 107       $self->keyword_matched(0);
 108       $self->short_circuit(1);
 109       return ($stripped, 1);
 110     }
 111   }
 112   my $code = $self->code;
 113   $self->code('');
 114   return ($code, 1);
 115 }
 116
 117 1;