package MyBuilder;
BEGIN {
require Module::Build;
@ISA = qw(Module::Build);
}
# Test with Test::Harness
sub ACTION_test_with_harness {
my $self = shift;
$self->SUPER::ACTION_test(@_);
}
# Test with TAP::Harness instead of Test::Harness
sub ACTION_test {
my $self = shift;
$self->depends_on('code');
my $tests = $self->find_test_files;
unless (@$tests) {
$self->log_info("No tests defined.\n");
return;
}
# TODO verbose and stuff
require TAP::Harness;
my $harness = TAP::Harness->new( { lib => 'blib/lib' } );
my $aggregator = $harness->runtests(@$tests);
die "Failed!\n" if $aggregator->has_problems;
}
sub ACTION_testprove {
my $self = shift;
$self->depends_on('code');
exec( $^X, '-Iblib/lib', 'bin/prove', '-b', '-r', 't' );
}
sub ACTION_testleaks {
my $self = shift;
$self->depends_on('code');
exec( $^X, '-MDevel::Leak::Object=GLOBAL_bless', '-Iblib/lib',
'bin/prove', '-b', '-r', 't'
);
}
sub ACTION_testreference {
my $self = shift;
$self->depends_on('code');
my $ref = 'reference/Test-Harness-2.64';
exec( $^X,
( -e $ref ? ( "-I$ref/lib", "$ref/bin/prove" ) : qw(-S prove) ),
'-Iblib/lib', '-r', 't'
);
}
sub ACTION_testauthor {
my $self = shift;
$self->test_files('xt/author');
$self->ACTION_test;
}
sub ACTION_critic {
exec(
qw(perlcritic -1 -q -profile perlcriticrc
bin/prove lib/), glob('t/*.t')
);
}
sub ACTION_tags {
exec(
qw(ctags -f tags --recurse --totals
--exclude=blib
--exclude=.svn
--exclude='*~'
--languages=Perl
t/ lib/ bin/prove
)
);
}
sub ACTION_tidy {
my $self = shift;
my @extra = qw(
Build.PL
Makefile.PL
bin/prove
);
my %found_files = map {%$_} $self->find_pm_files,
$self->_find_file_by_type( 'pm', 't' ),
$self->_find_file_by_type( 'pm', 'inc' ),
$self->_find_file_by_type( 't', 't' );
my @files = (
keys %found_files,
map { $self->localize_file_path($_) } @extra
);
for my $file (@files) {
system( 'perltidy', '-b', $file );
unlink("$file.bak") if $? == 0;
}
}
my @profiling_target = qw( -Mblib bin/prove --timer t/regression.t );
sub ACTION_dprof {
system( $^X, '-d:DProf', @profiling_target );
exec(qw( dprofpp -R ));
}
sub ACTION_smallprof {
system( $^X, '-d:SmallProf', @profiling_target );
open( FH, 'smallprof.out' ) or die "Can't open smallprof.out: $!";
@rows = grep {/\d+:/} <FH>;
close FH;
@rows = reverse
sort { ( split( /\s+/, $a ) )[2] <=> ( split( /\s+/, $b ) )[2] } @rows;
@rows = @rows[ 0 .. 30 ];
print join( '', @rows );
}
sub read_manifest {
my ( $self, $file, $into ) = @_;
open my $fh, '<', $file or die "Can't read $file: $!";
while (<$fh>) {
chomp;
s/\s*#.*//;
$into->{$_}++ if length $_;
}
}
sub ACTION_manifest {
my ( $self, @args ) = @_;
$self->SUPER::ACTION_manifest(@args);
my $stash = {};
my $mc = 'MANIFEST.CUMMULATIVE';
$self->read_manifest( $mc, $stash );
$self->read_manifest( 'MANIFEST', $stash );
open my $fh, '>', $mc or die "Can't write $mc: $!";
print $fh "$_\n" for sort keys %$stash;
}
1;