#!/usr/bin/perl
# This program is written in perl mainly for ease of writing a parser for
# the task list. It is copyright 2001 under the terms of the GPL by 
# Joey Hess <joeyh@debian.org>.
#
# Warning: this program is incompatable with the dialog frontend of debconf
#          versions prior to 0.9.53!
#
# TODO: i18n

use strict;
use warnings;
use Debconf::Client::ConfModule ':all';

# Argument processing.
my $test=my $queue=0;
if ($ARGV[0] eq '-t') {
	$test=1;
	shift;
}
elsif ($ARGV[0] eq '-q') {
	$queue=1;
	shift;
}
elsif ($ARGV[0] =~ /^-/) {
	die "Usage: $0 [-t|-q]\n";
}
my @tasks=ordertasks(readtasks(shift || "/usr/share/tasksel/tasklist"));

# Have debconf show the list, and get back the selected items.
version('2.0');
capb('backup');
title('Selecting software to install');
my @ret=subst('tasksel/tasklist', 'choices', genchoices(@tasks));
die "debconf error" if $ret[0] != 0; # if that failed, the templates are probably broken..
fset('tasksel/tasklist', 'seen', 'false'); # always re-show
input('critical', 'tasksel/tasklist');
@ret=go();
if ($ret[0] == 30) {
	# Back button pressed, so just exit.
	exit 30;
}
@ret=get('tasksel/tasklist');

# Now handle whatever was selected.
handle(seltasks($ret[1], @tasks));

# Depending on the command line arguments, handles a set of tasks in
# various ways (installs them, enqueues them, or just outputs a list of
# packages)
sub handle {
	my @tasks=@_;
	
	if ($test) {
		print STDERR dpkgsel(@tasks);
	}
	else {
		open (DPKG, "| dpkg --set-selections") or die "dpkg failed $!";
		print DPKG dpkgsel(@tasks);
		close DPKG or die "dpkg failed $!";
		unless ($queue) {
			# TODO
			die "apt run not implemented. Should be trivial though..";
		}
	}
}

# Pass a list of task structures, and a string will be returned. The string
# is suitable to be passed to dpkg --set-selections to let dselect and apt
# know that all packages listed in the tasks should be installed.
sub dpkgsel {
	my $ret='';
	foreach my $task (@_) {
		foreach (@{$task->{packages}}) {
			$ret.="$_\tinstall\n";
		}
	}
	return $ret;
}

# Pass a list of task structures, and a string will be returned, suitable
# for use in a debconf Choices: field. The list is assumed to be ordered
# by group, and each new group is used as a heading, with the things
# in the group listed underneath it.
sub genchoices {
	my $curgroup='';
	my @ret;
	foreach (@_) {
		if ($curgroup ne $_->{group}) {
			# There's no really good way to make a subsection
			# heading in a debconf multiselect widget. So I
			# resort to typograhpical tricks..
			push @ret, ucfirst($_->{group}).":";
			$curgroup=$_->{group};
		}
		# Again, a typographical trick to make it look like its is
		# indented.
		push @ret, "- ".$_->{description};
	}
	return join ", ", @ret;
}

# The complement to genchoices, this function takes a single string
# representing a list of choices (in the same form produced by genchoices,
# or the form prodiced by debconf as the value of a multiselect question),
# and a list of task structures. It parses the string, determines which
# tasks in the list of task structures match things in the string (if a
# section is listed in the string, all tasks in that section are selected),
# and returns the appropriate task structures.
sub seltasks {
	my $selections=shift;
	my @tasks=@_;
	my %taskdesc=map { $_->{description} => $_ } @tasks;
	
	my @ret;
	my %seen; # used to prevent dups
	foreach my $item (split /, /, $selections) {
		if ($item =~ /^(.*):$/) {
			# Select whole group.
			my $group=lcfirst($1);
			foreach (grep { $_->{group} eq $group } @tasks) {
				unless ($seen{$_}) {
					push @ret, $_;
					$seen{$_}=1;
				}
			}
		}
		else {
			$item =~ s/- //; # kill ascii art
			if (exists $taskdesc{$item}) {
				push @ret, $taskdesc{$item}
					unless $seen{$taskdesc{$item}};
				$seen{$taskdesc{$item}}=1;
			}
			else {
				warn "could not find task with description '$item'";
			}
		}
	}
	return @ret;
}

# Pass a list of task structures, and an ordered list will be returned. The
# sorting is done based on groups tasks are in , with a secondary ordering by
# task descriptions. (Maybe it would be better to do the secondary sort on
# some other field? We'd like a way to make the web server be at the top of
# the servers group, for example.)
sub ordertasks {
	sort { $a->{group} cmp $b->{group} || 
	       $a->{description} cmp $b->{description} } @_;
}

# Read and parse a task list file. Pass the filename, returns a list of
# task structures.
sub readtasks {
	my $file=shift;
	
	my @tasks;
	
	open (TASKLIST, $file) or die "Cannot read tasklist ($file): $!";
	my %field;
	my $save_stanza=sub { # closure
		# Ignore empty stanzas, but save the rest.
		if (%field) {
			unless (exists $field{description} and
			        exists $field{packages}) {
				die "incomplete stanza";
			}
			unless (exists $field{group}) {
				$field{group}="misc";
			}
			push @tasks, {%field};
			%field=();
		}
	};
	while (<TASKLIST>) {
		chomp;
		next if /^\s*#.*/; # Ignore comments
	
		# Blank lines begin a new stanza.
		if (/^\s*$/) {
			$save_stanza->();
		}
		# Parse out key and values.
		else {
			my ($key, $value)=split /:\s+/;
			if (! defined $key or ! length $key) {
				die "key/value parse error";
			}
			$key=lc($key);
			if ($key eq 'packages') {
				# Split up packages list.
				$field{$key}=[split /,\s+/, $value];
			}
			else {
				$field{$key}=$value;
			}
		}
	}
	$save_stanza->();
	close TASKLIST;
	return @tasks;
}
