#!/usr/bin/perl
#
# Author: Petter Reinholdtsen <pere@hungry.com>
# Date:   2001-08-23
#
# # $Id: cdd-gen-control,v 1.5 2004/06/29 16:55:46 otavio Exp $
#
# Generate the control file used by the Debian Edu task package.

use warnings;
use strict;

use Getopt::Std;
use File::Path;

use vars qw(%opts %available %excluded %included @wanted %missing
	    @tasks $debug);
my @arch = qw(alpha arm i386 ia64 m68k mips mipsel powerpc s390 sparc hppa);

$debug = 0;

my %taskinfo = ();

my $aptsources = "/etc/cdd/sources.list";
my $tmpaptsources = "" ;

getopts("cdaemis:", \%opts);

$tmpaptsources = $opts{'s'} if ($opts{'s'});

if ( -s $tmpaptsources ) {
    $aptsources = $tmpaptsources;
} else {
    if ( -s $aptsources.".".$tmpaptsources ) {
        $aptsources .= ".".$tmpaptsources ;
    }
}

$debug = 1 if ($opts{'d'});

load_available_packages();

load_tasks();

if ($opts{'c'}) {
    gen_control();
} else {
    if ($opts{'e'}) {
	print_excluded_packages();
    } elsif ($opts{'a'}) {
	print_all_packages();
    } else {
	print_available_packages();
    }
}
print_missing_packages() if ($opts{'m'});

sub apt {
    my $op = shift;

    my $aptdir  = "/tmp/cdd-apt";
    my @aptopts = ("Dir::Etc::sourcelist=$aptsources",
		   "Dir::State=$aptdir/state",
		   "Dir::Cache=$aptdir/cache",
		   "Dir::State::Status=/dev/null",
		   "Debug::NoLocking=true");

    # Stupid apt-get and apt-cache do not understand the same arguments!
    # I have to map them to different formats to get both working.

    if ("update" eq $op) {
	mkpath "$aptdir/state/lists/partial";
	mkpath "$aptdir/cache/archives/partial";

	my $aptget   = "apt-get --assume-yes -o " . join(" -o ", @aptopts);

	print STDERR "aptget: $aptget\n" if $debug;
	system("$aptget update 1>&2");
    } elsif ("apt-cache" eq "$op") {
	my $aptcache = "apt-cache -o=" . join(" -o=", @aptopts);
	print STDERR "aptcache: $aptcache\n" if $debug;
	return $aptcache;
    }
}

sub gen_control {
    my $task;

    for $task (sort keys %taskinfo) {
	print "Package: $task\n";
	my $header;
	for $header (qw(Section Architecture Priority)) {
	    print "$header: $taskinfo{$task}{$header}\n"
		if (defined $taskinfo{$task}{$header});
	}

	for $header (qw(Pre-Depends Depends Suggests Recommends)) {
	    print "$header: ", join(", ", sort @{$taskinfo{$task}{$header}}),"\n"
		if (defined $taskinfo{$task}{$header});
	}

	# Description Description-long
	print "Description: $taskinfo{$task}{Description}\n";
	print "$taskinfo{$task}{'Description-long'}"; # Already contain newline

	print "\n";
    }
}

#
# Check the APT cache, and find the packages currently available.
#
sub load_available_packages
{
    apt("update");
    my $aptcache = apt("apt-cache");
    open(APT, "$aptcache dump |") || die "Unable to start apt-cache";
    my $pkg;
    while (<APT>) {
	chomp;
	if (/^Package: (.+)$/) {
	    $pkg = $1;
	    print STDERR "Found pkg '$pkg'\n" if $debug;
	}
	if (/^\s+Version:\s+(.+)/) {
	    print STDERR " pkg $pkg = ver $1\n" if $debug;
#	    print "C: $pkg $available{$pkg} lt $1\n" if ( exists $available{$pkg});
	    $available{$pkg} = $1 if ( ! exists $available{$pkg} ||
				       $available{$pkg} lt $1 );
	}
    }
}

