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)) {
$self->keyword_parser($parser);
on_scope_end {
+ DEBUG_VERBOSE && print STDERR "#end of scope#";
$self->remove;
};
}
sub parse {
my $self = shift;
+ no strict 'refs';
+ DEBUG_VERBOSE && print STDERR "#parsing with " . \*{join'::',$self->target_package,$self->keyword_name} . "#";
$self->${\$self->parser}(@_);
}
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;
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; }
}
}
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;
}
my $inject = shift;
on_scope_end {
filter_add(sub {
+ DEBUG && print $inject;
$_ = $inject;
- filter_del();
+ filter_del;
1;
});
};
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);
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)
+ },
);
}
my ($self) = @_;
my ($string, $code) = $self->parser->get_next;
$_ = $string;
+ DEBUG && print $string;
return $code;
}
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);
}
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;