#!/usr/bin/perl
#
# Look at what wrappers are needed, get rid of ones that arn't needed any more,
# and generate those that do not already exit.

# Configuration section
$histfile='/var/lib/xaw-wrappers/update-wrappers-history';
$wrapperfile='/usr/share/xaw-wrappers/wrapper';
BEGIN { unshift @INC, "/usr/share/xaw-wrappers/" }

# Print out the text if verbose.
sub Log {
	print shift if $verbose;
}

# Purge a wrapper from the system.
sub RemoveWrapper { my $fn=shift; my $linkname=shift;
	if (-l $fn && unlink ($fn) eq 0) {
		print "\t$fn: symlink unlink failed: $!\n";
		$errorexit=1;
		return;
	}

	my $ret=system "/usr/sbin/update-alternatives","--quiet","--remove",
		$linkname,$wrapperfile;
	if (int($ret/256) ne 0) {
		print "\t$fn: update-alternatives failed\n";
		$errorexit=1;
		return;
	}
	
	my $ret=system "/usr/sbin/update-alternatives","--quiet","--auto",
		$linkname;
	if (int($ret/256) ne 0) {
		print "\t$fn: update-alternatives failed\n";
		$errorexit=1;
		return
	}

	Log "\t$fn\n";
}

# Add a wrapper to the system, and set up alternatives.
sub AddWrapper { my $fn=shift; my $linkname=shift;
	if (-f $fn) {
		# See changelog for 0.92 for an explination of when this
		# can happen.
		unlink $fn || die "$fn exists and I cannot remove it: $!";
	}
	
	my $ret=system "/usr/sbin/update-alternatives","--quiet","--install",
		$fn,$linkname,$wrapperfile,50;
	if (int($ret/256) ne 0) {	
		print "\t$fn: update-alternatives failed\n";
		$errorexit=1;
		return;
	}

	if (!-e $fn and ! -l $fn)  {
		my $ret=system "/usr/sbin/update-alternatives",
			"--auto",$linkname;
		if (int($ret/256) ne 0) {
			print "\t$fn: update-alternatives failed\n";
			$errorexit=1;
			return;
		}
	}
	elsif (!-l $fn) {
		print "\t$fn: unable to symlink\n";
		$errorexit=1;
		return;
	}

	Log "\t$fn\n";
}

# Parse parameters.
use Getopt::Long;
$ret=&GetOptions(
	"help|h", \$help,
	"verbose|v", \$verbose,
	"force|f", \$force,
	"off|o", \$off,
);

# Usage help.
if ($help) {
	print <<eof;
update-xaw-wrappers sets up wrapper scripts around programs that do not
work well with some xaw replacement libraries.

Usage: update-xaw-wrappers [options ...]
  -h, --help      Display this help text
  -v, --verbose   Be verbose about what changes are being made
  -f, --force     Force removal and reset up all wrappers
  -o, --off       Only remove existing wrappers, do not add new
eof
	exit;
}

# Make sure I have root privs.
if ($> ne 0) {
  print STDERR "$0 must be run as root.\n";
  exit 1;
}

# Loading this package causes all config files to be read.
use XawWrapper;
Log "Updating xaw wrappers..\n";

# Load up the list of what wrappers existed when this was run last, and
# if any of those are not needed, get rid of them.
Log "Removing wrappers:\n";
open (HISTORY,"<$histfile");
while (<HISTORY>) {
	chomp;
	$linkname=<HISTORY>;
	chomp $linkname;
	if ($force || !defined($XawWrapper::incompat{$_})) {
		RemoveWrapper($_,$linkname);
	}
}
close HISTORY;

# Create new wrappers, and write out the history file.
if (!$off) {
	Log "Adding wrappers:\n";
	open (HISTORY,">$histfile") || die "open $histfile: $!\n";
	foreach $fn (keys(%XawWrapper::incompat)) {
		print HISTORY "$XawWrapper::program{$fn}\n";
		print HISTORY "$fn\n";
		AddWrapper($XawWrapper::program{$fn},$fn);
	}
	close HISTORY;
}

exit $errorexit if $errorexit;
