#!/usr/bin/perl -w

# Copyright (C) 1998 Richard Braakman
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.

use strict;

sub usage {
    print <<END;
Usage: $0 [-k] [-v] [-d] testset-directory testing-directory [test]

The -k option means do not stop after one failed test, but try
them all and report all errors.

The -v option will also display those tests that have a description, but are
not tested in any testset-package.

The -d option will display debugging information.

The optional 3rd parameter causes runtests to only run that particular test.
END
    exit 2;
}

# for debugging:
my $debug = 0;

# Tests layout:
# Every test package is in a directory pkgname-version in the testset
# directory.  The lintian output that is expected for each package is
# in a file tags.pkgname in the testset directory.

# Running the tests:
# Each test package is copied to a subdirectory of the testing-directory,
# and built there.  Then lintian is run over the resulting .changes file,
# with its output redirected to tags.pkgname in the testing-directory.

# If the tags output is not identical to the tags.pkgname file in the
# testset-directory, then runtests will output the diff and exit with
# a failure code.

# The build output is directed to build.pkgname in the testing-directory.

# Exit codes:
# 0 - success
# 1 - one or more tests failed
# 2 - an error prevented proper running of the tests

# Turns out I might as well have written this in bash.  Oh well.

my $run_all_tests = 0;
my $verbose = 0;

# --- Parse options, such as they are.
while ($#ARGV >= 0 && $ARGV[0] =~ m/^-/) {
    if ($ARGV[0] eq '-k') {
        $run_all_tests = 1;
    } elsif ($ARGV[0] eq '-v') {
        $verbose = 1;
    } elsif ($ARGV[0] eq '-d') {
        $debug = 1;
    } else {
        usage;
    }
    shift;
}

# --- Parse directory arguments
if ($#ARGV < 1 || $#ARGV > 2) {
    usage;
}

my $testset = shift;
my $rundir = shift;
my $singletest;
if ($#ARGV == 0) {
    $singletest = shift;
}

# --- Set and unset environment variables that lintian is sensitive to
BEGIN {
    my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
    if (not $LINTIAN_ROOT) {
        use Cwd ();
        $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT = Cwd::cwd();
    }
    delete $ENV{'LINTIAN_CFG'};
    delete $ENV{'LINTIAN_LAB'};
    delete $ENV{'LINTIAN_DIST'};
    delete $ENV{'LINTIAN_UNPACK_LEVEL'};
    $ENV{'LC_COLLATE'} = 'C';

    # Set standard umask because many of the test packages rely on this
    # when creating files from the debian/rules script.
    umask(022);
}

my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};

use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Profile;
use Util;

# --- Set the ways to call lintian and dpkg-buildpackage
my $lintian_options = '-I -E';
my $lintian_info_options = '-I -E -i';
my $dpkg_buildpackage_options = '-rfakeroot -us -uc -d -iNEVER_MATCH_ANYTHING'
    . ' -INEVER_MATCH_ANYTHING';
my $lintian_path = $LINTIAN_ROOT . "/frontend/lintian";

my $testok = 0;
my %tags;

# --- Display output immediately
$| = 1;

# --- Let's play.

-d $rundir
    or fail("test directory $rundir does not exist\n");

$testok = 1;

my $profile = Lintian::Profile->new ('debian/main', $ENV{'LINTIAN_ROOT'},
                                     ["$ENV{'LINTIAN_ROOT'}/profiles"]);

# force all checks to be loaded - not the best solution
# - At the time of writing it is not needed for 'debian/main', but
#   that may change...
$profile->_load_checks();

for my $tag ($profile->tags (1)){
    my $ti = $profile->get_tag ($tag, 1);
    my $code = $ti->code;
    $code = 'X' if $ti->experimental;
    $tags{$tag}{'desc_file'} = $ti->script .'.desc';
    $tags{$tag}{'desc_type'} = $code;
}

undef $profile; # Don't need it any more.

if ($testok) {
    print "done.\n";
} else {
    print "FAILED!\n";
    exit 1 unless $run_all_tests;
}

# ok, I can make a static lab, now let's test the package checks
# in temporary labs
my @tests;
if ($singletest) {
    @tests = ( $singletest );
} else {
        opendir(TESTDIR, $testset)
                or fail("cannot open $testset: $!\n");

        @tests = sort(readdir(TESTDIR));

        closedir(TESTDIR);
}