#
# Load all tasks
#
sub load_tasks {
    my $taskfile;
    my $prefix = "test-" ;

    unless  ( -d "debian" ) {
        system ( "mkdir debian" ) ;
    }

    unless ( open(CTRL, ">debian/control" ) ) { die "Unable to open debian/control\n" ; }
    select CTRL;
    unless ( open(STUB, "debian/control.stub" ) ) {
        print STDERR "No template debian/control.stub.  Use test prefix.\n" ;
    } else {
        while ( <STUB> ) {
            if ( /^Package: (.+)$/) {
                $prefix = $1."-";
		last ;
            } else {
                print ;
            }
        }
	close(STUB) ;
    }
    
    # if there is a file common/control append this to control file
    if ( -s "common/control" && open(COMMON, "common/control") ) {
        while ( <COMMON> ) { print ; }
	close(COMMON);
    }
    
    # First document their existence, so they can depend on each other.
    for $taskfile (<tasks/*>) {
	next if ("tasks/CVS" eq $taskfile);
	if ("tasks/common" eq $taskfile) { die "You cannot use 'common' as task name"; }
	next if ($taskfile =~ m/~$/);

	my $curpkg = $taskfile;
	$curpkg =~ s%tasks/%$prefix%;
	$available{$curpkg} = "n/a";

	push(@tasks, "$taskfile:$curpkg");
    }

    # Next, load their content.
    my $foo;
    for $foo (@tasks) {
	my ($taskfile, $curpkg) = $foo =~ m/^(.+):(.+)$/;
	next if ("tasks/CVS" eq $taskfile);
	
	load_task($taskfile, $curpkg);
    }
}

sub process_pkglist {
    my $pkgstring = shift;
    my @pkglist = ();
    my @missinglist = ();
    my $packages;
    for $packages (split(/\s*,\s*/, $pkgstring)) {
	print "E: double comma?: $_\n" if ($packages =~ /^\s*$/ && $debug);
	my $package;
	for $package (split(/\s*\|\s*/, $packages)) {
	    print STDERR "Loading pkg '$package'\n" if $debug;
	    if ($package =~ /^-(.+)$/) {
		$excluded{$1} = 1;
	    } elsif ( !exists $available{$package} ) {
		if ( !exists $missing{$package}) {
		    $missing{$package} = 1;
		}
		push(@missinglist, $package);
	    } elsif ( ! $included{$package} ) {
		push(@pkglist, $package);

		push(@wanted, $package);
		$included{$package} = 1;
	    } else {
		push(@pkglist, $package);
		# already included, no need to add it to the wanted list again
	    }
	}
    }
    return (\@pkglist, \@missinglist);
}

sub load_task {
    my ($taskfile, $curpkg) = @_;
    open(TASKFILE, "<$taskfile") || die "Unable to open $taskfile";
    my $line;

    $taskinfo{$curpkg} = ();

    print STDERR "Loading task $curpkg\n" if $debug;

    while (<TASKFILE>) {
	chomp;
	next if (m/^\#/); # Skip comments
	$line = $_;

	# Append multi-line
	while ($line =~ /\\$/) {
	    $line =~ s/\s*\\//;
	    $_ = <TASKFILE>;
	    chomp;
	    $line .= $_;
	}
	# Remove trailing space
	$line =~ s/\s+$//;

	$_ = $line;
	$taskinfo{$curpkg}{'Section'}      = $1 if (m/^Section:\s+(.+)$/);
	$taskinfo{$curpkg}{'Architecture'} = $1 if (m/^Architecture:\s+(.+)$/);

	$taskinfo{$curpkg}{'Priority'}     = $1 if (m/^Priority:\s+(.+)$/);

	if (m/^Description:\s+(.+)$/) {
	    $taskinfo{$curpkg}{'Description'} = $1;
	    $taskinfo{$curpkg}{'Description-long'} = "";
	    while (<TASKFILE>) {
		# End of description, pass next line to pattern matching
		last if (m/^\S+/ || m/^\s*$/);

		$taskinfo{$curpkg}{'Description-long'} .= $_;
	    }
	}

	next unless defined $_;

	my $header;
	for $header (qw(Pre-Depends Depends Suggests Recommends)) {
	    if (m/^$header:\s+(.+)$/ && $1 !~ /^\s*$/) {
		$taskinfo{$curpkg}{$header} = ()
		    if (! exists $taskinfo{$curpkg}{$header});
		my ($pkglist, $missinglist) = process_pkglist($1);
		push(@{$taskinfo{$curpkg}{$header}}, @{$pkglist});

		# Avoid missing packages in Depends lists, allow them
		# in the two others.  Insert missing depends in
		# suggests list.
		if (@{$missinglist}) {
		    if ("Depends" eq $header) {
			push(@{$taskinfo{$curpkg}{'Suggests'}}, @{$missinglist});
		    } else {
			push(@{$taskinfo{$curpkg}{$header}}, @{$missinglist});
		    }
		}
	    }
	}

	if (/^Avoid:\s+(.+)$/) {
	    my @pkgs = split(/\s*,\s*/, $1);
	    my $packages;
	    for $packages (@pkgs) {
	        my $package;
	    	for $package (split(/\s*\|\s*/, $packages)) {
		    $excluded{$package} = 1;
		}
	    }
	}

	if (/^Ignore:\s+(.+)$/) {
	    my @pkgs = split(/\s*,\s*/, $1);
	    my $packages;
	    for $packages (@pkgs) {
	        my $package;
	    	for $package (split(/\s*\|\s*/, $packages)) {
		    # Remove explanations, ie the paranteses at the end.
		    $package =~ s/\s*\([^\)]*\)\s*$//;
		    $missing{$package} = 1;
		}
	    }
	}
    }
    close(TASKFILE);
}

sub print_excluded_packages {
    print join("\n", sort keys %excluded),"\n";
}

sub print_available_packages {
    print join("\n", @wanted),"\n";
}

sub print_all_packages {
    print STDERR "Printing all packages\n" if $debug;
    print join("\n", @wanted, keys %missing),"\n";
}

sub print_missing_packages {
    if (%missing) {
	print STDERR "Missing or avoided packages:\n";
	my $package;
	for $package (sort keys %missing) {
	    if (exists $available{$package}) {
	        print STDERR "  $package (v$available{$package} available)\n";
	    } else {
	        print STDERR "  $package\n";
	    }
	}
	exit 1 unless $opts{'i'};
    }
}