Fix calling of shadowed subs
Graham Knop [Tue, 18 Jun 2013 10:28:08 +0000 (06:28 -0400)]
Need to split up the parsing a little more, and restore the shadowed
subs for failed matches.

Also, optimize some by only checking for active keyword.

lib/Filter/Keyword.pm
lib/Filter/Keyword/Parser.pm

index 7413655..5ed05a3 100644 (file)
@@ -98,11 +98,16 @@ sub _build_globref {
 after clear_globref => sub {
   my ($self) = @_;
   $self->stash->remove_symbol('&'.$self->keyword_name);
+  $self->globref_refcount(undef);
+  $self->restore_shadow;
+};
+
+sub restore_shadow {
+  my ($self) = @_;
   if (my $shadowed = $self->_shadowed_sub) {
     { no warnings 'redefine', 'prototype'; *{$self->globref} = $shadowed; }
   }
-  $self->globref_refcount(undef);
-};
+}
 
 has globref_refcount => (is => 'rw');
 
index ce22a3b..10cc3d1 100644 (file)
@@ -27,7 +27,8 @@ has short_circuit => (is => 'rw');
 
 has code => (is => 'rw', default => sub { '' });
 
-has active_keyword => (is => 'rw', clearer => 1);
+has current_keyword => (is => 'rw', clearer => 1);
+has keyword_matched => (is => 'rw');
 
 sub get_next {
   my ($self) = @_;
@@ -36,14 +37,15 @@ sub get_next {
     $self->${\$self->re_add};
     return ('', 0);
   }
-  if (my $keyword = $self->active_keyword) {
-    $self->clear_active_keyword;
-    $keyword->clear_globref;
-    return $keyword->parse($self);
-  }
-  for my $keyword (@{$self->keywords}) {
-    if ($keyword->have_match) {
-      $self->active_keyword($keyword);
+  if (my $keyword = $self->current_keyword) {
+    if ($self->keyword_matched) {
+      $keyword->clear_globref;
+      $self->clear_current_keyword;
+      $self->short_circuit(1);
+      return $keyword->parse($self);
+    }
+    elsif ($keyword->have_match) {
+      $self->keyword_matched(1);
       $self->short_circuit(1);
       my $match = $self->current_match;
       my $end = $match eq '{' ? '}'
@@ -51,6 +53,10 @@ sub get_next {
                               : '';
       return ("$end;", 1);
     }
+    else {
+      $keyword->restore_shadow;
+      $self->clear_current_keyword;
+    }
   }
   return $self->check_match;
 }
@@ -91,6 +97,8 @@ sub check_match {
     ) {
       $keyword->install_matcher($matches->[0]);
       $self->current_match($matches->[0]);
+      $self->current_keyword($keyword);
+      $self->keyword_matched(0);
       $self->short_circuit(1);
       return ($stripped, 1);
     }