#! /usr/bin/perl
###############################################################################
#
#  Run-Mailcap:  Run a program specified in the mailcap file based on a mime
#  type.
#
#  Written by Brian White <bcwhite@pobox.com>
#  This file has been placed in the public domain (the only true "free").
#
###############################################################################


$debug=0;
$etcmailcap="/etc/mailcap";
$usrmailcap="$ENV{HOME}/.mailcap";
$etcmimetyp="/etc/mime.types";
$usrmimetyp="$ENV{HOME}/.mime.types";


sub Usage {
	my($error) = @_;
	print STDERR $error,"\n\n" if $error;

	print STDERR "Use: $0 <--option=value> [...] [<mime-type>:]<filename> [...]\n\n";
	print STDERR "Options:\n";
	print STDERR "  action        specify what action to do on these files (default=view)\n";
	print STDERR "  debug         be verbose about what's going on (any non-zero value)\n";
	print STDERR "\n";

	exit ($error ? 1 : 0);
}


sub SaveStdin {
	my($match) = @_;

	my $tmpfile;
	$tmpfile = $ENV{TMPDIR};
	$tmpfile = "/tmp" unless $tmpfile;
	$tmpfile.= "/run-mailcap-$$";
	if ($match =~ m/nametemplate=(.*?)\s*($|;)/) {
		my $tmp = $1;
		$tmp =~ s|%s|$tmpfile|;
		$tmpfile = $tmp;
	}
	unlink($tmpfile);
	open(TMPFILE,">$tmpfile") || die "Error: could not write '$tmpfile' -- $!\n";
	while (<STDIN>) {
		print TMPFILE $_;
	}
	close(TMPFILE);

	return $tmpfile;
}



sub ExtensionMimetype {
	my($ext) = @_;
	local $/ = undef;

	unless ($mimetypes) {
		if (open(MIMETYPES,"<$usrmimetyp")) {
			$mimetypes .= <MIMETYPES>;
			close MIMETYPES;
		}

		open(MIMETYPES,"<$etcmimetyp") || die "Error: could not read '$etcmimetyp' -- $!\n";
		$mimetypes .= <MIMETYPES>;
		close MIMETYPES;
	}

	$mimetypes =~ m!^(([\w-]+/[\w-]+).*\s\Q$ext\E(\s.*)?)$!m;
	print " - extension '$ext' maps to mime-type '$2'\n" if $debug;
	return $2;
}



sub FileMimetype {
	my($file) = @_;
	my($ext)  =m!\.([^/\.]+)$!;

	return unless $ext;
	return ExtensionMimetype($ext);
}



foreach (@ARGV) {
	print " - parsing parameter '$_'\n" if $debug;
	if (m!^--(.*?)=(.*)$!) {
		print STDERR "Warning: definition of '$1=$2' overrides value '${$1}'\n" if ($ {$1} && $ {$1} != $2);
		$ {$1}=$2;
	} elsif (m!^[^/]+/[^/]+:!) {
		push @files,$_;
	} else {
		my $file=$_;
		my $type=FileMimetype($file);
		if ($type && $file) {
			push @files,"$type:$file";
		} else {
			print STDERR "Warning: unknown mime-type for file '$file'\n";
		}
	}
}

$action="view" unless $action;


if (open(MAILCAP,"<$usrmailcap")) {
	while (<MAILCAP>) {
		chomp;
		next unless $_;
		next if m/^\#/;
		push @mailcap,$_;
	}
	close MAILCAP;
}

open(MAILCAP,"<$etcmailcap") || die "Error: could not read '$etcmailcap' -- $!\n";
while (<MAILCAP>) {
	chomp;
	next unless $_;
	next if m/^\#/;
	push @mailcap,$_;
}
close MAILCAP;


foreach (@files) {
	my($type,$file) = m/^(.*?):(.*)$/;
	print "Processing file '$file' of type '$type'...\n" if $debug;

	my @matches;
	@matches = grep(/^\Q$type\E;/,@mailcap);
	@matches = grep(/\Q$action\E=/,@matches) unless $action eq "view";

	my $done=0;
	foreach $match (@matches) {
		my $comm;
		print " - checking mailcap entry '$match'\n" if $debug;
		if ($action eq "view") {
			($comm) = ($match =~ m/^.*?;\s*(.*?)\s*($|;)/);
		} else {
			($comm) = ($match =~ m/\Q$action\E=(.*?)\s*($|;)/);
		}
		next unless $comm;
		print " - program to execute: $comm\n" if $debug;

		if ($match =~ m/;\s*test=(.*?)\s*;/) {
			print " - running test: $1\n" if $debug;
			next if (system $1);
		}

		my $tmpfile;
		if ($match =~ m/;\s*needsterminal\s*($|;)/ && ! -t STDOUT) {
			if ($file eq "-") {
				$tmpfile = SaveStdin($match);
				$file    = $tmpfile;
			}

			$comm = "/usr/bin/X11/xterm -T '$file ($type)' -e $0 --action=$action ${type}:${file}";
		}

		if ($file ne "-") {
			if ($comm =~ m/%s/) {
				$comm =~ s/%s/$file/g;
			} else {
				$comm.= " <$file";
			}
		} else {
			if ($comm =~ m/%s/) {
				$tmpfile = SaveStdin($match);
				$comm =~ s/%s/$tmpfile/g;
			} else {
				# no name means same as "-"... read from stdin
			}
		}

		print " - executing: $comm\n" if $debug;
		system $comm;
		$done=1;
		unlink $tmpfile if $tmpfile;
		last;
	}

	print STDERR "Error: no mailcap rule for action '$action' for type '$type'\n" unless ($done);
}
