#!/usr/bin/perl
# $Id: showproc,v 1.6 2004/03/04 20:03:03 petef Exp $
# a decent showproc for mh					(petef)

use File::Type;
use MIME::Parser;
use strict;

# A generic foo/bar --> text/html converter table.  Defaults.
my(%type_convert) = (
		'application/msword' => 'antiword',
		'text/html' => 'lynx -dump',
);

my($curmsg, @msgs, $base, $folder, %mh_profile, $progname, %seq, @msglist);
my($pager) = $ENV{'PAGER'};
my(@header_fields) = ("Date", "From", "To", "cc", "Newsgroups", "Subject", "X-Mailer", "X-FreeBSD-CVS-Branch", "X-Spam-Status", "X-Spam-Level", "Replied");
my($tmpdir) = "/tmp/show.$$";
my($ft) = File::Type->new();
$progname = $0;
$progname =~ s/.*\///;
chomp($folder = `folder -fast`);
$pager ||= 'less';
while (-d "$tmpdir") {
	$tmpdir .= ".$$";
}
mkdir($tmpdir,0700);

# parse .showprocrc.  we grok:
#    pager: pager of choice (defaults to $ENV{'PAGER'} or less)
#    headers: list of headers, in order, you want to see in mail
#    convert: foo/bar: filter
#        Convert mime type foo/bar to text by sending it through filter
my($lhs, $rhs);
open(RC, "$ENV{'HOME'}/.showprocrc");
while(<RC>) {
	next unless m/^([^#:][^:]*):[ 	]*(.*)/o;
	$lhs = $1; $rhs = $2;
	if ('convert' eq $lhs) {
		next unless $rhs =~ m/^([^#:][^:]*):[ 	]*(.*)/o;
		$type_convert{$1} = $2;
	} elsif ('pager' eq $lhs) {
		$pager = $rhs;
	} elsif ('headers' eq $lhs) {
		$rhs =~ s/ *, *//;
		@header_fields = split /,/, $rhs;
	} else {
		print STDERR "$progname: .showprocrc: unknown option $lhs\n";
	}
}
close(RC);

# parse .mh_profile
open(MH_PROFILE, "$ENV{'HOME'}/.mh_profile");
while(<MH_PROFILE>) {
	next unless m/^([^#:][^:]*):[ 	]*(.*)/o;
	$mh_profile{$1} = $2;
}
close(MH_PROFILE);
$mh_profile{'Path'} ||= 'Mail';

# what's our real mail path?
$base = $mh_profile{'Path'};
$base = $ENV{'HOME'} . "/" . $base unless $base =~ m/^\//;
$base = '' if $folder =~ /^\//;
chdir("$base/$folder");

# get current sequences, if any
my($s, $m);
open(SEQ, ".mh_sequences");
while(<SEQ>) {
	next unless /^([^#:][^:]*):[ 	]*(.*)/;
	$s = $1; $m = $2;
	@msglist = ();
	map { if (m/^([0-9]+)-([0-9]+)$/) { push(@msglist, ($1..$2)); } else { push(@msglist, $_); } } split(/ /, $m);
	$seq{$s} = join(' ', @msglist);
	$seq{$s.':first'} = $msglist[0];
	$seq{$s.':last'} = $msglist[$#msglist];
}
close(SEQ);

@msglist = sort { $a <=> $b } (glob("[0-9]*"));
$seq{'all'} = join(' ', @msglist);
$seq{'first'} = $msglist[0];
$seq{'last'} = $msglist[$#msglist];

# figure out what we're looking at
while($curmsg = shift @ARGV) {
	if ($seq{$curmsg}) {
		push(@msgs, split(/ /, $seq{$curmsg}));
		next;
	} elsif ($curmsg =~ m/^([0-9]+)-([0-9]+)$/) {
		push(@msgs, ($1..$2));
		next;
	}
	die "$progname: invalid message/sequence \"$curmsg\"\n" unless -f "$base/$folder/$curmsg";
	push(@msgs, $curmsg);
}

# send our output to a pager
pipe READPIPE, WRITEPIPE;
my($pid) = fork();
if (0 == $pid) {
	# child
	open(STDIN, "<&READPIPE") || die "can't reopen stdin\n";
	close(WRITE);
	close(READ);
	exec($pager) || die "can't exec pager: $pager\n";
}
open(STDOUT, ">& WRITEPIPE") || die "can't reopen stdout\n";
close(WRITEPIPE);
close(READPIPE);

# parse our messages
foreach $curmsg (@msgs) {
	print "\n >> $folder:$curmsg\n\n" if scalar(@msgs) > 1;
	my($mparse, $ment, $head);
	my($v);
	$mparse = new MIME::Parser;
	$mparse->output_under("$tmpdir");
	$ment = $mparse->parse_open("$base/$folder/$curmsg") || die "$progname: MIME parsing failed!\n";

	# show the header.  we extract fields in order that we care about.
	# can be set with the 'headers' param in .showprocrc.
	$head = $ment->head || die "$progname: can't get the header: $!\n";
	foreach (@header_fields) {
		print "$_: $v" if ($v = $head->get($_));
	}
	print "\n";

	# recursively show the parts of the body we care about.
	show_parts($ment, total_parts($ment));
}

sub total_parts {
	my($ent, $t) = @_;
	$t ||= 0;
	if ($ent->parts()) {
		for (my($i) = 0; $i < $ent->parts(); $i++) {
			$t = total_parts($ent->parts($i), $t);
		}
		return $t;
	}
	return $t + 1;
}

sub show_parts {
	my($ent, $tparts, $nparts) = @_;
	$nparts ||= 1;
	my($body_parts, @body, $b, $i);
	if ($ent->parts()) {
		for (my($i) = 0; $i < $ent->parts(); $i++) {
			$nparts = show_parts($ent->parts($i), $tparts, $nparts);
		}
		return $nparts;
	}

	print_part($ent, $tparts, $nparts);
	return $nparts + 1;
}

# Print out a MIME part.  Decode to text as best we can.  We require
# lynx and antiword for now.
sub print_part {
	my($ent, $tparts, $nparts) = @_;
	my($bfh, $type, $guess);
	$type = $ent->head->mime_type;

	# If we have an unknown type, see if we can grok what specifically
	# it is.
	$guess = undef;
	if ($type eq 'application/octet-stream') {
		$guess = $ft->mime_type($ent->bodyhandle->path);
	}

	if ($type_convert{$type} || $type_convert{$guess}) {
		my($filter) = $type_convert{$type};
		$filter = $type_convert{$guess} if defined($guess);
		print ">>> MIME part $nparts/$tparts, type $type" . (defined($guess) ? " [$guess]" : "") . " (converted to text/plain)\n\n";
		open(CONVERTED, $type_convert{$type} . ' ' . $ent->bodyhandle->path . ' |');
		$/ = undef;
		print <CONVERTED>;
		close(CONVERTED);
		print "\n";
	} elsif ($type =~ /^(text|message)/) {
		print ">>> MIME part $nparts/$tparts, type $type\n\n" if $tparts > 1;
		$bfh = $ent->open('r');
		if (!defined($bfh)) {	# in core, not on disk?
			print $ent->as_string();
			last;
		}
		while(defined($_ = $bfh->getline)) {
				print;
		}
		$bfh->close();
		print "\n";
	} else {	# some unknown attachment
		print ">>> MIME part $nparts/$tparts, type $type" . (defined($guess) ? " [$guess]" : "") . " (not shown)\n\n";
	}
}

close(STDOUT);
wait(); # for $pager
system("rm -r $tmpdir");
exit(0);