#!/usr/local/bin/perl
#
#NAME
#  Rmm - trash the current email message
#
#SYNOPSIS
#  Junk   [-folder] +folder [/pat/] [messages]..
#  Trash  [-folder] +folder [/pat/] [messages]..
#  Refile [-folder] +folder [/pat/] [messages]..
#  Refile <patfile
#
#REQUIRES
#
	$LNAM = $ENV{'LOGNAME'} || $ENV{'USER'};
	$HOME = $ENV{'HOME'} || "/home/$LNAM";
	@INC = ($HOME, "$HOME/mh","$HOME/sh",@INC);
	require 'jcmh.pm';
#
#DESCRIPTION
#  File a list of messages into a mail folder.
#
#  If there are no messages listed, this program reads stdin and  expects  to
#  file a list of lines of the form:
#    folder pattern
#  Messages in the current folder are scanned, and if a message matches any
#  of the patterns, it is moved to the corresponding folder.  The patterns
#  are perl REs.  This is typically used to 
#  
#
#OPTIONS
#
#EXAMPLES
#
#  Refile <<EOF
#  userlinux /^From:\s*discuss-request\@lists\.userlinux\.com/
#  asterisk  /^To:\s*asterisk-users\@lists\.digium\.com/
#  RJ        '^Subject:.*\[RJ\]'
#  trash     "\bbig5\b"i
#  EOF
#
#FILES
#
#BUGS
#
#SEE ALSO
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>

$| = 1;
($P = $0) =~ s".*/"";
$V = $ENV{"V_$P"} || 2;
print "$P: V=$V\n" if $V>1;

$maxinarow = $ENV{"M_$P"} || 50;	# Give up if we accept this many messages in a row
$msgargs = 0;		# How many message-related args were there?
@pats = ();			# List of patterns to match
$remove = 1;		# Set to 0 during debugging to not unlink files
$trashed = 0;		# How many messages were trashed?

$FrFLDR = 'inbox';
if    ($P eq 'Trash')   {$ToFLDR = 'trash'}
elsif ($P eq 'Junk')    {$ToFLDR = 'junk'}
elsif ($P eq 'Refile')  {$Refile = 1}

for $a (@ARGV) {
	print "$P: Arg \"$a\"\n" if $V>1;
	if ($a =~ /^\+(\w+)$/) {		# Target folder name
		$ToFLDR = $1;
		print "Folder \"$ToFLDR\" from command line.\n" if $V>1;
		++$msgargs;
	} elsif ($a =~ /^-(\w+)$/) {	# Source folder name
		$FrFLDR = $1;
		print "Folder \"$FrFLDR\" from command line.\n" if $V>1;
	#	++$msgargs;
	} elsif ($a =~ /^\d+$/) {		# Message number
		print "Move msg $a ...\n";
		++$trashed;
	} elsif ($a =~ /^\/(.*)\/$/) {	# Pattern to match in messages
		print "Match /$1/ ...\n" if $V>1;
		push @pats, $1;
		$ToFldr{$1} = $ToFLDR;
	} elsif ($a =~ /^\d/) {			# Message number
		print "Move msgs $a ...\n";
		++$msgargs;
		&movelist($a);
	} elsif ($a =~ /^[-+][Hh]/) {	# Print help (usage) message
		&Usage();
	} else {
		print STDERR "$P: Unrecognized arg \"$a\" ignored.\n";
		&Usage();
		++$trashed;	# Suppress trashing of current message.
	}
}

$maildir = "$HOME/mail";
$listdir = "$maildir/list";
$friendsfile = "$listdir/friends";
print "$P: friendsfile='$friendsfile'\n" if $V>2;

if ($ToFLDR && !($trashed || $msgargs || @pats)) {
	print "$P: Default to current message.\n" if $V>2;
	$ndx = &getindex($MDIR,$FrFLDR,1);
	print "--- $P message $ndx (current)\n" if $V>0;
	&movelist($ndx);
	++$trashed;
}

