#!/usr/bin/perl
#
# Author: Petter Reinholdtsen <pere@hungry.com>
# Date:   2001-08-23
#
# 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);

my $debug = 0;
my $nodepends = 0;
my $ignoreapterrors = 0;

my %taskinfo = ();

my $aptsources = "./sources.list.sarge";

sub usage() {
    print STDERR << "EOF";
gen-control help screen
usage: $0 [options]

   -a               : print wanted packages
   -A               : ignore APT errors
   -c               : create new debian/control file
   -d               : print debug information
   -D               : lover all Depends: to Recommends:
   -e               : print excluded packages
   -h               : print this help screen and exit
   -i               : 
   -m               : print missing packages
   -s <sourcefile>  : specify which sources.list file to use
   -t               : print task descriptions and package list for task

example: $0 -s sources.list.etch -D -c -m -i
EOF
}

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

usage() and exit if $opts{'h'};

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

$debug = 1 if ($opts{'d'});
$nodepends = 1 if ($opts{'D'});
$ignoreapterrors = 1 if ($opts{'A'});

load_available_packages();

load_tasks();

# An ordered list of debian-edu tasks, in priority order of which are
# most needed on the CD. Only leaf tasks need be listed.
my @priorityorder =
    qw(education-common
       education-networked
       education-laptop
       education-main-server
       education-thin-client-server
       education-workstation
       education-standalone);

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

sub apt {
    my $op = shift;

    my $aptdir  = "./tmp/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;
	if (system("$aptget update 1>&2")) {
	    print STDERR "error: updating apt package lists failed\n";
	    exit 1 unless $ignoreapterrors;
	}
    } elsif ("apt-cache" eq "$op") {
	my $aptcache = "apt-cache -o=" . join(" -o=", @aptopts);
	print STDERR "aptcache: $aptcache\n" if $debug;
	return $aptcache;
    }
}

sub sort_uniq {
    my $seen = shift;
    my @list;
    for my $entry (sort @_) {
	push @list,$entry unless $seen->{$entry};
	$seen->{$entry} = 1;
    }
    return @list;
}

