Perl distributions assume that they are going to be run from a Makefile and that someone is going to look at the output: not the results, the output. The Test::Harness stuff is narrowly focussed for just that purpose. No one really cares that much about using it for anything else, so it mostly lives a peaceful life. I just need it to be the tiniest bit different though, so I just reuse some bits from the private interface to Test::Harness and throw away the output. Don't try this at home, kids!

(Note: some of this originally appeared on Use.perl) I want to run the Test::Harness magic from a program, but it wasn't designed for that really, and outputs things when it should really be be quiet. This problem is a documented To Do item in the Test::Harness docs, even. No matter: I just turn STDOUT and STDERR into big globs of nothing, then run the private method _run_all_tests() because it is really just runtests() without the report.

That turning off STDOUT even works surprises me. Remember that Test::Harness gets messages from the test files through STDOUT. Heck, it was a couple of seconds of typing and it worked. I tried it on some tests that had failures, and it caught them. Schwern tells me I should do it right by using Test::Harness::Straps, and he's right, of course. I basically have to rewrite _run_all_tests(), which already does everything I want but is just slightly annoying. So, I'll get right on that the next time I have some free time for coding.

_run_all_tests() needs to know where to find things that only MakeMaker knows about (the build library: blib), so I create an ExtUtils::MM object and peek at things I probably shouldn't know about. It likes to complain too, so I have to do that after STDERR is wiped away (temporarily). I could have just faked this since I already know what those paths are, but maybe someone who wants to use this has a different set-up. I hate hard-coding things in programs (mostly because Randal slaps me on the wrist whenever I do. If you think he's tough here, try pair programming with him ;)

What a little bundle of ugliness, but it's better than fixing the modules or doing a lot of Test::Harness::Straps work, at least for now. The first goal is working code.

my( $totals, $failed ) = eval {
    local @INC = @INC;
    local *STDOUT;                # Shut up Test::Harness!
    local *STDERR;                # Yeah, you too!
    my $MM = ExtUtils::MM->new(); # and you!

    unshift @INC, map { File::Spec->rel2abs($_) }
        @{ $MM }{ qw( INST_LIB INST_ARCHLIB ) };

    Test::Harness::_run_all_tests( @test_files )
    };
[download]

The report

The report I get is very simple. It's a one line message for each directory it checks. Later, when I convert things to Test::Harness::Straps, I can do an overall report.

/Users/brian/Dev/orn-weblogs ... No tests failed
/Users/brian/Dev/Palm/Magellan/NavCompanion ... 1/1 ( 100.0% ) failed
/Users/brian/Dev/perlbrowser ... Prerequisites not found! Skipping.
/Users/brian/Dev/Pod/LaTeX/TPR ... No tests failed
/Users/brian/Dev/Polyglot ... No tests failed
/Users/brian/Dev/release ... Could not even run tests.
/Users/brian/Dev/scriptdist ... No tests failed

Most things pass all their tests, some have missing prerequisites, and a some fail tests. Some things don't have tests. Some things have tests, but I've broken things so badly I can't run the tests (like the release project which is in the middle of a major overhaul). Now I know what I need to do to get everything to the same level.

Some things are missing prereqs because I have a new laptop and I simply haven't installed them. That's easy to fix (unless the prereq is ImageMagick ;).

Again, I'm doing all of this to avoid abandoned code. Most of the time those "abandoned" projects just need the tiniest bit of attention to stay current. I can periodically check all of my projects at once, automatically, and with very little effort.

The program

I wrote this in one pass, and since it's working I haven't messed around with it. Eventually I want to turn this into something where the test harness runs all of the test files in all of the directories and gives one report, but that's going to take some work (and a lot of chdir()s).

Remember the bits I said about ugly kludginess!

If you want to run it, give it a list of directories to check. Those should be the directories with a Makefile.PL and a t directory. I run it with a command line and save the output to a file. I can then grep the file to list things that I need to look at.

