B-CompilerPhase-Hook
view release on metacpan or search on metacpan
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
MODULE = B::CompilerPhase::Hook PACKAGE = B::CompilerPhase::Hook
PROTOTYPES: ENABLE
# UNITCHECK
void
prepend_UNITCHECK(handler)
SV* handler
PROTOTYPE: &
CODE:
if ( !PL_unitcheckav ) {
PL_unitcheckav = newAV();
}
SvREFCNT_inc(handler);
av_unshift(PL_unitcheckav, 1);
av_store(PL_unitcheckav, 0, handler);
void
append_UNITCHECK(handler)
SV* handler
PROTOTYPE: &
CODE:
if ( !PL_unitcheckav ) {
PL_unitcheckav = newAV();
}
SvREFCNT_inc(handler);
av_push(PL_unitcheckav, handler);
# CHECK
RETVAL
AV*
get_INIT_array()
CODE:
RETVAL = PL_initav;
OUTPUT:
RETVAL
AV*
get_UNITCHECK_array()
CODE:
RETVAL = PL_unitcheckav;
OUTPUT:
RETVAL
Hook.xs
lib/B/CompilerPhase/Hook.pm
Makefile.PL
MANIFEST This list of files
README.md
t/000-load.t
t/001-basic.t
t/010-BEGIN.t
t/011-CHECK.t
t/012-INIT.t
t/013-UNITCHECK.t
t/014-END.t
t/100-timing-test.t
t/lib/Timer.pm
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
{
"abstract" : "Programatically install BEGIN/CHECK/INIT/UNITCHECK/END blocks",
"author" : [
"Stevan Little"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
---
abstract: 'Programatically install BEGIN/CHECK/INIT/UNITCHECK/END blocks'
author:
- 'Stevan Little'
build_requires: {}
configure_requires:
ExtUtils::MakeMaker: '6.30'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
Makefile.PL view on Meta::CPAN
use strict;
use warnings;
use ExtUtils::MakeMaker 6.30;
my %WriteMakefileArgs = (
'NAME' => 'B::CompilerPhase::Hook',
'VERSION' => '0.04',
'DISTNAME' => 'B-CompilerPhase-Hook',
'ABSTRACT' => 'Programatically install BEGIN/CHECK/INIT/UNITCHECK/END blocks',
'AUTHOR' => 'Stevan Little',
'BUILD_REQUIRES' => {},
'CONFIGURE_REQUIRES' => {
'ExtUtils::MakeMaker' => '6.30'
},
'EXE_FILES' => [],
'LICENSE' => 'perl',
'NORECURS' => 1,
'PREREQ_PM' => {
# tests ..
# B::CompilerPhase::Hook
This provides access to the BEGIN/CHECK/INIT/UNITCHECK/END
blocks with a clean API.
# Copyright and License
This software is copyright (c) 2017 by Stevan Little.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
lib/B/CompilerPhase/Hook.pm view on Meta::CPAN
package B::CompilerPhase::Hook;
# ABSTRACT: Programatically install BEGIN/CHECK/INIT/UNITCHECK/END blocks
use strict;
use warnings;
our $VERSION;
our $AUTHORITY;
use XSLoader;
BEGIN {
$VERSION = '0.04';
$AUTHORITY = 'cpan:STEVAN';
XSLoader::load( __PACKAGE__, $VERSION );
# now set up the DWIM methods ...
*enqueue_BEGIN = \&append_BEGIN;
*enqueue_CHECK = \&prepend_CHECK;
*enqueue_INIT = \&append_INIT;
*enqueue_UNITCHECK = \&prepend_UNITCHECK;
*enqueue_END = \&prepend_END;
}
sub import {
shift;
if ( @_ ) {
my $to = caller;
my $from = __PACKAGE__;
foreach ( @_ ) {
no strict 'refs';
lib/B/CompilerPhase/Hook.pm view on Meta::CPAN
}
1;
__END__
=pod
=head1 NAME
B::CompilerPhase::Hook - Programatically install BEGIN/CHECK/INIT/UNITCHECK/END blocks
=head1 VERSION
version 0.02
=head1 SYNOPSIS
use B::CompilerPhase::Hook qw[
enqueue_BEGIN
enqueue_CHECK
enqueue_INIT
enqueue_UNITCHECK
enqueue_END
];
# We call these functions within BEGIN
# blocks so that we can be assured they
# will enqueue properly, see the docs
# for more info.
print "10. Ordinary code runs at runtime.\n";
BEGIN {
enqueue_END { print "16. So this is the end of the tale.\n" };
enqueue_INIT { print " 7. INIT blocks run FIFO just before runtime.\n" };
enqueue_UNITCHECK { print " 4. And therefore before any CHECK blocks.\n" };
enqueue_CHECK { print " 6. So this is the sixth line.\n" }
}
print "11. It runs in order, of course.\n";
BEGIN {
enqueue_BEGIN { print " 1. BEGIN blocks run FIFO during compilation.\n" }
enqueue_END { print "15. Read perlmod for the rest of the story.\n" }
enqueue_CHECK { print " 5. CHECK blocks run LIFO after all compilation.\n" }
enqueue_INIT { print " 8. Run this again, using Perl's -c switch.\n" }
}
print "12. This is anti-obfuscated code.\n";
BEGIN {
enqueue_END { print "14. END blocks run LIFO at quitting time.\n" }
enqueue_BEGIN { print " 2. So this line comes out second.\n" }
enqueue_UNITCHECK { print " 3. UNITCHECK blocks run LIFO after each file is compiled.\n" }
enqueue_INIT { print " 9. You'll see the difference right away.\n" }
}
print "13. It only _looks_ like it should be confusing.\n";
# With apologies to the `BEGIN-UNITCHECK-CHECK-INIT-and-END` section of `perlmod`
=head1 DESCRIPTION
This module makes it possible to enqueue callbacks to be run during
the various Perl compiler phases, with the aim of doing multi-phase
meta programming in a reasonably clean way.
=head1 FUNCTIONS
These functions either C<push> or C<unshift> onto the respective internal
lib/B/CompilerPhase/Hook.pm view on Meta::CPAN
=head2 C<enqueue_CHECK( $cb )>
This will C<unshift> the C<$cb> onto the end of the internal
C<CHECK> array.
=head2 C<enqueue_INIT( $cb )>
This will C<push> the C<$cb> onto the end of the internal
C<INIT> array.
=head2 C<enqueue_UNITCHECK( $cb )>
This will C<unshift> the C<$cb> onto the end of the internal
C<UNITCHECK> array.
=head2 C<enqueue_END( $cb )>
This will C<unshift> the C<$cb> onto the end of the internal
C<END> array.
=head1 LOWER LEVEL FUNCTIONS
For each of the phases we have a C<prepend_${phase}> function, which
will C<push> and an C<append_${phase}> function which will C<unshift>.
t/001-basic.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
BEGIN {
use_ok('B::CompilerPhase::Hook', qw[
enqueue_BEGIN
enqueue_CHECK
enqueue_INIT
enqueue_UNITCHECK
enqueue_END
]);
}
=pod
This tests is based on the `begincheck` program as
presented in the perlmod docs.
https://metacpan.org/pod/perlmod#BEGIN-UNITCHECK-CHECK-INIT-and-END
=cut
# NOTE:
# we need to do this so that our
# END tests work, comment it out
# to see why ;)
# - SL
END { done_testing() }
our @DATA;
# Since (UNIT)CHECK/END in LIFO order, we need to specify these here ...
UNITCHECK { is_deeply( \@DATA, [ 1 .. 4 ], '... got the data in the expected order during UNITCHECK' ) }
CHECK { is_deeply( \@DATA, [ 1 .. 6 ], '... got the data in the expected order during CHECK' ) }
END { is_deeply( \@DATA, [ 1 .. 16 ], '... got the data in the expected order during END' ) }
# this is the body of the test
push @DATA => 10;
BEGIN {
enqueue_END { push @DATA => 16 };
enqueue_INIT { push @DATA => 7 };
enqueue_UNITCHECK { push @DATA => 4 };
enqueue_CHECK { push @DATA => 6 };
}
push @DATA => 11;
BEGIN {
enqueue_BEGIN { push @DATA => 1 };
enqueue_END { push @DATA => 15 };
enqueue_CHECK { push @DATA => 5 };
enqueue_INIT { push @DATA => 8 };
}
push @DATA => 12;
BEGIN {
enqueue_END { push @DATA => 14 };
enqueue_BEGIN { push @DATA => 2 };
enqueue_UNITCHECK { push @DATA => 3 };
enqueue_INIT { push @DATA => 9 };
}
push @DATA => 13;
# since BEGIN/INIT/RUN is in FIFO we need to specify these here ...
BEGIN { is_deeply( \@DATA, [ 1, 2 ], '... got the data in the expected order during BEGIN' ) }
INIT { is_deeply( \@DATA, [ 1 .. 9 ], '... got the data in the expected order during INIT' ) }
is_deeply( \@DATA, [ 1 ... 13 ], '... got the data in the expected order during RUN' );
1;
t/013-UNITCHECK.t view on Meta::CPAN
#!perl
use strict;
use warnings;
use Test::More;
BEGIN {
use_ok('B::CompilerPhase::Hook', qw[
enqueue_UNITCHECK
append_UNITCHECK
prepend_UNITCHECK
]);
}
=pod
=cut
our @TEST;
UNITCHECK {
is(scalar(@TEST), 0, '... got the undefined TEST');
is(scalar(@{ B::CompilerPhase::Hook::Debug::get_UNITCHECK_array() }), 0, '... UNITCHECK is empty');
enqueue_UNITCHECK { push @TEST => 2 };
prepend_UNITCHECK { push @TEST => 1 };
append_UNITCHECK { push @TEST => 3 };
is(scalar(@{ B::CompilerPhase::Hook::Debug::get_UNITCHECK_array() }), 3, '... UNITCHECK now has three');
is(scalar(@TEST), 0, '... (still) got the undefined TEST');
}
# check at runtime ...
{
is(scalar(@{ B::CompilerPhase::Hook::Debug::get_UNITCHECK_array() }), 0, '... UNITCHECK is empty again');
is(scalar(@TEST), 3, '... got the expected true value of TEST');
is_deeply(\@TEST, [1, 2, 3], '... got the right values as well');
}
done_testing();
t/lib/Timer.pm view on Meta::CPAN
package Timer;
use strict;
use warnings;
use Time::HiRes qw[ gettimeofday tv_interval ];
use B::CompilerPhase::Hook qw[ enqueue_UNITCHECK ];
our $TIME = 0;
sub import {
$TIME = 0;
my $start = [ gettimeofday ];
#warn sprintf "Starting at %d:%d\n" => @$start;
sleep(1);
enqueue_UNITCHECK {
$TIME = tv_interval( $start, [ gettimeofday ] );
#warn "Finished after $TIME\n";
};
}
1;
__END__
( run in 1.638 second using v1.01-cache-2.11-cpan-702932259ff )