sub uniq {
    my $seen = shift;
    my @list;
    for my $entry (@_) {
	push @list,$entry unless $seen->{$entry};
	$seen->{$entry} = 1;
    }
    return @list;
}

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});
	}
	my %seenlist;
	if ($nodepends) {
		# degrade dependencies to recommends
		print "Depends: education-tasks\n";
		# Use common %seenlist, as it is no use listing
		# packages both in recommends and suggest
		my @list;
		for $header (qw(Depends Recommends)) {
		    push (@list, @{$taskinfo{$task}{$header}})
			if defined $taskinfo{$task}{$header};
		}
		my ($pkglist, $missinglist) = process_pkglist(join(",",@list));
		my (@recommends, @suggests);
		push @recommends, @{$pkglist};
		push @suggests, @{$missinglist};
#		push(@recommends, )
#		     if defined $taskinfo{$task}{Depends};
#		push(@recommends, )
#		    if defined $taskinfo{$task}{Recommends};
		push(@suggests, @{$taskinfo{$task}{Suggests}})
		    if defined $taskinfo{$task}{Suggests};
	    	print("Recommends: ",
		      join(", ", sort_uniq(\%seenlist, @recommends)),"\n")
			if defined $taskinfo{$task}{Depends};
	    	print("Suggests: ",
		      join(", ", sort_uniq(\%seenlist, @suggests)),"\n")
		    if @suggests;
	}
	else {
		for $header (qw(Depends Recommends Suggests)) {
		    print "$header: ", join(", ", sort_uniq(\%seenlist, @{$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";
    }
}

# List all depends, recommends and suggests packages as task packages.
# Optionally, list depends as key packages, and the rest as task
# packages.
# Enable to list all dependencies as key packages
my $task_depends_are_keys = 0;
sub print_task_desc {
	foreach my $task (sort keys %taskinfo) {
		next if (exists $taskinfo{$task}{'Leaf'} &&
			$taskinfo{$task}{'Leaf'} eq 'false');
		
		print "Task: $task\n";
		print "Section: debian-edu\n";
		print "Description: $taskinfo{$task}{Description}\n";
		print "$taskinfo{$task}{'Description-long'}"; # Already contain newline
		print "Relevance: 10\n";
		print "Key: \n";
		print " $task\n";
		my %seen;
		$seen{$task} = 1;
		if ($task_depends_are_keys) {
		    foreach my $package (task_packages($task, "Depends")) {
			print " $package\n" unless $seen{$package};
			$seen{$package} = 1;
		    }
		}
		print "Packages: list\n";
		for my $header (qw(Depends Recommends Suggests)) {
		    foreach my $package (task_packages($task, $header, 1)) {
			print " $package\n" unless $seen{$package};
			$seen{$package} = 1;
		    }
		}
		
		print "\n";
	}
}

sub select_alternative {
    my $pkglist = shift;
    return $pkglist;
}

sub task_packages {
	my ($task, $header, $includealldeps) = @_;
	my @packages = $task;
	foreach my $package (@{$taskinfo{$task}{$header}}) {
		if ($package=~/\|/) {
			# Tasksel doesn't allow boolean or-ing of
			# dependencies. Just take the first one that is
			# available.
			my $ok=0;
			foreach my $alternative (split(' | ', $package)) {
	    			if (! exists $taskinfo{$alternative} &&
				    ! exists $available{$alternative}) {
				    	if (! exists $missing{$alternative}) {
				    		$missing{$alternative} = 1;
				    	}
				}
				else {
					print STDERR "task_packages: choosing $alternative from $package\n" if $debug;
					$package=$alternative;
					$ok=1;
					last;
				}
			}
			if (! $ok) {
				next;
			}
		}
		if (exists $taskinfo{$package}) {
			# Add packages from task recursively, since
			# tasksel does not support dependent tasks of
			# the type used by debian-edu
			if (defined $includealldeps && $includealldeps) {
				for my $h (qw(Depends Suggests Recommends)) {
			    
					push(@packages, $package,
					     task_packages($package, $h));
			    }
			} else {
				push(@packages, $package,
				     task_packages($package, $header));
			}
		}
		else {
			push @packages, $package;
		}
	}
	return @packages;
}

#
# 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;

    # First document their existence, so they can depend on each other.
    for $taskfile (<tasks/*>) {
	next if (($taskfile eq "tasks/CVS") || ($taskfile eq "tasks/.svn"));
	next if ($taskfile =~ m/~$/);

	my $curpkg = $taskfile;
	$curpkg =~ s%tasks/%education-%;
	$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;
	my @alternates=split(/\s*\|\s*/, $packages);
	my $alternatecount=0;
	for $package (@alternates) {
	    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);
	    } else {
		if ($alternatecount == 0) {
		    #push(@pkglist, $package) if (! exists $pkglist[$package]);
		    push(@pkglist, $package); 
		}
		else {
		    $pkglist[-1].=" | $package";
		}
		$alternatecount++;

	        if ( ! $included{$package} ) {
		    push(@wanted, $package);
		    $included{$package} = 1;
		}
	    }
	}
    }
    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+(.+)$/);
	
	$taskinfo{$curpkg}{'Leaf'}         = $1 if (m/^Leaf:\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(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_pkgs_tasks {
    my ($seenref, @tasks) = @_;

    for my $header (qw(Depends Recommends Suggests)) {
	print STDERR "  Processing $header\n" if $debug;
	my %seentask;
	for my $task (@tasks) {
	    print STDERR "   Printing $task\n" if $debug;
	    next if $seentask{$task};
	    $seentask{$task} = 1;

	    # Pick the first available if there are alternatives
	    my @pkgs = uniq($seenref, task_packages($task, $header), $task);
	    print join("\n", @pkgs), "\n" if @pkgs;
	}
    }
}

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

    # First process the high priority tasks
    my %seenlist;
    print_all_pkgs_tasks(\%seenlist, @priorityorder);

    # Next process all the others, in alphabetic order
    print_all_pkgs_tasks(\%seenlist, sort keys %taskinfo);

    # And last, the alternatives we dropped above
    print join("\n", uniq(\%seenlist, @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'};
    }
}