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 active_keyword => (is => 'rw', clearer => 1);
  31
  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   }
  39   if (my $keyword = $self->active_keyword) {
  40     $self->clear_active_keyword;
  41     $keyword->clear_globref;
  42     return $keyword->parse($self);
  43   }
  44   for my $keyword (@{$self->keywords}) {
  45     if ($keyword->have_match) {
  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);
  53     }
  54   }
  55   return $self->check_match;
  56 }
  57
  58 sub fetch_more {
  59   my ($self) = @_;
  60   my $code = $self->code||'';
  61   my ($extra_code, $not_eof) = $self->reader->();
  62   $code .= $extra_code;
  63   $self->code($code);
  64   return $not_eof;
  65 }
  66
  67 sub match_source {
  68   my ($self, $first, $second) = @_;
  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);
  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   }
  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     ) {
  92       $keyword->install_matcher($matches->[0]);
  93       $self->current_match($matches);
  94       $self->short_circuit(1);
  95       return ($stripped, 1);
  96     }
  97   }
  98   my $code = $self->code;
  99   $self->code('');
 100   return ($code, 1);
 101 }
 102
 103 1;