package Test::Unit::TestRunner;
use strict;
use constant DEBUG => 0;

use base qw(Test::Unit::TestListener); 

use Test::Unit::TestSuite;
use Test::Unit::TestResult;

use Benchmark;

sub new {
    my $class = shift;
    my ($filehandle) = @_;
    $filehandle = \*STDOUT unless $filehandle;
    bless { _Print_stream => $filehandle }, $class;
}

sub print_stream {
    my $self = shift;
    return $self->{_Print_stream};
}

sub _print {
    my $self = shift;
    my (@args) = @_;
    local *FH = *{$self->print_stream()};
    print FH @args;
}

sub add_error {
    my $self = shift;
    my ($test, $exception) = @_;
    $self->_print("E");
}
	
sub add_failure {
    my $self = shift;
    my ($test, $exception) = @_;
    $self->_print("F");
}

sub add_pass {
    # in this runner passes are ignored.
}

sub create_test_result {
    my $self = shift;
    return Test::Unit::TestResult->new();
}
	
sub do_run {
    my $self = shift;
    my ($suite, $wait) = @_;
    my $result = $self->create_test_result();
    $result->add_listener($self);
    my $start_time = new Benchmark();
    $suite->run($result);
    my $end_time = new Benchmark();
    my $run_time = timediff($end_time, $start_time);
    $self->_print("\n", "Time: ", timestr($run_time), "\n");

    $self->print_result($result);
    
    if ($wait) {
	print "<RETURN> to continue"; # go to STDIN any case
	<STDIN>;
    }
    if (not $result->was_successful()) {
	die "\nTest was not successful.\n";
    }
    return 0;
}

sub end_test {
    my $self = shift;
    my ($test) = @_;
}

sub main {
    my $self = shift;
    my $a_test_runner = Test::Unit::TestRunner->new();
    $a_test_runner->start(@_);
}

sub print_result {
    my $self = shift;
    my ($result) = @_;
    $self->print_header($result);
    $self->print_errors($result);
    $self->print_failures($result);
}

sub print_errors {
    my $self = shift;
    my ($result) = @_;
    if ($result->error_count() != 0) {
	if ($result->error_count == 1) {
	    $self->_print("There was ", $result->error_count(), " error:\n");
	} else {
	    $self->_print("There were ", $result->error_count(), " errors:\n");
	}
	my $i = 0; 
	for my $e (@{$result->errors()}) {
	    $i++;
	    $self->_print($i, ") ", $e->to_string());
	}
    }
}

sub print_failures {
    my $self = shift;
    my ($result) = @_;
    if ($result->failure_count() != 0) {
	if ($result->failure_count == 1) {
	    $self->_print("There was ", $result->failure_count(), " failure:\n");
	} else {
	    $self->_print("There were ", $result->failure_count(), " failures:\n");
	}
	my $i = 0; 
	for my $e (@{$result->failures()}) {
	    $i++;
	    $self->_print($i, ") ", $e->to_string());
	}
    }
}

sub print_header {
    my $self = shift;
    my ($result) = @_;
    if ($result->was_successful()) {
	$self->_print("\n", "OK", " (", $result->run_count(), " tests)");
    } else {
	$self->_print("\n", "!!!FAILURES!!!", "\n",
		      "Test Results:\n",
		      "Run: ", $result->run_count(), 
		      " Failures: ", $result->failure_count(),
		      " Errors: ", $result->error_count(),
		      "\n");
    }
}

sub run {
    my $self = shift;
    my ($class) = @_;
    my $a_test_runner = Test::Unit::TestRunner->new();
    if ($class->isa("Test::Unit::Test")) {
	$a_test_runner->do_run($class, 0);
    } else {
	$a_test_runner->do_run(Test::Unit::TestSuite->new($class), 0);
    }
}
	
sub run_and_wait {
    my $self = shift;
    my ($test) = @_;
    my $a_test_runner = Test::Unit::TestRunner->new();
    $a_test_runner->do_run($test, 1);
}

sub start {
    my $self = shift;
    my (@args) = @_;

    my $test_case = "";
    my $wait = 0;

    for (my $i = 0; $i < @args; $i++) {
	if ($args[$i] eq "-wait") {
	    $wait = 1;
	} elsif ($args[$i] eq "-v") {
	    print "Test::Unit Version 0.1 experimental, copyright Christian Lemburg, Brian Ewins, J.E. Fritz, Cayte Lindner, Zhon Johansen, 2000\n";
	} else {
	    $test_case = $args[$i];
	}
    }
    if ($test_case eq "") {
	die "Usage TestRunner.pl [-wait] name, where name is the name of the TestCase class", "\n";
    }

    eval "require $test_case" 
	or die "Suite class " . $test_case . " not found: $@";
    no strict 'refs';
    my $suite;
    my $suite_method = $test_case->can("suite") ? 
	    \&{"$test_case" . "::" . "suite"} : undef; 
    if (not $suite_method) {
	$suite = Test::Unit::TestSuite->new($test_case);
    }
    if (not $suite) {
	eval {
	    $suite = $suite_method->();
	};
	die "Could not invoke the suite() method: $@" if $@;
    }
    $self->do_run($suite, $wait);
}

sub start_test {
    my $self = shift;
    my ($test) = @_;
    $self->_print(".");
}

1;
__END__


=head1 NAME

    Test::Unit::TestRunner - unit testing framework helper class

=head1 SYNOPSIS

    use Test::Unit::TestRunner;

    my $testrunner = Test::Unit::TestRunner->new();
    $testrunner->start($my_testcase_class);

=head1 DESCRIPTION

    This class is the test runner for the command line style use
    of the testing framework.

    It is used by simple command line tools like the TestRunner.pl
    script provided.

    The class needs one argument, which is the name of the class
    encapsulating the tests to be run.
    
    Options:
	-wait : wait for user confirmation between tests
	-v    : Version info

=head1 AUTHOR

    Framework JUnit authored by Kent Beck and Erich Gamma.

    Ported from Java to Perl by Christian Lemburg.

    Copyright (c) 2000 Christian Lemburg, <lemburg@acm.org>.

    All rights reserved. This program is free software; you can
    redistribute it and/or modify it under the same terms as
    Perl itself.

    Thanks go to the other PerlUnit framework people: 
    Brian Ewins, Cayte Lindner, J.E. Fritz, Zhon Johansen.

=head1 SEE ALSO

    - Test::Unit::TestCase
    - Test::Unit::TestListener
    - Test::Unit::TestSuite
    - Test::Unit::TestResult
    - Test::Unit::TkTestRunner
    - For further examples, take a look at the framework self test 
      collection (Test::Unit::tests::AllTests).

=cut