my $tests_run = 0;
for (@tests) {
    next if $_ eq '.' or $_ eq '..' or $_ eq 'CVS' or $_ eq '.svn';
    next unless -d "$testset/$_";

    my $pkgdir = $_;

    open(CHANGELOG, "$testset/$pkgdir/debian/changelog") or
         die("Could not open $testset/$pkgdir/debian/changelog");
    my $line = <CHANGELOG>;
    chomp($line);
    close(CHANGELOG);
    $line =~ s/^.*\(//;
    $line =~ s/\).*$//;

    my ($pkg, $ver) = ($pkgdir, $line);
    $ver =~ s/(^|-)\d+:/$1/;
    print "Running test on $pkg $ver: copying... ";

    print "Cleaning up and repopulating $rundir/$pkgdir...\n" if $debug;
    runsystem_ok("rm -rf $rundir/$pkgdir");
    runsystem("cp -rp $testset/$pkgdir $rundir");
    opendir D, "$testset" or die;
    foreach (readdir D) {
      next unless /^\Q${pkg}\E_.*\.orig\.tar\.gz$/;
      print "Symlinking $_ in $rundir...\n" if $debug;
      symlink $ENV{'PWD'}."/$testset/$_", "$rundir/$_";
    }
    closedir D;
    runsystem("find $rundir -name CVS -o -name .svn -print0 | xargs -0r rm -R");

    print "building... ";
    print "Running dpkg-buildpackage $dpkg_buildpackage_options in $rundir/$pkgdir...\n" if $debug;
    runsystem("cd $rundir/$pkgdir && dpkg-buildpackage $dpkg_buildpackage_options >../build.$pkg 2>&1");

    print "testing... ";
    print "Running lintian --allow-root --no-cfg $lintian_options on $rundir/$pkg\_$ver*.changes...\n" if $debug;
    runsystem_ok("$lintian_path --allow-root --no-cfg $lintian_options $rundir/$pkg\_$ver*.changes".
        " 2>&1 | sort > $rundir/tags.$pkg");

    # Run a sed-script if it exists, for tests that have slightly variable
    # output
    runsystem_ok("sed -i -f $testset/tags.$pkg.sed $rundir/tags.$pkg")
        if -e "$testset/tags.$pkg.sed";

    $testok = runsystem_ok("cmp -s $rundir/tags.$pkg $testset/tags.$pkg");
    $tests_run++;
    if ($testok) {
        print "done.\n";
    } else {
        print "FAILED:\n";
        runsystem_ok("diff -u $testset/tags.$pkg $rundir/tags.$pkg");
        exit 1 unless $run_all_tests;
        next;
    }

    open TAGS, "$rundir/tags.$pkg" or fail("Cannot open $rundir/tags.$pkg");
    while (<TAGS>) {
        next if m/^N: /;
        if (not /^(.): (\S+)(?: (?:source|udeb|changes))?: (\S+)/) {
            print "E: Invalid line:\n$_";
            next;
        }
        $tags{$3}{'tested_type'} = $1;
        $tags{$3}{'tested_package'} = $2;
    }
    close TAGS;
}

if (!$tests_run) {
    if ($singletest) {
        print "W: No tests run, did you specify a valid test name?\n";
    } else {
        print "E: No tests run, did you specify a valid testset directory?\n";
    }
}

print "Checking whether all tags are tested and tags have description ... \n";
$testok = 1;
for (keys %tags) {
    my $values = $tags{$_};
    if (not defined $values->{'desc_type'}) {
        print "E: tag-has-no-description $_ in $values->{'tested_package'}\n";
        $testok = 0;
    } elsif (not defined $values->{'tested_type'}) {
        print "I: tag-is-not-tested $_ in $values->{'desc_file'}\n"
            if $verbose;
    } elsif ($values->{'desc_type'} ne $values->{'tested_type'}) {
        print "E: tag-has-inconsistent-type $_ $values->{'tested_type'} vs ".
            "$values->{'desc_type'}\n";
        $testok = 0;
    }
}

if ($testok) {
    print "done.\n";
} else {
    print "FAILED\n";
    exit 1 unless $run_all_tests;
}

# --------------
sub runsystem {
    system(@_) == 0
        or fail("failed: @_\n");
}

sub runsystem_ok {
    my $errcode = system(@_);
    $errcode == 0 or $errcode == (1 << 8)
        or fail("failed: @_\n");
    return $errcode == 0;
}

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et