#!/usr/local/bin/perl
#
#NAME
#  Repl - produce an email message
#
#SYNOPSIS
#  Repl [+folder] [index]
#
#REQUIRES
#
	$LNAM = $ENV{'LOGNAME'} || $ENV{'USER'};
	$HOME = $ENV{'HOME'} || "/home/$LNAM";
	@INC = ($HOME, "$HOME/mh","$HOME/sh",@INC);
	require 'jcmh.pm';
#
#DESCRIPTION
#  This lists the current message from  an  mh-style  directory.   If
#  there is no current message, we start at 1. If the current message
#  doesn't exist, we act as Next, and hunt for the next message.
#
#OPTIONS
#
#EXAMPLES
#
#FILES
#
#BUGS
#
#SEE ALSO
#   Inc, List, Prev, Next, ...
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>

$| = 1;
$Q = '|';	# Message quoting char

$lin = $nxt = '';
$Rf = '';	# Reference list.
$I = '#';	# Char used to flag original lines.

for $a (@ARGV) {
	print "$0: Arg \"$a\"\n" if $V>2;
	if ($a =~ /^\+(\w+)$/) {
		$FLDR = $1;
		print "Folder \"$FLDR\" from command line.\n" if $V>2;
	} elsif ($a =~ /^\d+$/) {
		$ndx = $a;
	} else {
		print STDERR "$P: Unrecognized arg \"$a\" ignored.\n";
	}
}
print "Folder \"$FLDR\"\n" if $V>1;

unless ($ndx) {
	$ndx = &getindex($MDIR,$FLDR,1);
	print "Current index in $FDIR is $ndx.\n" if $V>1;
}
#hdrpat = "^(Subj|From|To|Repl|Date|Cc|X-)";

$ifile = "$FDIR/$ndx";
$rfile = "$FDIR/${ndx}R";


if (-f $rfile) {
	print "Reply message $rfile already exists.\n";
	print "[E]dit,[R]eplace,[Q]uit? ";
	$rsp = <STDIN>;	# 'E' or 'R' else quit
} else {
	$rsp = 'R';		# Build a reply message
}

if ($rsp =~ /^R/i) {	# Replace it with new reply message
	unless (open(IMSG,$ifile)) {
		print STDERR "$P: Can't read \"$ifile\" ($!)\n";
		die $!;
	}
	unless (open(RMSG,">$rfile")) {
		print STDERR "$P: Can't write \"$rfile\" ($!)\n";
		die $!;
	}
	print "Read headers from $ifile ...\n" if $V>2;
	@hdrs = ();	# We accumulate the headers here
line:
	while ($l = <IMSG>) {
		$l =~ s/[\s\r]+$//;	# Trim away white stuff
		if ($l eq '') {
			last line;
		} else {
			&hdrline($l);
		}
	}
	&parsehdrs();
	&outhdrs();		# Output the new headers
	print RMSG "\n";
	while ($l = <IMSG>) {
		print RMSG "$Q $l";	# Quote message contents
	}
	close IMSG;
	close RMSG;
	$rsp = 'E';	# Now edit the reply
}

# Now invoke an editor.
if ($rsp =~ /^E/i) {
	$ed = $ENV{'EDITOR'} || $ENV{'VISUAL'} || 'vi';
	$cmd = "$ed $rfile";
	print "Command: \"$cmd\"\n" if $V>2;
	sleep($V*2) if $V>1;
	system $cmd;
	print "Send? ";
	$rsp = <STDIN>;
	$rsp =~ s/[\s\r]+$//;
	if ($rsp eq '' || $rsp =~ /^[sy]/i) {
		print "Send $rfile\n" if $V>0;
		($snd = `which Send`) =~ s/[\r\s]$//;
		print "$P: snd=\"$snd\"\n" if $V>1;
		$cmd = "$snd $rfile";
		print "$P: cmd=\"$cmd\"\n" if $V>1;
		system $cmd;
		print "Sent $rfile (status=$?)\n" if $V>0;
	} else {
		print "Reply saved as $rfile\n" if $V>0;
	}
}
print "Done.\n" if $V>0;

