#!/usr/bin/perl
# This program must be run as a user in the MOOENTRYGROUP.
#
# Runs tests on all the mooix objects whose directory names are given
# as parameters, and displays results. Expects to be given objects in a
# test tree, as set up with the testtree utility.
use warnings;
use strict;
use Mooix::Thing;
use Test::Harness;
use Test::Harness::Straps;

my $verbose=0;
# Maps between the names of the tests and the object and method to run.
my %tests;

# By default perl's test harness runs test programs via perl. For mooix,
# we want to make mooix method calls (which will use runmeth underneath).
# To do this we'll have to override Test::Harness::Straps::analyze_file.
# Then we can use the rest of Test::Harness.
no warnings 'redefine';
sub Test::Harness::Straps::analyze_file {
	
	my ($this, $testname) = @_;
	my $object = $tests{$testname}->[0];
	my $method = $tests{$testname}->[1];
	
	# Don't use a method call to run the test, because it's better to
	# stream the results through the test analyzer.
	if (open(METHOD_PIPE, "-|")) {
		my %results = $this->analyze_fh($object->name."->$method", \*METHOD_PIPE);
		close METHOD_PIPE;

		$results{wait} = $?;
		$results{exit} = Test::Harness::Straps::_wait2exit($?);
		$results{passing} = 0 unless $? == 0;
		return %results;
	}
	else {
		# close it, but runmeth really wants it to be a file handle
		open(STDIN, "</dev/null");
		chdir($object->id) || die "chdir";
		exec("runmeth", "./$method") || die "runmeth: $!";
	}
}
use warnings 'redefine';

my $objs=0;
for (my $x=0; $x < @ARGV; $x++) {
	my $dir=$ARGV[$x];
	print "\rScanning objects.. ".($x+1)."/".int(@ARGV)."\r";

	my $obj=Mooix::Thing->get($dir);
	unless (ref $obj) {
		die "$dir is not a mooix object\n";
	}
	my @testpairs=$obj->test_list;
	$objs++ if @testpairs;
	while (@testpairs) {
		my $method=shift @testpairs;
		my $object=shift @testpairs;
		unless ($method =~ /^test_.+/) {
			die "$obj returned a bogus test method, $object->$method\n";
		}
		unless (ref $object) {
			die "$obj returned a bogus test object, $object\n";
		}
		$tests{$object->name."->".$method} = [ $object, $method ];
	}
}
print "Gathering test methods.. ".int(keys %tests)." in $objs objects";
if ($objs < @ARGV) {
	print " (".(@ARGV - $objs)." untestable objects)";
}
print "\n";

print "Running tests..\n";
runtests(sort keys %tests);