unless ($trashed || $msgargs || @pats) {	# Were any messages listed?
	unless (@pats) {
		print "$P: Read patterns from STDIN ...\n" if $V>2;
		while ($line = <STDIN>) {
			next if ($line =~ /^\s*#/);
			$line =~ s/[\r\s]+$//;
			print "$P: LINE \"$line\"\n" if $V>4;
			if (($fldr,$pat,$q1,$rmdr,$q2,$qual) = ($line =~ /^([-\w]+)\s+((\W)(.*)(\W)(\w*))/)) {
				print "$P: PAT \"$fldr\" <- $q1$rmdr$q2$qual\n" if $V>2;
				if ($q1 eq $q2) {
					print "$P: PAT [$q1$rmdr$q2$qual]\n" if $V>2;
					print "$P: PAT {$pat}\n" if $V>2;
					$ToFldr{$pat} = $fldr;
					push @pats, $pat;
				} else {
					print "$P: PAT \"$pat\" has mismatched quotes.\n" if $V>0;
				}
			}
		}
	}
	if (open(FRNDS,$friendsfile)) {	# Do we have a list of friends?
		print "$P: Reading 'friendsfile' ...\n" if $V>2;
		for $line (<FRNDS>) {
			next if ($line =~ /^\s*#/);
			$line =~ s/[\r\s]+$//;
			print "$P: line='$line'\n" if $V>2;
			if (($where,$who) = ($line =~ /^\s*<([^>]+)>\s+(.*)/)) {
				print "$P: Friend: <$where> $who\n" if $V>2;
				$Friend{lc($where)} = $who;
			}
		}
	}
	print "$P: " . int(@pats) . " patterns to match.\n" if $V>2;
	unless (%ToFldr) {
		print "$P: No patterns from STDIN.\n" if $V>2;
		if (-f ($patfile = "$MDIR/.patterns")) {
			print "$P: Pattern file \"$patfile\" exists.\n" if $V>2;
			if (open(PF,$patfile)) {
				while ($line = <PF>) {
					$line =~ s/[\r\s]+$//;
					print "$P: LINE \"$line\"\n" if $V>4;
					next if ($line =~ /^\s*#/);
					if (($fldr,$pat,$q1,$rmdr,$q2,$qual) = ($line =~ /^([-\w]+)\s+((\W)(.*)(\W)(\w*))/)) {
						print "$P: PAT \"$fldr\" <- $q1$rmdr$q2$qual\n" if $V>3;
						if ($q1 eq $q2) {
							print "$P: PAT [$q1$rmdr$q2$qual]\n" if $V>3;
							print "$P: $fldr\t$pat\n" if $V>2;
							$ToFldr{$pat} = $fldr;
							push @pats, $pat;
						} else {
							print "$P: PAT \"$pat\" has mismatched quotes.\n" if $V>0;
						}
					}
				}
				close PF;
			} else {
				print "$P: ### Can't read \"$patfile\" ($!)\n" if $V>1;
			}
		}
	}
#	$sel = '9??';		# Files to select for testing
	$sel = '*';			# Files to select for normal run
	$pth = '';
	$mailfiles = 0;		# Count the mail files scanned
	$inarow = 0;		# Count consecutive "good" messages
	print "$P: inarow=$inarow at $pth\n" if $V>2;
file:
	for $pth (`ls -t $MDIR/$FLDR/$sel`) {
		$pth =~ s/[\r\n]+$//;
		print "$P: FILE \"$pth\" --------------------------------------\n" if $V>2;
		++$mailfiles;
		($fil = $pth) =~ s".*/"";
		next if ($fil =~ /^,/);
		next if ($fil =~ /R$/);
		if (open(MSG,$pth)) {
	line:	while ($line = <MSG>) {
				$line =~ s/[\r\s]+$//;
				print "$P: line \"$line\"\n" if $V>4;
				if (($line =~ /^(From|Sender)[:\s]+(.*)$/i) || ($line =~ /^(Reply-To):\s*(.*)$/i)) {
					$mhdr = $1;
					$sndr = sender($2);	# Extract the email address
					print "$P: $mhdr '$sndr'\n" if $V>2;
					if ($name = $Friend{lc($sndr)}) {
						print "\tKept msg $fil from friend <$sndr> $name\n" if $V>2;
						last line;
					}
				}
				for $pat (@pats) {
					print "$P: pat: \"$pat\"\n" if $V>3;
				#	$why1 = $why2  = '';
					if (eval "(\$line =~ m$pat)") {
						if ($V>2) {
							print "$P: PAT: \"$pat\"\n";
						#	print "$P: WHY1 \"$why1\"\n";
						#	print "$P: WHY2 \"$why2\"\n";
							print "$P: LINE \"$_\"\n";
							print "$P: ---> \"$ToFldr{$pat}\"\n";
						}
						&filemsg($fil,$ToFldr{$pat},$pat);
						$inarow = 0;	# Reset the good-msgs counter
						print "$P: inarow=$inarow at $pth [refiled]\n" if $V>2;
						last line;		# Done with this file.
					} else {
						print "$P: NO MATCH\n" if $V>3;
					}
					++$tests;
				}
			}
			close MSG;
			print "$P: inarow=$inarow at $pth\n" if $V>2;
		} else {
			print "$P: ### Can't read \"$pth\" ($!)\n" if $V>0;
		}
		print "$P: $mailfiles mail files scanned so far.\n" if $V>2 && !($mailfiles%20);
		++$inarow;	# Count consecutive messages that "pass" by failing all the spam tests
		print "$P: inarow=$inarow at $pth\n" if $V>2;
		if ($inarow >= $maxinarow) {
			print "$P: Exit after $inarow consecutive good messages.\n" if $V>0;
			last file;	# Give up looking for spam
		}
	}
	print "$P: $mailfiles mail files scanned.\n" if $V>2;
}

printf("$P: %3d messages trashed..\n",$trashed) if $V>0 && $trashed;
for $fldr (sort keys %FldrCnt) {
	$fcnt = $FldrCnt{$fldr};
	$imax = $MaxNdx{$fldr};
	printf("$P: %3d new messages in $fldr.\n",$fcnt) if $V>0;
}
exit 0 if $trashed > 0;

if (!$rmcnt && $P eq 'Trash') {	# Were there any files listed?
	print "$P current file.\n" if $V>2;
	$ndx = &getindex($MDIR,$FrFLDR,1);
	print "--- $P message $ndx (current)\n" if $V>0;
	&movefiles($ndx,$ndx);
	exit 0;
}
exit 1;

sub sender { local($F) = 'sender';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Given the data on a From: line, we try  to  determine  the  sender's  email #
# address.  This is trickier than it might appear.                            #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($data) = @_;
	if ($data =~ /<(.*)>/) {	# The easy case
		return $1;
	}
	if ($data =~ /([^\s]+)@([^\s]+)/) {	# Is this sufficient for the rest?
		return $1 . '@' . $2;
	}
	return $data;	# Give up and treat the whole thing as the address
}

sub filemsg { local($F) = 'filemsg';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Move a file from the current folder to a different folder.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($file,$fldr,$why) = @_;
	local($ndx,$pth1,$pth2);
	print "$F: file=\"$file\" FLDR=\"$FLDR\" fldr=\"$fldr\"\n" if $V>2;
	$pth1 = "$MDIR/$FLDR/$file";
	print "$F: pth1=\"$pth1\"\n" if $V>2;
	unless ($ndx = $MaxNdx{$fldr}) {
		$ndx = $MaxNdx{$fldr} = &maxindex($MDIR,$fldr);
		print "$F: ndx $ndx is maxindex for fldr \"$fldr\"\n" if $V>2;
	}
	++$ndx;		# Advance to the next index
	print "$F: ndx=$ndx.\n" if $V>2;;
	$pth2 = "$MDIR/$fldr/$ndx";
	while (-f ($pth2 = "$MDIR/$fldr/$ndx")) {
		++$ndx;
		print "$F: ndx=$ndx is next index in \"$fldr\"\n" if $V>1;
	}
	if (link($pth1,$pth2)) {
		print "$F: Move  \"$pth1\" -> \"$pth2\"\n" if $V>1;
		print "\tReason: [$why]\n" if $V>1;
		$MaxNdx{$fldr} = $ndx;	# New max index for this folder
		++$FldrCnt{$fldr};		# Count the moved messages
		if ($remove && unlink($pth1)) {
			print "$F: Unlinked \"$pth1\"\n" if $V>2 && $remove;
			print "$P: Moved \"$pth1\" -> \"$pth2\"\n" if $V>2;
			++$moved;
		} else {
			print "$F: ### Can't unlink \"$pth1\" ($!)\n" if $V>0 && $remove;
		}
#		&setindex($MDIR,$fldr,$ndx);	# Update folder's index
	} elsif (!-f $pth1) {
		print "$F: Can't link \"$pth1\" -> \"$fldr/$ndx\" ($!)\n" if $V>0;
	} else {
		print "$F: ### Can't link \"$pth1\" -> \"$pth2\" ($!)\n" if $V>0;
		if (-f $pth1) {print "$F: --- \"$pth1\" exists.\n" if $V>1;
		}       else  {print "$F: --- \"$pth1\" does not exist.\n" if $V>1;}
		if (-f $pth2) {print "$F: --- \"$pth2\" exists." if $V>1;
		}       else  {print "$F: --- \"$pth2\" does not exist." if $V>1;}
	}
}

sub movefiles { local($F) = 'movefiles';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($lo,$hi) = @_;
	local($frfil,$frndx,$tofil,$tondx);
	die "$F: No source folder\n"      unless $FrFLDR && -d "$MDIR/$FrFLDR";
	die "$F: No destination folder\n" unless $ToFLDR && -d "$MDIR/$ToFLDR";
	$hi = $lo unless $hi >= $lo;
	for ($frndx = $lo; $frndx <= $hi; $frndx++) {
		++$rmcnt;
		print "Delete: message $frndx.\n" if $V>2;
		$tondx = getindex($MDIR,$ToFLDR);
		$frfil = "$MDIR/$FrFLDR/$frndx";
		$tofil = "$MDIR/$ToFLDR/$tondx";
		while (-f $tofil) {
			++$tondx;
			$tofil = "$MDIR/$ToFLDR/$tondx";
		}
		print "--- Move $frfil to $tofil ...\n" if $V>2;
		if (link($frfil,$tofil)) {
			unlink($frfil);
			print "--- Moved $FrFLDR/$frndx to $ToFLDR/$tondx.\n" if $V>1;
		} elsif (!-f $frfil) {
			print "--- Current message $frndx doesn't exist.\n" if $V>0;
		} else {
			print STDERR "Can't link $frndx to $tofil ($!)\n" if $V>0;
		}
	}
#	&setindex($MDIR,$ToFLDR,$tondx);
}

sub movelist { local($F) = 'movelist';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($lst) = @_;
	local($lo,$hi,$rmdr);
	while(($lo,$rmdr) = ($lst =~ /^(\d+)(.*)$/)) {
		if (($hi,$rmdr) = ($rmdr =~ /^-(\d+)(.*)$/)) {
			&movefiles($lo,$hi);
		} elsif ($rmdr =~ s/^,//) {
			&movefiles($lo,$lo);
		} else {
			&movefiles($lo,$lo);
		}
		($lst = $rmdr) =~ s/^,//;
	}
	if ($lst) {
		print STDERR "$F: Can't parse message list \"$lst\"\n" if $V>0;
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub Usage {
	if (lc($P) eq 'trash') {
		print "Usage: Trash [-folder] +folder [messages]..\n";
	} else {
		print "Usage: $P [-folder] +folder [messages]..\n";
	}
}