#!/usr/bin/perl 
# -*- perl -*-
#

=head1 NAME

libvirt-tck - libvirt Technology Compatability Kit

=head1 SYNOPSIS

 # libvirt-tck [OPTIONS] [TESTS..]

Run with default config, probing for URI to use

 # libvirt-tck

Run with a custom config

 # libvirt-tck --config /etc/libvirt-tck/other.yml

Run with verbose progress information

 # libvirt-tck -v

Generate a formal XML document of results

 # libvirt-tck --format xml

Generate a JUnit XML document of results

 # libvirt-tck --format junit

=head1 DESCRIPTION

The C<libvirt-tck> (libvirt Technology Compatability Kit) command
provides the primary mechanism to run the functional, integration
test suite for libvirt drivers.

=head2 WARNING

The test suite is intended to be moderately safe to run on arbitrary
hosts and takes steps to avoid intentionally breaking things.

All objects (guests, networks, storage pools, etc) that are created
will  have a name prefix of "tck" to minimize risk of clashes. The
test suite will only ever (intentionally) delete objects with a
"tck" name prefix.

Where a test suite needs access to a precious host resource (physical
NIC, PCI device, USB device, block device), execution will be skipped
until the admin has white listed one or more suitable resources in
the C</etc/libvirt-tck/default.yml> configuration file.

Despite these precautions, running automated tests always carries some
degree of risk to the host system. It is thus advisable to avoid
executing this test suite on hosts with precious state.

=head2 OPTIONS

If invoked without any arguments the test suite will run using
the default configuration file from C</etc/libvirt-tck/default.yml>
and will allow libvirt to probe for the hypervisor driver to
run. If a reliably repeatable test result set is desired, it is
recommended to always give an explicit libvirt connection URI
to choose the driver.

Any command line arguments that are not parsed as options will
be considered paths to test scripts to invoke. If no paths are
given, all tests under C</usr/share/libvirt-tck/tests> will be
executed.

The following options are available when running the C<libvirt-tck>
command

=over 4

=item -v, --verbose

Display fine details of individual test progresss. Without this
only the name of each test will be printed, along with details
of failures.

=item -q, --quiet

Do not display any information about test progress, not even
the name of each test case

=item -c, --config FILE

Specify the name of the configuration file to use, rather than
the default C</etc/libvirt-tck/default.yml>

=item --format text|html|xml|junit

Choose the output format for the test results. The default format
is C<text>, producing human readable results on the console. The
C<html> option dumps an HTML file of results to STDOUT, while the
C<xml> option generates a formal XML document of results.

=item --force

Forcably remove all previously created objects, including guests,
networks, storage pools, etc which have a "tck" name prefix.

User created objects whose name does not start with "tck" will be
left untouched.

=item -a, --archive FILE

Generate an archive containing all the raw test results. The
filename given should end in either C<.bz>, C<.tar.gz> or
C<.tgz>

=item --timer

Print elapsed time after each test.

=back

=cut


use strict;
use warnings;

use Getopt::Long;
use File::Spec::Functions qw(rootdir catdir catfile rel2abs);
use Pod::Usage;
# Ultimately we're just a dumb wrapper around C<prove> making
# it less tedious to run the tests than it is when using
# C<prove> directly'
use App::Prove;

use Carp qw(confess cluck);

my $datadir = catdir(rootdir(), qw(usr share libvirt-tck));
my $confdir = catdir(rootdir(), qw(etc libvirt-tck));


my $verbose = 0;
my $quiet = 0;
my $help = 0;
my $force = 0;
my $debug = 0;
my $timer = 0;
my $archive;
my $config = catfile($confdir, "default.yml");
my $format = "text";

if (!GetOptions("verbose" => \$verbose,
		"debug" => \$debug,
		"quiet" => \$quiet,
		"help" => \$help,
		"archive=s" => \$archive,
		"config=s" => \$config,
		"force" => \$force,
		"format=s" => \$format,
		"timer" => \$timer) || $help) {
    pod2usage(-verbose => $help,
	      -output => $help ? \*STDOUT : \*STDERR,
	      -exitval => $help ? 0 : 1);
}

if ($debug) {
    warn "do debug";
    $SIG{__WARN__} = sub { Carp::cluck $_[0] };
    $SIG{__DIE__} = sub { Carp::confess $_[0] };
    $ENV{LIBVIRT_TCK_DEBUG} = 1;
}

unless (-e $config) {
    print STDERR "$0: config file $config does not exist\n";
    exit 2;
}
$config = rel2abs ($config);

if ($verbose && $quiet) {
    pod2usage(-msg => "$0: only one of --verbose and --quiet can be used\n",
	      -exitval => 2,
	      -output => \*STDERR);
}

my @testdirs = @ARGV;
unless (@testdirs) {
    push @testdirs, catdir($datadir, "tests");
}

foreach (@testdirs) {
    unless (-e $_) {
	print STDERR "$0: test path '$_' does not exist\n";
	exit 2;
    }
}

my @newargv = ("-r", "--norc", "--merge", @testdirs);

if ($archive) {
    push @newargv, "-a", $archive;
}

if ($verbose) {
    push @newargv, "-v";
} elsif ($quiet || $format ne "text") {
    push @newargv, "-Q";
}

if ($format eq "xml") {
    push @newargv, "--formatter=Sys::Virt::TCK::TAP::XMLFormatter";
} elsif ($format eq "html") {
    push @newargv, "--formatter=TAP::Formatter::HTML"
} elsif ($format eq "junit") {
    push @newargv, "--formatter=TAP::Formatter::JUnit"
} elsif ($format ne "text") {
    pod2usage(-msg => "unknown format '$format', expecting one of 'text', 'html', 'junit' or 'xml'\n",
	      -exitval => 2,
	      -output => \*STDERR);
}

if ($timer) {
    push @newargv, "--timer";
}

# This env variable is the only way to pass config into
# the Sys::Virt::TCK module from here
$ENV{LIBVIRT_TCK_CONFIG} = $config;
$ENV{LIBVIRT_TCK_AUTOCLEAN} = $force;

my $app = App::Prove->new;
$app->process_args(@newargv);
exit ($app->run ? 0 : 1);

=head1 AUTHORS

Written by Daniel P. Berrange <berrange@redhat.com>

=head1 BUGS

Probably. Report any bugs found to your OS distribution's bug
tracker or the libvirt mailing list L<http://www.redhat.com/mailman/listinfo/libvir-list>

=head1 LICENSE

Copyright (C) 2009 Daniel P. Berrange
Copyright (C) 2009 Red Hat, Inc.

C<libvirt-tck> is distributed under the terms of the GNU GPL v2+. This
is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR  A  PARTICULAR
PURPOSE.

=head1 SEE ALSO

C<prove>. If you need more fine grained control over running the tests,
then set the LIBVIRT_TCK_CONFIG environment variable to point to your
configuration file, and then run the C<prove> command passing in
the path to the test scripts to run.