exit 0;

sub hdrline {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Accumulate the header lines in @hdrs.  The tricky part is  recognizing  the #
# continued lines and joining them into single long lines.                    #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($l) = @_;
	if (@hdrs && ($l =~ /^\s/)) {	# Indented lines are continuations
		$l =~ s/^\s+/ /;
		$hdrs[$#hdrs] .= $l;
	} else {
		push @hdrs, $l;
	}
}

sub parsehdrs {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Analyze the command-line args.  Chew up the input, one  header  line  at  a #
# time.   For  lines  that  we recognize, we extract the data and store it in #
# globals.  Other lines are stored in @hdrs for later use.                    #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($l);
line:
	for $l (@hdrs) {
		if ($l =~ /^Reply-To:\s*(.*)/i) {	# The preferred Internet return address
			$Reply_To = $l;
			$r = $1;
			if ($r =~ /^(.*)<(.*)>\s*$/) {	# R.J.Hacker <foo!bar!rjh>
				$RT = &trim($2);	# Should be bang path to sender
				$Fd = &trim($1);	# Should be description or name
			} elsif ($r =~ /^(.*)\((.*)\)\s*$/) {	# foo!bar!rjh (R.J.Hacker)
				$RT = &trim($1);	# Should be bang path to sender
				$Fd = &trim($2);	# Should be description or name
			} else {
				$RT = &trim($1);	# Should be just a (bang) path to sender
			}
		} elsif ($l =~ /^Apparently-To:\s*(.*)/i) {
			$Apparently_To = $l;
			$AT = &trim($1);		# Should be email path from sender to recipient
		} elsif ($l =~ /^From +([^ ]+) *(.*)/) {	# UUCP return address
			$UUCP_From = $l;
			$FU =					# UUCP "From" path
			$Fr = &trim($1);		# Should be bang path to sender
			$Dr = $2;				# Date received
			print "Fr='$Fr' Dr='$Dr' [From ]\n" if $V>1;
		} elsif ($l =~ /^From:/i) {	# Some people don't like us to use this
			$SMTP_From = $l;
			if ($l =~ /^From:\s*(.+) +\((.*)\)/i) {
				$FS = 
				$Fr = &trim($1);	# Can be any kind of path to sender
				$Fd = &trim($2);	# Comment should describe sender
				print "Fr='$Fr' Fd='$Fd' [From: ... (...)\n" if $V>1;
			} elsif ($l =~ /^From:\s*(.+) +<(.*)>/i) {
				$FS = 
				$Fr = &trim($2);	# Can be any kind of path to sender
				$Fd = &trim($1);	# Comment should describe sender
				print "Fr='$Fr' Fd='$Fd' [From: ... <...>]\n" if $V>1;
			} elsif ($l =~ /^From:\s*(.+)/i) {
				$FS = 
				$Fr = &trim($1);	# Assume it's just an email path
				print "Fr='$Fr' [From:]\n" if $V>1;
			}
		} elsif ($l =~ /^Message-ID:\s*(.+)/i) {
			$ID = &trim($1);		# Message ID string
		} elsif ($l =~ /^X-/) {		# At present, we don't recognize any of these
			;
		} elsif ($l =~ /^Return-Path:\s*(.*)/) {	# Return path hated by some
			$Return_Path = $l;
			$RP = &trim($1);		# Path back to sender
		} elsif ($l =~ /^Received:\s*(.*)/) {
			$Re = $1 . ' ';			#
			$R_for = $R_sid = $R_mlr = $R_frm = $R_via = $R_mid = '';
#			$Received = $l;
			if ($Re =~ s/\s+\(*for\s+(\S+)\)*\s*/ /) {
				$R_for = &trim($1);	# Mail handler id
			}
			if ($Re =~ s/\s+by\s+([A-Za-z0-9.-]+)\s*/ /) {
				$R_sid = &trim($1);	# Should be system id
			}
			if ($Re =~ s/\s+from\s+([A-Za-z0-9.-]+)\s+/ /) {
				$R_frm = &trim($1);	# Id of sender system
			}
			if ($Re =~ s/\s+id\s+(<\S*>)\s*;*/ /) {
				$R_mid = &trim($1);	# Message id
			}
			if ($Re =~ s/\s+[Ii][Dd]\s+(\S*)\s*;*/ /) {
				$R_mid = &trim($1);	# Message id
			}
			if ($Re =~ s/\s+via\s+(\S*)\s*;*/ /) {
				$R_via = &trim($1);	# Network name
			}
			if ($Re =~ s/\s+with\s+(\S*)\s*;*/ /) {
				$R_wth = &trim($1);	# Network name
			}
			if ($Re =~ s/^\s+\((.*)\)/ /) {
				$R_mlr = $1;	# Mail handler id
			}
			$Re =~ s/^\s+//;
			$Re =~ s/\s+$//;
			if ($V > 3) {
				print RMSG "X-Rcvd:\tby <$R_sid> from <$R_frm>\n";
				print RMSG "\tfor <$R_for> via <$R_via> with <$R_wth>\n" 
					if $R_for || $R_via;
				print RMSG "\tid <$R_mid> ($R_mlr)\n"
					if $R_mid || $R_mlr;
				print RMSG "\t[$Re]\n" 
					if $Re;
			}
		} elsif ($l =~ /^\s*\(for (.*)\)\s+id\s+(.*)/) {
			$Msg_Id = $l;
			unless ($Fr) {
				$Fr = $1;	# Who this system thought it was sent to
				print "Fr='$Fr' [for..id]\n" if $V>1;
			}
			$Id = $2;		# One system's message ID, plus assorted junk
		} elsif ($l =~ /^Sender:\s*(.+)/i) {	# Where is this documented?
			$Sender = $l;
			$FS = $1;
			$Fr = $1 unless $Fr;
			print "Fr='$Fr' FS='$FS' [Sender:]\n" if $V>1;
		} elsif ($l =~ /^Subject:\s*(.+)/i) {	# Not required, but nice to have
			$Sb = $1;	# Subject is arbitrary string
			$Sb =~ s/ *R[Ee]:\s*//;
		} elsif ($l =~ /^To:\s*(.+)/i) {		# Not always who it was originally sent to
			$Sent_To = $l;
			$To = $1;	# Should be valid email address
		} elsif ($l =~ /^Cc:\s*(.+)/i) {		# Not always who it was originally sent to
			$Also_To = $l;
			$Cc = $1;	# Should be valid email address(es)
		} elsif ($l =~ /^Bcc:\s*(.+)/i) {		# Blind copies sometimes do show
			$Blind_cc = $l;
			$Bcc = $1;	# Should be valid email address(es)
		} elsif ($l =~ /^Date:\s*(.+)/) {		# Not always in a sensible date format
#			$Date = $l;
			$Ds = $1;	# Date sent
		} elsif ($l =~ /^Message-ID:\s*(.+)/i) {	# 
			$InRpTo = $1;	# In-Reply-To
		} elsif ($l =~ /^(Newsgroups*):\s*(.+)/) {	# Reply to BB article
#			$Newsgroup = $l;
			$Nh = $1;	# Can be plural
			$Ng = $2;
		} elsif ($l =~ /^(References*):\s*(.+)/) {	# Other BB articles
#			$Rh = $1;	# Can be plural
			$Rf = $2;
		} elsif ($l =~ /^In-Reply-To:\s*(.+)/) {
			$In_Reply_To = $l;
			$IRT = $1;	# Should be valid email address
		} elsif ($l =~ /^Message-Id:\s*(.+)/i) {		# Other BB articles
			$Message_Id = $l;
			$ID = $1;
		} elsif ($l =~ /^X-Mailer:\s*(.+)/) {
			$X_Mailer = $l;
			$XM = $1;	# Should be valid email address
		}
		push @ihdrs, "$I$l\n";	# Unmatched headers
	}
	$hdrs[$#hdrs] =~ s/^$I/$I??/;
	;
}

sub outinfo {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# We now put out a summary of what we learned from the headers.  This is done #
# only at debug level 3 and higher, because we usually don't want it.         #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	if ($Message_Id)    {print RMSG "X-$Message_Id\n";}
	if ($Dr)            {print RMSG "X-Sent-Date: $Dr\n";}
	if ($Sent_To)       {print RMSG "X-Sent-To: $To\n";}
	if ($Also_To)       {print RMSG "X-Also-To: $Cc\n";}
	if ($Blind_cc)      {print RMSG "X-Blnd-Cc: $Bcc\n";}
	if ($Apparently_To) {print RMSG "X-Aply-To: $AT\n";}
	if ($Dr)            {print RMSG "X-Recv-Date: $Dr\n";}
	if ($Ds)            {print RMSG "X-Send-Date: $Ds\n";}
	if ($XM)            {print RMSG "X-$X_Mailer\n";}
	if ($In_Reply_To)   {print RMSG "X-In-Reply: $IRT\n";}
	if ($Reply_To)      {print RMSG "X-$Reply_To\n";}
	if ($Return_Path)   {print RMSG "X-$Return_Path\n";}
	if ($Sender)        {print RMSG "X-$Sender\n";}
	if ($SMTP_From)     {print RMSG "X-SMTP-$SMTP_From\n";}
	if ($UUCP_From)     {print RMSG "X-UUCP-From: $FU\n";}
}

sub outhdrs {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# To reply, we go thru the possible return addresses in what  we  believe  is #
# the preferred order, taking the first that is nonnull.                      #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	if ($To) {
		print RMSG "#To: $To\n";
	}
	if ($RT) {
		&to($RT,$Fd);
	}
	if ($RP) {
		&to($RP,$Fd);
	}
	if ($Fr) {
		print "Fr='$Fr' [to]\n" if $V>1;
		&to($Fr,$Fd);
	}
	if ($FS && ($FS ne $Fr)) {
		print "FS='$FS' [to]\n" if $V>1;
		&to($FS,$Fd);
	}
	if ($Cc) {
		print RMSG "#Cc: $Cc\n";
	}
	&outinfo() if $V>2;
# It's conventional to add exactly one "Re:" to the subject.
	if ($Sb) {
		print RMSG "Subject: Re: $Sb\n";
	}
# For news/BB articles, we preserve the group names.
	if ($Ng) {
		$Ng =~ s/,  */,/g;
		print RMSG "$Nh: $Ng\n";
	}
# If there were any references, we preserve them.
	$Rf = "$ID,$Rf" if ($ID);
	if ($Rf) {
		$Rf =~ s/,\s*/,/g;
		$Rf =~ s/,*$//;
		print RMSG "References: $Rf\n";
	}
	if ($InRpTo) {
		print RMSG "In-Reply-To: $InRpTo\n";
	}
# Most messages have an ID string.
	if ($ID) {
		print RMSG "Message-ID: $ID\n";
	}
	if ($V > 1) {
		for $l (@hdrs) {
			$l =~ s/\s+/ /g;
			print RMSG "$l\n";
		}
	}
}

sub to {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Here's a routine to generate the "To:  Note that we first strip off  spaces #
# and "<>"." line.  We also remember the recipient for possible later use.    #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($rcpt,$desc) = @_;
	$rcpt =~ s/^[ 	<]*//;
	$rcpt =~ s/[ 	>]*$//;
	print RMSG "#To: <$rcpt> ($desc)\n";
	$TO = $rcpt;
	return $TO;
}

sub trim {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($x) = @_;
	$x =~ s/^\s*[<("]*\s*//;
	$x =~ s/\s*[;>)"]*\s*$//;
	return $x;
}