#!/usr/bin/perl -w
#
# Reconfigure a package.
# This has the same effect as re-installing the package, basically. I hope
# one day this will be called by dpkg --reconfigure 
#
# Pass package name(s) to reconfigure on command line.

use strict;
use Debian::DebConf::ConfigDb;
use Debian::DebConf::Config;
use Debian::DebConf::AutoSelect;
use Debian::DebConf::Log ':all';

# See if they are root.
if ($> != 0) {
	warn "$0 must be run as root";
	exit 1;
}

my $infodir="/var/lib/dpkg/info";

# Parse command line if GetOpt::Long is available, else just throw out all
# options except --all.
my $all='';
eval qq{
	use Getopt::Long;
};
if ($@) {
	$all=1 if grep { $_ eq '--all' } @ARGV;
	@ARGV=grep { ! /^-/ } @ARGV;
}
else {
	eval q{
		Getopt::Long::config qw(bundling no_ignore_case permute);
		GetOptions(
			"all" => \$all,
			"frontend|f=s" => 
				sub { shift; Debian::DebConf::Config::frontend(shift) },
			"priority|p=s" =>
				sub { shift; Debian::DebConf::Config::priority(shift) },
		);
	};
	die $@ if $@;
}

# Load up previous state information.
Debian::DebConf::ConfigDb::loaddb(Debian::DebConf::Config::dbdir());

my $frontend=Debian::DebConf::AutoSelect::frontend();

# Make the frontend show questions even if the user has already seen them.
# Since this is a reconfigure program, they may want to change their choices.
Debian::DebConf::Config::showold('true');

TOP:
foreach my $pkg ($all ? allpackages() : @ARGV) {
	# If this doesn't exist, the package probably doesn't use debconf,
	# so skip it, becuase a normal package may misbehave when run here.
	if (! -x "/var/lib/dpkg/info/$pkg.config") {
		warn "package \"$pkg\" is not installed or does not use debconf";
		next;
	}

	# Set default title.
	$frontend->default_title($pkg);

	# Get the package version. Also check to make sure it is installed.
	$_=`dpkg --status $pkg`;
	my ($version)=m/Version: (.*)\n/;
	my ($status)=m/Status: (.*)\n/;
	if (! defined $status || $status !~ m/ ok installed$/) {
		warn "package \"$pkg\" is not fully installed";
		exit 1;
	}
	
	# Load up templates just in case they arn't already.
	Debian::DebConf::ConfigDb::loadtemplatefile("$infodir/$pkg.templates", $pkg)
		if -e "$infodir/$pkg.templates";

	# Run config and postinst scripts in sequence, with args.
	foreach my $info (['config',   'reconfigure', $version],
			  ['postinst', 'configure',   $version]) {
		my $script=shift @$info;
		next unless -x "$infodir/$pkg.$script";
		# Test to see if the script uses debconf.
		my $is_confmodule='';
		open (IN, "<$infodir/$pkg.$script");
		while (<IN>) {
			if (/confmodule/i) {
				$is_confmodule=1;
				last;
			}
		}
		close IN;

		if ($is_confmodule) {
			# Start up the confmodule.
			my $confmodule=Debian::DebConf::AutoSelect::confmodule(
				"$infodir/$pkg.$script", @$info);
	
			# Make sure any questions the confmodule registers are owned
			# by this package.
			$confmodule->owner($pkg);
		
			# Talk to it until it is done.
			1 while ($confmodule->communicate);
	
			exit $confmodule->exitcode if $confmodule->exitcode > 0;
		}
		else {
			# Not a confmodule, so run it as a normal script.
			# Since it might run other programs that do use
			# debconf, checkpoint the current database state
			# and re-initialize it when the script finishes.
			Debian::DebConf::ConfigDb::savedb(Debian::DebConf::Config::dbdir());
			
			$ENV{DEBIAN_HAS_FRONTEND}='';
			my $ret=system("$infodir/$pkg.$script", @$info);
			if (int($ret / 256) != 0) {
				exit int($ret / 256);
			}
			$ENV{DEBIAN_HAS_FRONTEND}=1;
			
			Debian::DebConf::ConfigDb::loaddb(Debian::DebConf::Config::dbdir());
			Debian::DebConf::Config::showold('true');
		}
	}
}

# Save state.
Debian::DebConf::ConfigDb::savedb(Debian::DebConf::Config::dbdir());

# Returns a list of all installed packages.
sub allpackages {
	my @ret;
	local $/="\n\n";
	
	open (STATUS, "</var/lib/dpkg/status")
		|| die "Cannot read status file: $!";
	while (<STATUS>) {
		push @ret, $1
			if m/Status:\s*.*installed\n/ && m/Package:\s*(.*)\n/;
	}
	close STATUS;

	return sort @ret;
}
