#!/usr/bin/perl use strict; use warnings; use Term::ANSIColor; use Test::Harness::Straps; use constant SUCCESS => color 'bold green'; use constant FAILURE => color 'bold red'; use constant SKIP => color 'bold yellow'; use constant RESET => color 'reset'; my $strap = Test::Harness::Straps->new(); for my $file (@ARGV) { next unless -f $file; my %results = $strap->analyze_file( $file ); my ($header, $results) = process_results( $file, \%results ); if ($results{passing}) { print SUCCESS; print( sprintf("All (%d) tests passed in %s\n", $results{seen}, $file)); } elsif ($results{skip_all}) { print SKIP; print sprintf("All (%d) tests skipped in %s\n", $results{seen}, $file); } else { print FAILURE; print "$header\n"; } foreach my $result (@$results) { if ($result->{test}{ok}) { print SUCCESS; } else { print FAILURE; } print $result->{output}; } print RESET; } sub process_results { my ($file, $results) = @_; my $report = create_header($file, @{$results}{qw( max seen ok )}); my $count = 0; my @results; for my $test ( @{ $results->{details} } ) { $count++; push @results => { test => $test, output => create_test_result( $test->{ok}, $count, @{ $test }{qw( name reason ) } ) } } return ($report, \@results); } sub create_header { my ($file, $expected, $seen, $passed) = @_; my $failed = $seen - $passed; return sprintf "File '%s'\nExpected %d / Seen %d / Okay %d / Failed %d\n", @_, $failed; } sub create_test_result { my ($ok, $number, $name, $reason) = @_; $ok = $ok ? 'ok' : 'not ok'; $reason = $reason ? " ($reason)" : ""; return sprintf "%6s %4d %s%s\n", $ok, $number, $name, $reason; }