debug
Graham Knop [Tue, 18 Jun 2013 18:18:21 +0000 (14:18 -0400)]
lib/Filter/Keyword.pm
lib/Filter/Keyword/Filter.pm
lib/Filter/Keyword/Parser.pm

index eeac09b..30db54d 100644 (file)
@@ -9,6 +9,9 @@ use B qw(svref_2object);
 use B::Hooks::EndOfScope;
 use Scalar::Util qw(set_prototype);
 
+use constant DEBUG => $ENV{FILTER_KEYWORD_DEBUG};
+use constant DEBUG_VERBOSE => DEBUG && $ENV{FILTER_KEYWORD_DEBUG} > 1;
+
 sub _compiling_file () {
   my $depth = 0;
   while (my @caller = caller(++$depth)) {
@@ -35,6 +38,7 @@ sub install {
   $self->keyword_parser($parser);
 
   on_scope_end {
+    DEBUG_VERBOSE && print STDERR "#end of scope#";
     $self->remove;
   };
 }
@@ -78,6 +82,8 @@ has parser         => (is => 'ro', required => 1);
 
 sub parse {
   my $self = shift;
+  no strict 'refs';
+  DEBUG_VERBOSE && print STDERR "#parsing with " . \*{join'::',$self->target_package,$self->keyword_name} . "#";
   $self->${\$self->parser}(@_);
 }
 
@@ -97,6 +103,7 @@ sub _build_globref {
 
 after clear_globref => sub {
   my ($self) = @_;
+  DEBUG_VERBOSE && print STDERR "#removing#";
   $self->stash->remove_symbol('&'.$self->keyword_name);
   $self->globref_refcount(undef);
   $self->restore_shadow;
@@ -105,6 +112,8 @@ after clear_globref => sub {
 sub restore_shadow {
   my ($self) = @_;
   if (my $shadowed = $self->_shadowed_sub) {
+    no strict 'refs';
+    DEBUG_VERBOSE && print STDERR "#adding shadow to " . \*{join'::',$self->target_package,$self->keyword_name} . "#";
     { no warnings 'redefine', 'prototype'; *{$self->globref} = $shadowed; }
   }
 }
@@ -118,9 +127,12 @@ sub save_refcount {
 
 sub install_matcher {
   my ($self, $post) = @_;
-  my $stash = $self->stash;
-  my $sub = sub {};
+  my $sub = sub {
+    DEBUG_VERBOSE && print STDERR "#fake#";
+  };
   set_prototype(\&$sub, '*;@') unless $post eq '(';
+    no strict 'refs';
+  DEBUG_VERBOSE && print STDERR "#adding fake to " . \*{join'::',$self->target_package,$self->keyword_name} . "#";
   { no warnings 'redefine', 'prototype'; *{$self->globref} = $sub; }
   $self->save_refcount;
 }
@@ -135,8 +147,9 @@ sub inject_after_scope {
   my $inject = shift;
   on_scope_end {
     filter_add(sub {
+      DEBUG && print $inject;
       $_ = $inject;
-      filter_del();
+      filter_del;
       1;
     });
   };
index bb2cab5..b79160f 100644 (file)
@@ -6,6 +6,9 @@ use Filter::Util::Call;
 use Scalar::Util qw(weaken);
 use B::Hooks::EndOfScope;
 
+use constant DEBUG => $ENV{FILTER_KEYWORD_DEBUG};
+use constant DEBUG_VERBOSE => DEBUG && $ENV{FILTER_KEYWORD_DEBUG} > 1;
+
 has parser => (is => 'lazy');
 has active => (is => 'rwp', default => 0);
 
@@ -14,7 +17,11 @@ sub _build_parser {
   weaken $self;
   Filter::Keyword::Parser->new(
     reader => sub { $_ = ''; my $r = filter_read; ($_, $r) },
-    re_add => sub { filter_add($self) },
+    re_add => sub {
+      DEBUG_VERBOSE && print STDERR "#re-add#";
+      filter_del;
+      filter_add($self)
+    },
   );
 }
 
@@ -34,6 +41,7 @@ sub filter {
   my ($self) = @_;
   my ($string, $code) = $self->parser->get_next;
   $_ = $string;
+  DEBUG && print $string;
   return $code;
 }
 
index 86ab9a3..9abe38e 100644 (file)
@@ -1,6 +1,9 @@
 package Filter::Keyword::Parser;
 use Moo;
 
+use constant DEBUG => $ENV{FILTER_KEYWORD_DEBUG};
+use constant DEBUG_VERBOSE => DEBUG && $ENV{FILTER_KEYWORD_DEBUG} > 1;
+
 has reader => (is => 'ro', required => 1);
 
 has re_add => (is => 'ro', required => 1);
@@ -40,17 +43,20 @@ sub get_next {
   }
   if (my $keyword = $self->current_keyword) {
     if ($self->keyword_parsed) {
+      DEBUG_VERBOSE && print STDERR "#after parse#";
       $keyword->clear_globref;
       $self->clear_current_keyword;
       $self->keyword_parsed(0);
     }
     elsif ($self->keyword_matched) {
+      DEBUG_VERBOSE && print STDERR "#after match#";
       $keyword->clear_globref;
       $self->short_circuit(1);
       $self->keyword_parsed(1);
       return $keyword->parse($self);
     }
     elsif ($keyword->have_match) {
+      DEBUG_VERBOSE && print STDERR "#just matched#";
       $self->keyword_matched(1);
       $self->short_circuit(1);
       my $match = $self->current_match;