Test結果に色づけしたいというちょっと古いネタ。

ふと本棚を見てPerlHacksをみて、「あぁTestにFailした物だけを表示するやつやってなかったなぁ」
と思ってパッっと作ってみた。最初PerlHacksのやつコピペしただけで行けるかな？と思ったけど
動かなかったのでちょこちょこ直した。

#!/usr/bin/perl
use strict;
use warnings;
use Term::ANSIColor;
use Test::Harness::Straps;


open *STDERR, '>/dev/null' or die;


my $simple = $ARGV[0] eq '-s' ? shift @ARGV : 0;
my $strap = Test::Harness::Straps->new();
my $all_cnt = 0;
my $err_cnt = 0;


for my $file (@ARGV) {

	unless (-e $file)	{
		my @files = glob $file;
		next unless @files;

		push @ARGV, @files and next;
	}


    my $result = $strap->analyze_file($file);


	my $out = sprintf "%-40s", $file;
		$out =~ s/ /./g;
	print $out unless $simple;


	print $result->skip_all
		? coloring('bold yellow' => 'Skipped')
		: $result->passing
			? coloring('blue bold' => 'Success')
			: coloring('bold red' => sprintf("failed test %d of %d", $result->max - $result->ok, $result->max) ) unless $simple;

	print	map { "-----> $_->{name}\n" }
				grep { not $_->{actual_ok} }
					@{$result->details} unless $simple;

	$all_cnt += @{$result->details};
	$err_cnt += $result->max - $result->ok;
}

print $err_cnt == 0 ? "\n" : "E$err_cnt/A$all_cnt\n";


sub coloring	{
	my($color,$string) = @_;
	return color($color), $string, color('reset'), "\n";
}

とりあえずこんなとこで良いかな。細かいところはちょこちょこ変えて行こう。でももうちょっとエラー以外の出力減らしていいかも。
$simpleと最後の$err_cntがなかったら改行だけを出力してるのはscreenのstatuslineで使いたかったからです。

あとこれでつかったTest::Harness::Strapsて面白いね。テストの出力好き勝手にいじれます。