#!/usr/bin/perl -w

# Copyright (C) 2008 Ralf Treinen <treinen@debian.org>
# 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, version 2 of the License.

$debug=0;

# the prefix used to encode source packages
$sourceprefix="source---";

$architecture="";
$binexplain=0;
$edosoptions = "-failures -explain";
while ( $arg = shift @ARGV ) {
    if ( $arg eq '-a' || $arg eq '--architecture' ) {
	if ($#ARGV == -1) {
	    die "-a option needs a value";
	} else {
	    $architecture = shift @ARGV;
	}
    } elsif ( $arg =~ "--binexplain" || $arg =~ "-be" ) {
	$binexplain = 1;
    } elsif ( $arg =~ /^-.*/ ) {
	die "unrecognized option: $arg";
    } else {
	last;
    }
}

if ($#ARGV != 0) {
    die "Usage: edos-debbuildcheck [options] Packages Sources"
} else {
    $packagefile = $arg;
    $sourcesfile = shift(@ARGV);
}

if ($debug) {
    print "Arch: $architecture\n";
    print "Packages: $packagefile\n";
    print "Sources:  $sourcesfile\n";
    print "Edos options: $edosoptions\n";
}

$packagearch="";
open(P,$packagefile);
while (<P>) {
    next unless /^Architecture/;
    next if /^Architecture:\s*all/;
    /Architecture:\s*([^\s]*)/;
    if ($packagearch eq "") {
	$packagearch = $1;
    } elsif ( $packagearch ne $1) {
	die "Package file contains different architectures: $packagearch, $1";
    }
}
close P;

if ( $architecture eq "" ) {
    if ( $packagearch eq "" ) {
	die "No architecture option given, " .
	    "and no non-all architecture found in the Packages file";
    } else {
	$architecture = $packagearch;
    }
} else {
    if ( $packagearch ne "" & $architecture ne $packagearch) {
	die "Architecture option is $architecture ".
	    "but the package file contains architecture $packagearch";
    }
}

open(RESULT,"add-sources.py ".
     "--prefix \"$sourceprefix\" < $packagefile $sourcesfile $architecture ".
     "| edos-debcheck $edosoptions|");

$sourcestanza=0;
$explanation="";
$binpackage="";

while (<RESULT>) {
    if (/^The following constraints cannot be satisfied:/) {
    	next
    } elsif (/^\s+/) {
	if ($sourcestanza) {
	    s/^(\s*)$sourceprefix(.*)(depends on|conflicts with)/$1$2build-$3/o;
	    s/&gt;/>/;
	    s/&lt;/</;
	    print;
	    if (/depends on ([^\s]*) .*\{.*\}/) {
		push(@binqueue,$1);
	    }
	} else {
	    $explanation .= $_;
	}
    } else {
    	if ($sourcestanza) {
	    print "\n";
	    $sourcestanza=0;
	}
	if ($binpackage ne ""){
	    $binfailures{$binpackage} = $explanation;
	    $binpackage="";
	}
	if (/^$sourceprefix(.*) \(.*\): FAILED/o) {
	    print "Package: $1\n";
	    print "Failed-Why:\n";
	    $sourcestanza=1;
	} elsif (/^([^\s]*) .*: FAILED/) {
	    $binpackage=$1;
	    $explanation=$_;
	    $explanation.=<RESULT>;
	    $sourcestanza=0;
	} else {
	    # we have someting strange here
	    $sourcestanza=0;
	}
    }
}

close RESULT;

if ($binexplain) {
    while (@binqueue) {
	$p=pop(@binqueue);
	$v=$binfailures{$p};
	next unless defined $v;
	$binfailures{$p}="";
	print "$v" if $v ne "";
	if ($v=~/depends on ([^\s]*) .*\{.*\}/) {
	    push(@binqueue,$1);
	}
    }
}