Devel-Hook
view release on metacpan or search on metacpan
0.005 Fri Mar 3 2008
- fixed silly mistake in regex at t/10error.t
- corrected the docs about the direct relationship
of order in the array of blocks versus the
execution order
- added a test to verify the straighforward
relation between array order and execution
order of blocks
- I discovered that in XS code testing for
PL_unitcheckav (with #ifdef) did not work as
intented - now trying with KEY_UNITCHECK
- added an exploratory test for Perl semantics
of special code blocks
0.004 Sun Mar 2 2008
- support manipulating array of UNITCHECK blocks
(for Perls that have it)
- new test for bad block arguments
- no actual need for ppport.h (considering API
for 5.006+ Perls)
0.003 Sat Mar 1 2008
- enable prototypes in Hook.xs
- it is useless to try to support 5.005
(big API changed introduced by 5.006 seems
to have changed a lot of things)
AV *_get_end_array();
AV *_get_begin_array() {
if ( !PL_beginav ) {
PL_beginav = newAV();
}
return PL_beginav;
}
AV *_get_unitcheck_array() {
#ifdef KEY_UNITCHECK
if ( !PL_unitcheckav ) {
PL_unitcheckav = newAV();
}
return PL_unitcheckav;
#else
croak( "UNITCHECK not implemented in this release of perl" );
#endif
}
AV *_get_check_array() {
if ( !PL_checkav ) {
PL_checkav = newAV();
}
return PL_checkav;
}
AV *_get_end_array() {
if ( !PL_endav ) {
PL_endav = newAV();
}
return PL_endav;
}
HV *_get_supported_types() {
HV *hv = newHV();
hv_store( hv, "BEGIN", 5, &PL_sv_yes, 0 );
#ifdef KEY_UNITCHECK
hv_store( hv, "UNITCHECK", 9, &PL_sv_yes, 0 );
#else
hv_store( hv, "UNITCHECK", 9, &PL_sv_no, 0 );
#endif
hv_store( hv, "CHECK", 5, &PL_sv_yes, 0 );
hv_store( hv, "INIT", 4, &PL_sv_yes, 0 );
hv_store( hv, "END", 3, &PL_sv_yes, 0 );
return hv;
}
MODULE = Devel::Hook PACKAGE = Devel::Hook
PROTOTYPES: ENABLE
Output will be:
INIT #1 (hook)
INIT #2
INIT #3 (hook)
RUNTIME
DESCRIPTION
Perl keeps arrays of subroutines that are executed at the beginning and
at the end of a running Perl program and its program units. These
subroutines correspond to the special code blocks: `BEGIN', `UNITCHECK',
`CHECK', `INIT' and `END'. (See details at perlmod.) This module
provides limited capabilities to manipulate these arrays.
Such arrays belong to Perl's internals that you're not supposed to see.
Entries in these arrays get consumed by the interpreter as it enters
distinct compilation phases, triggered by statements like `require',
`use', `do', `eval', etc. To play as safest as possible, the only
allowed operations are to add entries to the start and to the end of
these arrays.
# add code hooks to the start of <BLOCK> array
Devel::Hook->unshift_<BLOCK>_hook( @blocks );
# add code hooks to the end of <BLOCK> array
Devel::Hook->push_<BLOCK>_hook( @blocks );
where <BLOCK> is one of: `BEGIN', `UNITCHECK', `CHECK', `INIT' or `END'.
The hooks execute first if they are at the start of the array and last
if they are at the end. Notice that the FIFO or LIFO nature of blocks
according to their textual order of appearance at Perl source does not
matter here. For example, BEGIN and INIT are FIFO (first-in, first-out)
blocks while CHECK, UNITCHECK and END are LIFO (last-in, first-out). But
the Perl interpreter and the user of this module inserts blocks at the
start of arrays if they should execute earlier and at the end if they
are to be executed later, with a homogeneous treatment with respect to
the block arrays.
If you are curious about the content of these arrays, read more at
Manip::END and proceed to the innards of Perl.
WHAT IS IT GOOD FOR
If you want to inject code into Perl compilation phases or at the end of
the program, this module may be useful.
If it can be done with literal `BEGIN/UNITCHECK/CHECK/INIT/END' blocks,
it should be. For weirder things, maybe `Devel::Hook' can solve it.
As an example of application, Devel::Sub::Trace uses this module to
insert a `INIT' hook which will run just before any other runtime code
in the caller's package, wrapping subs after they were
compiled/generated but before they get called by runtime code.
HOW TO USE IT
(not yet finished)
* unshift_BEGIN_hook
* push_BEGIN_hook
Devel::Hook->unshift_BEGIN_hook( @blocks );
Devel::Hook->push_BEGIN_hook( @blocks );
This will add the blocks to the start (`unshift_BEGIN_hook') and to
the end (`push_BEGIN_hook') of the array of BEGIN hooks.
`@blocks' is an array of subroutine references.
* unshift_UNITCHECK_hook
* push_UNITCHECK_hook
Devel::Hook->unshift_UNITCHECK_hook( @blocks );
Devel::Hook->push_UNITCHECK_hook( @blocks );
This will add the blocks to the start (`unshift_UNITCHECK_hook') and
to the end (`push_UNITCHECK_hook') of the array of UNITCHECK hooks.
`@blocks' is an array of subroutine references.
The first stable release with `UNITCHECK' was 5.10.0. For earlier
releases, these methods die.
* unshift_CHECK_hook
* push_CHECK_hook
Devel::Hook->unshift_CHECK_hook( @blocks );
Devel::Hook->push_CHECK_hook( @blocks );
This will add the blocks to the start (`unshift_CHECK_hook') and to
the end (`push_CHECK_hook') of the array of CHECK hooks.
Please report bugs via CPAN RT
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Devel-Hook or mailto:
TODO
* finish docs
* finish tests
* this module will be soon renamed into `Devel::Hooks::BLOCK'
* test support for UNITCHECK blocks (needs Perl 5.10.0+)
ACKNOWLEDGEMENTS
Everything I needed to learn about XS to write this module was borrowed
from Manip::END written by Fergal Daly. To be really honest, the code
was all there and I pruned it to a safer/limited/smaller API and
included the manipulation to other hooks besides END blocks. And I also
plagiarized his documentation.
AUTHOR
Fergal Daly (for the code in Manip::END)
lib/Devel/Hook.pm view on Meta::CPAN
unshift @{ _get_begin_array() }, @_;
}
sub push_BEGIN_hook {
shift;
_check( 'BEGIN', @_ );
push @{ _get_begin_array() }, @_;
}
sub unshift_UNITCHECK_hook {
shift;
_check( 'UNITCHECK', @_ );
unshift @{ _get_unitcheck_array() }, @_;
}
sub push_UNITCHECK_hook {
shift;
_check( 'UNITCHECK', @_ );
push @{ _get_unitcheck_array() }, @_;
}
sub unshift_CHECK_hook {
shift;
_check( 'CHECK', @_ );
unshift @{ _get_check_array() }, @_;
}
lib/Devel/Hook.pod view on Meta::CPAN
INIT #1 (hook)
INIT #2
INIT #3 (hook)
RUNTIME
=head1 DESCRIPTION
Perl keeps arrays of subroutines that are executed
at the beginning and at the end of a running Perl program
and its program units. These subroutines correspond
to the special code blocks: C<BEGIN>, C<UNITCHECK>,
C<CHECK>, C<INIT> and C<END>.
(See details at L<perlmod/"BEGIN, UNITCHECK, CHECK, INIT and END">.)
This module provides
limited capabilities to manipulate these arrays.
Such arrays belong to Perl's internals that you're
not supposed to see. Entries in these arrays get
consumed by the interpreter as it enters distinct
compilation phases, triggered by statements like
C<require>, C<use>, C<do>, C<eval>, etc.
To play as safest as possible, the only allowed
operations are to add entries to the start and to
the end of these arrays.
# add code hooks to the start of <BLOCK> array
Devel::Hook->unshift_<BLOCK>_hook( @blocks );
# add code hooks to the end of <BLOCK> array
Devel::Hook->push_<BLOCK>_hook( @blocks );
where E<lt>BLOCKE<gt> is one of: C<BEGIN>,
C<UNITCHECK>, C<CHECK>, C<INIT> or C<END>.
The hooks execute first if they are at the start
of the array and last if they are at the end.
Notice that the FIFO or LIFO nature of blocks
according to their textual order of appearance
at Perl source does not matter here.
For example, BEGIN and INIT are
FIFO (first-in, first-out) blocks while
CHECK, UNITCHECK and END are LIFO (last-in, first-out).
But the Perl interpreter and the user of this
module inserts blocks at the start of arrays
if they should execute earlier and at the end
if they are to be executed later,
with a homogeneous treatment with respect to
the block arrays.
If you are curious about the content of these arrays,
read more at L<Manip::END/WARNING> and proceed
to L<the innards of Perl|perlhack>.
=head2 WHAT IS IT GOOD FOR
If you want to inject code into Perl compilation phases or
at the end of the program, this module may be useful.
If it can be done with literal C<BEGIN/UNITCHECK/CHECK/INIT/END>
blocks, it should be. For weirder things, maybe
C<Devel::Hook> can solve it.
As an example of application, L<Devel::Sub::Trace> uses this module
to insert a C<INIT> hook which will run just before any
other runtime code in the caller's package, wrapping
subs after they were compiled/generated but before
they get called by runtime code.
=head2 HOW TO USE IT
lib/Devel/Hook.pod view on Meta::CPAN
Devel::Hook->unshift_BEGIN_hook( @blocks );
Devel::Hook->push_BEGIN_hook( @blocks );
This will add the blocks to the start (C<unshift_BEGIN_hook>)
and to the end (C<push_BEGIN_hook>) of the array of BEGIN
hooks.
C<@blocks> is an array of subroutine references.
=item * B< unshift_UNITCHECK_hook >
=item * B< push_UNITCHECK_hook >
Devel::Hook->unshift_UNITCHECK_hook( @blocks );
Devel::Hook->push_UNITCHECK_hook( @blocks );
This will add the blocks to the start (C<unshift_UNITCHECK_hook>)
and to the end (C<push_UNITCHECK_hook>) of the array of UNITCHECK
hooks.
C<@blocks> is an array of subroutine references.
The first stable release with C<UNITCHECK> was 5.10.0.
For earlier releases, these methods die.
=item * B< unshift_CHECK_hook >
=item * B< push_CHECK_hook >
Devel::Hook->unshift_CHECK_hook( @blocks );
Devel::Hook->push_CHECK_hook( @blocks );
lib/Devel/Hook.pod view on Meta::CPAN
the last code blocks executed by Perl when it is exiting.
C<@blocks> is an array of subroutine references.
=back
=head1 SEE ALSO
L<perlmod/"BEGIN, UNITCHECK, CHECK, INIT and END">
L<Manip::END>
L<B::CompilerPhase::Hook>
=head1 BUGS
Please report bugs via CPAN RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Devel-Hook>
or L<mailto://bugs-Devel-Hook@rt.cpan.org>
lib/Devel/Hook.pod view on Meta::CPAN
=item *
finish tests
=item *
B<this module will be soon renamed into C<Devel::Hooks::BLOCK>>
=item *
test support for UNITCHECK blocks (needs Perl 5.10.0+)
=back
=head1 ACKNOWLEDGEMENTS
Everything I needed to learn about XS to write this
module was borrowed from L<Manip::END> written by Fergal Daly.
To be really honest, the code was all there
and I pruned it to a safer/limited/smaller API and included
t/00blocks.t view on Meta::CPAN
$block = 'BEGIN #3';
}
BEGIN {
is( $block, 'BEGIN #3', 'at BEGIN #4 (hook)' );
$block = 'BEGIN #4';
}
BEGIN {
SKIP : {
unless ( Devel::Hook->_has_support_for( 'UNITCHECK' ) ) {
$block = 'UNITCHECK #4';
skip "UNITCHECK not supported", 4;
}
# happily, UNITCHECK blocks work inside eval
# UNITCHECK blocks execute in LIFO order
eval q[
UNITCHECK {
is( $block, 'UNITCHECK #3', 'at UNITCHECK #4 (hook)' );
$block = 'UNITCHECK #4';
}
UNITCHECK {
is( $block, 'UNITCHECK #2', 'at UNITCHECK #3 (hook)' );
$block = 'UNITCHECK #3';
}
UNITCHECK {
is( $block, 'UNITCHECK #1', 'at UNITCHECK #2 (hook)' );
$block = 'UNITCHECK #2';
}
UNITCHECK {
is( $block, 'BEGIN #4', 'at UNITCHECK #1 (hook)' );
$block = 'UNITCHECK #1';
}
];
}
}
# CHECK blocks executes in LIFO order
CHECK {
is( $block, 'CHECK #3', 'at CHECK #4 (hook)' );
t/00blocks.t view on Meta::CPAN
}
CHECK {
is( $block, 'CHECK #2', 'at CHECK #3 (hook)' );
$block = 'CHECK #3';
}
CHECK {
is( $block, 'CHECK #1', 'at CHECK #2 (hook)' );
$block = 'CHECK #2';
}
CHECK {
is( $block, 'UNITCHECK #4', 'at CHECK #1 (hook)' );
$block = 'CHECK #1';
}
# INIT blocks executes in FIFO order
INIT {
is( $block, 'CHECK #4', 'at INIT #1 (hook)' );
$block = 'INIT #1';
}
INIT {
t/00blocks.t view on Meta::CPAN
}
INIT {
is( $block, 'INIT #2', 'at INIT #3 (hook)' );
$block = 'INIT #3';
}
INIT {
is( $block, 'INIT #3', 'at INIT #4 (hook)' );
$block = 'INIT #4';
}
is( $block, 'INIT #4', 'after BEGIN, UNITCHECK, CHECK, and INIT hooks, before END hooks' );
$block = 'RUNTIME';
# END blocks executes in LIFO order
END {
is( $block, 'END #3', 'at END #4 (hook)' );
$block = 'END #4';
}
END {
is( $block, 'END #2', 'at END #3 (hook)' );
$block = 'END #3';
t/09order.t view on Meta::CPAN
sub {
is( $block, 'BEGIN #2', 'at BEGIN #3 (hook)' );
$block = 'BEGIN #3';
},
sub {
is( $block, 'BEGIN #3', 'at BEGIN #4 (hook)' );
$block = 'BEGIN #4';
},
);
if ( Devel::Hook->_has_support_for( 'UNITCHECK' ) ) {
Devel::Hook->unshift_UNITCHECK_hook(
sub {
is( $block, 'BEGIN #4', 'at UNITCHECK #1 (hook)' );
$block = 'UNITCHECK #1';
},
sub {
is( $block, 'UNITCHECK #1', 'at UNITCHECK #2 (hook)' );
$block = 'UNITCHECK #2';
},
sub {
is( $block, 'UNITCHECK #2', 'at UNITCHECK #3 (hook)' );
$block = 'UNITCHECK #3';
},
sub {
is( $block, 'UNITCHECK #3', 'at UNITCHECK #4 (hook)' );
$block = 'UNITCHECK #4';
},
);
} else {
Devel::Hook->push_BEGIN_hook(
sub {
SKIP: {
$block = 'UNITCHECK #4';
skip "UNITCHECK not supported", 4;
} }
);
}
Devel::Hook->unshift_CHECK_hook(
sub {
is( $block, 'UNITCHECK #4', 'at CHECK #1 (hook)' );
$block = 'CHECK #1';
},
sub {
is( $block, 'CHECK #1', 'at CHECK #2 (hook)' );
$block = 'CHECK #2';
},
sub {
is( $block, 'CHECK #2', 'at CHECK #3 (hook)' );
$block = 'CHECK #3';
},
t/09order.t view on Meta::CPAN
},
sub {
is( $block, 'END #3', 'at END #4 (hook)' );
$block = 'END #4';
},
);
}
is( $block, 'INIT #4', 'after BEGIN, UNITCHECK, CHECK, and INIT hooks, before END hooks' );
$block = 'RUNTIME';
t/10error.t view on Meta::CPAN
use Devel::Hook ();
eval { Devel::Hook->push_BEGIN_hook( 1 ) };
like( $@, qr/\ABEGIN blocks must be CODE references/, 'bad BEGIN blocks cause errors' );
eval { Devel::Hook->unshift_BEGIN_hook( undef ) };
like( $@, qr/\ABEGIN blocks must be CODE references/, 'bad BEGIN blocks cause errors' );
SKIP: {
skip 'UNITCHECK not supported', 2 unless Devel::Hook->_has_support_for( 'UNITCHECK' );
eval { Devel::Hook->push_UNITCHECK_hook( 1 ) };
like( $@, qr/\AUNITCHECK blocks must be CODE references/, 'bad UNITCHECK blocks cause errors' );
eval { Devel::Hook->unshift_UNITCHECK_hook( sub {}, \*STDOUT ) };
like( $@, qr/\AUNITCHECK blocks must be CODE references/, 'bad UNITCHECK blocks cause errors' );
}
eval { Devel::Hook->push_CHECK_hook( "" ) };
like( $@, qr/\ACHECK blocks must be CODE references/, 'bad CHECK blocks cause errors' );
eval { Devel::Hook->unshift_CHECK_hook( sub {}, "" ) };
like( $@, qr/\ACHECK blocks must be CODE references/, 'bad CHECK blocks cause errors' );
eval { Devel::Hook->push_INIT_hook( sub {}, [] ) };
( run in 0.994 second using v1.01-cache-2.11-cpan-748bfb374f4 )