find ~/Dev -name Makefile.PL | perl -pe 's|/Makefile.PL$||' | xargs da
+ily_build > daily.txt
[download]

Just the code

#!/usr/bin/perl -sw
use strict;

use ExtUtils::MM;
use File::Spec;
use File::Spec::Functions qw(catfile);
use Test::Harness;
use Test::Manifest;

our( %Missing, $v );

foreach my $arg ( @ARGV )
    {
    print "$arg ... ";
    print "\n" if $v;
    
    #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
    do{    message( "Could not change to [$arg]: $!" ); next } 
        unless chdir $arg;
        
    do{ message( "There is no Makefile.PL! Skipping." ); next } 
        unless -e "Makefile.PL";
    
    #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
    my @output = run_makefile_pl();

    #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
    if( my @missing = find_missing_prereqs( @output ) )
        {
        message( "Prerequisites not found! Skipping." );
        
        if( $v )
            {
            message( "\t\t" . join "\n\t\t", @missing );
        
            @Missing{ @missing } = (1) x @missing;
            }
            
        next;
        }
            
    #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
    @output = run_make();
    
    #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
    my @test_files = get_test_files();
    
    #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
    unless( @test_files )
        {
        message( "Found no test files! Skipping." );
        next;
        }
        
    #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
    message( "Found tests ==> " . join " ", @test_files, "\n" ) if $v;
    
    open STDERR, ">> /dev/null";

    message( "Testing ==> " ) if $v;
    
    my( $totals, $failed ) = test_files( @test_files );

    unless( defined $totals and defined $failed )
        {
        message( "Could not even run tests." );
        next;
        }
    
    #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
    if( keys %$failed )
        {
        my( $max, $fail, $string ) = ( 0, 0, '' );

        foreach my $key ( keys %$failed )
            {
            my $hash = $failed->{$key};
            
            if( $hash->{failed} > $hash->{max} )
                {
                $hash->{failed} = $hash->{max}
                }
                
            $string  .= sprintf "\t\t%-20s failed %d/%d ( %3d%% )\n",
                $key, @{ $hash }{ qw( failed max percent ) };
                
            $max  += $hash->{max};
            $fail += $hash->{failed};
            }
        
        message( sprintf "%d/%d ( %3.1f%% ) failed",
            $fail, $max, $fail / $max * 100 );
            
        message( $string ) if $v;
        }
    else
        {
        message( "No tests failed" );
        }
    }
    
#  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #  #
if( $v and keys %Missing )
    {
    print "-" x 73, "\n", "Missing modules\n";
    print join "\n\t", sort keys %Missing;
    print "\n\n";
    }

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub message
    {
    chomp( my $message = shift );
    
    print "\t" if $v;
    print "$message\n";
    }
    
sub get_test_files
    {
    my @files = do {
        if( -e Test::Manifest::manifest_name() )
            {
            Test::Manifest::get_t_files()
            }
        else
            {
            find_all_t_files();
            }
        };
    }
    
sub find_all_t_files { glob "t/*.t" }

sub run_makefile_pl { `perl Makefile.PL 2>&1`;    }

sub run_make { `make 2>&1`;    }

sub find_missing_prereqs 
    {
    my @output = shift;
    my %missing = ();
    
    if( grep { m/not found/ } @output )
        {
        chomp @output;
        %missing = map { s/^W.*ite\s+|\s+[\d._]* not found.$//g; $_, 1
+ } 
            grep { m/not found/ } @output;
        }
    
    return ( keys %missing );
    }
    
sub test_files
    {
    my @test_files = @_;
    
    eval { 
        local @INC = @INC;
        local *STDOUT;                # Shut up Test::Harness!
        local *STDERR;                # Yeah, you too!
        my $MM = ExtUtils::MM->new(); # and you!
        
        unshift @INC, map { File::Spec->rel2abs($_) }
            @{ $MM }{ qw( INST_LIB INST_ARCHLIB ) };
            
        Test::Harness::_run_all_tests( @test_files ) 
        }    
    }
[download]