#! /usr/bin/perl
###############################################################################
#
#  Update-MIME:  Install programs into "/etc/mailcap", resolve conflicts,
#				 auto-uninstall, make dinner, and wash dishes.
#
#  Written by Brian White <bcwhite@pobox.com>.
#
#  This program has been placed in the public domain (the only true "free").
#  Do whatever you wish with it, though I'd appreciate it if my name stayed
#  on it as the original author.
#
###############################################################################



#
# Program Constants
#
$debug		= 0;
$mailcap	= "/etc/mailcap";
$mimedir	= "/usr/lib/mime/packages";
$orderfile	= "/etc/mailcap.order";
$defpriority= 5;

#$mailcap	= "/home/bcwhite/tmp/mailcap";
#$mimedir	= "/home/bcwhite/tmp/mime";
#$orderfile	= "/home/bcwhite/tmp/mime.order";



#
# Global Variables
#
%entries;
%packages;
%priorities;
@order;



sub ReadEntries
{
	my($package,$priority,$counter);

	$counter=1;

	foreach $file (glob "$mimedir/*") {
		next if ($file =~ m/^\#|\~$/);
		($package) = ($file =~ m|/([^/]*)$|);
		print STDERR "$package:\n" if $debug;

		if (!defined $packages{$package}) {
			$packages{$package} = [];
		}

		if (open(FILE,"<$file")) {
			while (<FILE>) {
				chomp;
				next if m/^\s*$|^\s*\#/;
				if (m/priority\s*=\s*(\d+)\s*($|;)/i) {
					$priority=$1;
				} else {
					$priority=$defpriority;
				}
				if ($priority < 0 || $priority > 9) {
					print STDERR "Error: priority of $priority is out of range (0 <= pri <= 9)\n";
					print STDERR "       $_\n";
					$priority=$defpriority;
				}
				s/([^\s;]\s+)(?![\'\"])([^\s;]*)%s([^\s;]*)/$1'$2%s$3'/g;
				$entries{$counter} = $_;
				push @{$packages{$package}},$counter;
				push @{$priorities{$priority}},$counter;
				print STDERR "$counter: $_\n" if $debug;
				$counter++;
			}
			close(FILE);
		} else {
			print STDERR "Warning: could not open file '$file' -- $!\n";
		}
	}
}



sub ReadOrder
{
	if (-e $orderfile) {
		if (open(FILE,"<$orderfile")) {
			while (<FILE>) {
				chomp;
				s/\s*\#.*$//;
				next if m/^\s*$/;
				push @order,$_;
			}
			close(FILE);
		} else {
			print STDERR "Warning: could not open file '$orderfile' -- $!\n";
		}
	}
}



sub OrderEntries
{
	my(@entrylist,@orderlist,$priority,$entrycode,$ordercode);

	foreach $priority (sort {$b <=> $a} keys %priorities) {
		print STDERR " - Priority $priority:" if $debug;
		foreach $entry (@{$priorities{$priority}}) {
			print STDERR " $entry" if $debug;
			push @entrylist,$entry;
		}
		print STDERR "\n" if $debug;
	}

	print STDERR "entrylist: @entrylist\n" if $debug;
	foreach $ordercode (@order) {
		my($pkg,$typ);
		if ($ordercode =~ m/:/) {
			($pkg,$typ) = ($ordercode =~ m/^(.*):(\S*)/);
		} else {
			$pkg = $ordercode;
			$typ = "*/*";
		}
		$typ = "*/*" unless $typ;
		print STDERR " - Ordering '$ordercode'...  (package=$pkg, type=$typ, orderlist=@orderlist)\n" if $debug;
		$typ =~ s/\*/\.\*/g;
		foreach $entrycode (@entrylist) {
			next if grep(/^\Q$entrycode\E$/,@orderlist);
			print STDERR "    - Checking entrycode '$entrycode' against (@{$packages{$pkg}})...\n" if $debug;
			if (grep(/^\Q$entrycode\E$/,@{$packages{$pkg}})) {
				$entry = $entries{$entrycode};
				my($etype) = ($entry =~ m/^(.*?)(;|\s)/);
				print STDERR "       - entry found, type=$etype, checking against '$typ'\n" if $debug;
				if ($etype =~ m!^$typ$!) {
#					print STDERR "       - matched!\n" if $debug;
#					my($oaction) = ($ordercode =~ m/action=([^\s;]*)/i);
#					my($eaction) = ($entry     =~ m/action=([^\s;]*)/i);
#					$eaction="view" unless $eaction;
#					print STDERR "       - checking entry action '$eaction' against '$oaction'\n" if $debug;
#					if (!$oaction || $eaction =~ m/^($oaction)$/) {
						push @orderlist,$entrycode;
						print STDERR "       - matched!  (orderlist=@orderlist)\n" if $debug;
#					}
				}
			}
		}
	}

	foreach $entrycode (@entrylist) {
		next if grep(/^\Q$entrycode\E$/,@orderlist);
		push @orderlist,$entrycode;
	}

	print STDERR "orderlist: @orderlist\n" if $debug;
	return @orderlist;
}



#
# Generate new mailcap file
#
sub UpdateMailcap
{
	my(@entrylist) = @_;
	my(@above,@user,@below,$state,$entrycode);
	$state = 0;
	if (!open(PATH,"<$mailcap")) {
		print STDERR "Warning: could not read '$mailcap' (update stopped) -- $!\n";
		return;
	}

	while (<PATH>) {
		s/install-mime/update-mime/g;
		if ($state == 0) {
			push @above,$_;
		}
		$state=2 if ($state == 1 && /^\# ----- .* Ends /);
		if ($state == 1) {
			push @user,$_;
		}
		$state=1 if ($state == 0 && /^\# ----- .* Begins /);
		if ($state == 2) {
			push @below,$_;
		}
		$state=3 if ($state == 2);
	}

	close PATH;

	if ($state == 3) {
		open(PATH,">$mailcap") || die "Error: could not write '$mailcap' -- $!\n";
		print PATH @above;
		print PATH @user;
		print PATH @below;
		print PATH "\n###############################################################################\n\n";
		foreach $entrycode (@entrylist) {
			my $entry = $entries{$entrycode};
			$entry =~ s/\s*priority\s*=\s*\d+\s*($|;)//;
			$entry =~ s/\s*;\s*$//;
			print PATH $entry,"\n";
		}
		close PATH;
	} else {
		print STDERR "Error: '$mailcap' is not in required format -- not updated\n";
		print STDERR "       Restore from backup or delete and reinstall mime-support package";
	}
}



ReadEntries();
ReadOrder();
@list = OrderEntries();
UpdateMailcap(@list);
