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

use Test::Unit::TestSuite;
use Test::Unit::TestCase;
use Test::Unit::UnitHarness;

# should really do something in here about a local @INC.
sub obj_load {
  my $class=shift;
  load(@_);
}

sub load {
  my $test_case=shift;
  my $suite;
  # Is it a test class?
  if ($test_case=~/^[\w:]+$/ 
	  and eval "require $test_case"
	  and not $@) {
	# first up: is this a real test case?
	$suite=try_test_case($test_case);
	return $suite if ($suite);
	$suite=try_test_suite($test_case);
	return $suite if ($suite);
  } elsif ($test_case=~/\.pm$/ 
		   and eval "require \"$test_case\""
		   and not $@) {
	#In this case I need to figure out what the class
	#was I just loaded!
	$test_case=get_package_name_from_file($test_case);
	$suite=try_test_case($test_case);
	return $suite if ($suite);
	$suite=try_test_suite($test_case);
	return $suite if ($suite);
  } else {
	print "Debug: ".$@ if DEBUG;
  }
  for my $file ("$test_case",
			  "$test_case.t",
			  "t/$test_case",
			  "t/$test_case.t" ) {
	# try it out as a test::harness type test.
	$suite=try_test_harness($file);
	return $suite if $suite;
  }
  # one last shot: is it a _directory_?
  $suite=try_test_dir($test_case);
  return $suite if $suite;
  die "(This error is expected) Suite class " . $test_case . " not found: $@";
 
}

sub try_test_case {
  my $test_case=shift;
  no strict 'refs';
  if ($test_case->isa("Test::Unit::TestCase")) {
	return Test::Unit::TestSuite->new($test_case);
  } 
}
sub try_test_suite {
  my $test_case=shift;
  no strict 'refs';
  if ($test_case->can("suite")) {
	return $test_case->suite();
  } 
}
sub try_test_harness {
  my $test_case=shift;
  if (-r $test_case) {
	my $fh = new FileHandle;
	$fh->open($test_case) or return;
	my $first = <$fh>;
	$fh->close or return;
	return Test::Unit::UnitHarness->new($test_case);
  }
}
sub try_test_dir {
  my $test_case=shift;
  if (-d $test_case) {
	die "This is a test directory. I havent implemented that.\n";
	return Test::Unit::UnitHarness::new_dir($test_case);
  }
}

# The next bit of code is a helper function which attempts
# to identify the class we are trying to use from a '.pm'
# file. If we've reached this point, we managed to 'require'
# the file already, but we dont know the file the package was
# loaded from. Somehow I feel this information is in perl
# somwhere but if it is I dont know where...
sub get_package_name_from_file {
  my $test_case=shift;
  my $fh = new FileHandle;
  my $filename;
  # first off we've actually got to find the thing. It's in
  # @INC somewhere...
  foreach my $file (map {"$_/$test_case"} @INC) {
	$fh->open($file) or next; 
	foreach my $line (<$fh>) {
	  if ($line=~/^\s*package\s+([\w:]+)/) {
		return $1;
	  }
	}
	$fh->close or 
	  die "Didnt find 'package' in $test_case and couldnt close it!";
  }
  die "Got a $test_case but cant find 'package'";
}

1;
__END__


=head1 NAME

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

=head1 SYNOPSIS

This class is not intended to be used directly 

=head1 DESCRIPTION

This class is used by the framework to load testcase classes into the
runtime environment. It handles testcase class names (that is, classes
inheriting from Test::Unit::TestCase), Test::Harness style test files,
and directory names.

=head1 AUTHOR

Copyright (c) 2000 Brian Ewins.

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: 
Christian Lemburg, Cayte Lindner, J.E. Fritz, Zhon Johansen.

=head1 SEE ALSO

=over 4

=item *

L<Test::Unit::TestCase>

=item *

L<Test::Unit::UnitHarness>

=item *

L<Test::Unit::TkTestRunner>

=back

=cut