The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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() ) {
        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 F<TestRunner.pl>
script provided.

The class needs one argument, which is the name of the class
encapsulating the tests to be run.

=head1 OPTIONS

=over 4

=item -wait

wait for user confirmation between tests

=item -v

version info

=back


=head1 AUTHOR

Framework JUnit authored by Kent Beck and Erich Gamma.

Ported from Java to Perl by Christian Lemburg.

Copyright (c) 2000 Christian Lemburg, E<lt>lemburg@acm.orgE<gt>.

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

=over 4

=item *

L<Test::Unit::TestCase>

=item *

L<Test::Unit::TestListener>

=item *

L<Test::Unit::TestSuite>

=item *

L<Test::Unit::TestResult>

=item *

L<Test::Unit::TkTestRunner>

=item *

For further examples, take a look at the framework self test
collection (Test::Unit::tests::AllTests).

=back

=cut