view release on metacpan or  search on metacpan

lib/B/Hooks/AtRuntime.pm  view on Meta::CPAN

        compiling_string_eval() and croak 
            "Can't stuff into a string eval";

        if (defined(my $extra = remaining_text())) {
            $extra =~ s/\n+\z//;
            carp "Extra text '$extra' after call to lex_stuff";
        }

        Filter::Util::Call::filter_add(sub {
            $_ = $str;
            Filter::Util::Call::filter_del();
            return 1;
        });
    };
}

# In order to avoid needing to stuff text into perl's lexer too often,
# the code stuffed looks like this
#
#   B::Hooks::AtRuntime::run(@B::Hooks::Runtime::hooks);
#   BEGIN { B::Hooks::Runtime::clear(1) }
#
# The way this works is as follows.
#
# - The @hooks global refers to a different array every time it is used.
#   The sub replace_hooks is responsible for making sure that the global
#   points to the correct array at the time the stuffed code is
#   compiled.
#
# - The lexical array @Hooks below contains one entry for each time we
#   have recursively entered compile time. So, for example, if the user
#   writes
#
#       BEGIN {
#           BEGIN {
#               at_runtime { ... };
#           }
#       }
#
#   then the at_runtime sub is pushed onto @Hooks[2], because we are in
#   our second recursive BEGIN. (@Hooks[0] is never used.)
#
# - The XS sub count_BEGINs is responsible for finding which level of
#   @Hooks to push onto. It does this by looking for BEGIN blocks,
#   because even use compiles out as a BEGIN block.
#
# - The call to clear() ensures that if we leave and re-enter compile
#   time at this level we get a new array of hooks and a new code-stuff
#   to call them. The number passed (interpolated into the compiled
#   code) is the level of @Hooks to clear.

my @Hooks;

sub replace_hooks {
    my ($new) = @_;

    # By deleting the stash entry we ensure the only ref to the glob is
    # through the optree it was compiled into. This means that if that
    # optree is ever freed, the glob will disappear along with anything
    # closed over by the user's callbacks.
    delete $B::Hooks::AtRuntime::{hooks};

    no strict "refs";
    $new and *{"hooks"} = $new;
}

sub clear {
    my ($depth) = @_;
    $Hooks[$depth] = undef;
    replace_hooks $Hooks[$depth - 1];
}

sub find_hooks {
    USE_FILTER and compiling_string_eval() and croak
        "Can't use at_runtime from a string eval";

    my $depth = count_BEGINs()
        or croak "You must call at_runtime at compile time";

    my $hk;
    unless ($hk = $Hooks[$depth]) {
        # Close over an array of callbacks so we don't need to keep
        # stuffing text into the buffer.
        my @hooks;
        $hk = $Hooks[$depth] = \@hooks;
        replace_hooks $hk;

        # This must be all on one line, so we don't mess up perl's idea
        # of the current line number.
        lex_stuff(q{B::Hooks::AtRuntime::run(@B::Hooks::AtRuntime::hooks);} .
            "BEGIN{B::Hooks::AtRuntime::clear($depth)}");
    }

    return $hk;
}

sub at_runtime (&) {
    my ($cv) = @_;
    my $hk = find_hooks;
    push @$hk, subname scalar(caller) . "::(at_runtime)", $cv;
}

# The XS sub run() knows that a ref to a ref is an after_runtime sub.
sub after_runtime (&) {
    my ($cv) = @_;
    my $hk = find_hooks;
    push @$hk, \subname scalar(caller) . "::(after_runtime)", $cv;
}

1;

=head1 NAME

B::Hooks::AtRuntime - Lower blocks from compile time to runtime

=head1 SYNOPSIS

    # My::Module
    sub import {
        at_runtime { warn "TWO" };
    }

    # elsewhere
    warn "ONE";
    use My::Module;
    warn "THREE";

=head1 DESCRIPTION

This module allows code that runs at compile-time to do something at
runtime. A block passed to C<at_runtime> gets compiled into the code
that's currently compiling, and will be called when control reaches that
point at runtime. In the example in the SYNOPSIS, the warnings will
occur in order, and if that section of code runs more than once, so will
all three warnings.

=head2 at_runtime

    at_runtime { ... };

This sets up a block to be called at runtime. It must be called from
within a C<BEGIN> block or C<use>, otherwise there will be no compiling