#! /usr/bin/perl

    #   Read or search a mail folder and dispatch
    #   messages to folders based on action keys.
    
    #	by John Walker  http://www.fourmilab.ch/
    #	    	   September 2002

    #   The assignments to the %action hash define the keys
    #   which are accepted by the "Disposition" prompt.  You
    #   can add additional folders by simply
    #   specifying the key and path name.  The upper case
    #   keywords denote actions built into the program.
    #	If you add any built-in actions, be sure to document
    #	them in the printHelpText subroutine.

    $action{'d'} = "";	    # Discard and advance to next message
    $action{'j'} = "junk";
    $action{'m'} = "mail";

    $action{'b'} = 'BACK';
    $action{'f'} = 'FILE';
    $action{'q'} = "QUIT";
    $action{'v'} = 'VIEW';
    $action{'/'} = 'SEARCH';
    $action{'?'} = 'HELP';

    if ($#ARGV < 0) {
    	print("Usage: perl splitmail.pl mail_folder_file\n");
	exit(2);
    }
    open(IN, "<$ARGV[0]") || die "Cannot open input file $ARGV[0]";

    while (1) {
    	$whence = tell(IN);
    	if ((!($l = <IN>)) || ($l =~ m/^From /)) {
    	    last;
	}
    }
    
    if (!$l) {
    	print("No messages in mail folder!\n");
	exit(0);
    }
    
    $eof = 0;
    $pattern = '';  	    	# Initialise search pattern
    
    push(@backStack, $whence);
    
    while (!$eof) {
    
    	#   Read next message from mail folder.  At
	#   this point $l contains the first ("From ")
	#   line of the message.
	
	$nlines = 0;
	undef @message;
	$msize = length($l);
	&trim_end_of_line;
	$message[$nlines++] = $l;
	
	#   Read the balance of the message into the
	#   @message array.  Quit when the "From " line
	#   of the next message is encountered or the
	#   end of the folder is encountered.
	
	while (1) {
	    $whence = tell(IN);
	    if ((!($l = <IN>)) || ($l =~ m/^From /)) {
		last;
	    } else {
	    	&trim_end_of_line;
	    	$message[$nlines++] = $l;
	    	$msize += length($l);
    	    }
	}
	push(@backStack, $whence);
	
	if ($nlines > 0) {
	    &dispose_of_message;
	}
	$eof = !($l);
    }

#   Dispose of the message in the @message
#   array.
    
sub dispose_of_message {
    local($i, $from, $to, $subject, $disp, $afrom, $act);
    
    #	Parse message header for "interesting" items
    
    for ($i = 0; $i < $nlines; $i++) {
    	if ((length($message[$i]) == 0) ||
	    ($message[$i] =~ m/^\s*$/)) {
	    last;
	}
	
	if ($message[$i] =~ m/^From\s/) {
	    if (!($message[$i] =~ m/^From\s+-\s+/)) {
	    	$from = $message[$i];
	    } else {
	    	$afrom = $message[$i];
	    }
	}
	elsif ((!defined($from)) && ($message[$i] =~ m/^From:\s/)) {
	    $from = $message[$i];
	}
	elsif ($message[$i] =~ m/^To:\s/) {
	    $to = $message[$i];
	}
	elsif ($message[$i] =~ m/^Subject:\s/) {
	    $subject = $message[$i];
	}
	elsif ($message[$i] =~ m/^Date:\s/) {
	    $date = $message[$i];
	}
    }

    $disp = '';
    while (length($disp) == 0) {    
	print("\n");
	if (!defined($from)) {
	    print("$afrom\n");
	} else {
	    print("$from\n");
	}
	print("$to\n");
	print("$subject\n");
	print("$date\n");
	print("Size: $msize\n");
	
    	print("Disposition (" . join('', sort(keys(%action))) . "): ");
    	$disp = <STDIN>;
	chop($disp);
	if ((length($disp) > 0) && (!defined($action{substr($disp, 0, 1)}))) {
	    print("\nDisposition \"$disp\" undefined.  Enter ? for help.\n");
	    $disp = '';
	} else {
	    if (length($disp) > 0) {
	    	$act = $action{substr($disp, 0, 1)};
	    } else {
	    	$act = '';
		$disp = 'default';  	# Can be anything, so long as it isn't null
	    }
	    if (length($act) > 0) {
		if ($act eq 'QUIT') {
		    while (1) {
		    print("Really quit? (yn): ");
			$disp = <STDIN>;
			#   We accept 'q' as a synonym for 'y' Lynx-style, since it's
			#   much faster to type when you're furiously testing.
			if ((substr($disp, 0, 1) eq 'y') ||
		    	    (substr($disp, 0, 1) eq 'q')) {
		    	    undef $l;
			    last;
			} elsif (substr($disp, 0, 1) eq 'n') {
		    	    $disp = '';
			    last;
			}
		    }
		} elsif($act eq 'VIEW') {
		    &view_message;
		    $disp = '';
		} elsif ($act eq 'SEARCH') {
		    &search_messages;
		} elsif ($act eq 'BACK') {
		    if ($#backStack > 1) {
		    	pop(@backStack);
			pop(@backStack);
			seek(IN, $backStack[$#backStack], 0);
			$l = <IN>;
		    } else {
		    	print("At start of folder.\n");
			seek(IN, 0, 0);
			undef(@backStack);
			$l = <IN>;
			push(@backStack, 0);
		    	$disp = '';
		    }
		} elsif($act eq 'HELP') {
		    &printHelpText;
		    $disp = '';
		} else {
		    if ($act eq 'FILE') {
		    	print("File name: ");
		    	$act = <STDIN>;
			chop($act);
		    }
		    if (length($act) > 0) {
		    	if (open(OF, ">>$act")) {
			    for ($i = 0; $i < $nlines; $i++) {
		    		print(OF "$message[$i]\n");
			    }
			    close(OF);
			} else {
			    print("Cannot append message to file $act\n");
			    $disp = '';
			}
		    } else {
		    	$disp = '';
		    }
		}
	    }
	}
    }
}

#   Print help text for disposition prompt

sub printHelpText {
    local($k);
    
    print << "EOS";
    
b      Back to previous message
d      Display next message
f      Save in user-defined file
q      Quit
v      View message
/pat   Search for regular expression (+pat to find substring)
?      Print this message
EOS
    foreach $k (sort(keys(%action))) {
    	if ((length($action{$k}) > 0) &&
	    (!($action{$k} =~ m/^[A-Z]/))) {
	    print("$k      Save in folder \"$action{$k}\"\n");
	}
    }
}

#   Trim end of line sequences from line

sub trim_end_of_line {
    $l =~ s/(.*)([\r\n]+)$/\1/;
}

#   View text of message (like "more")

sub view_message {
    local($n, $page, $nx, $a, $ac);
    
    $page = 24;     	    # Page length
    $n = 0;
main:
    while (1) {
    	$nx = (($n + $page) < $nlines) ? ($n + $page) : $nlines;
    	for (; $n < $nx; $n++) {
	    print("$message[$n]\n");
	}
    	if ($nx < $nlines) {
	    while (1) {
		printf("--More--(%d%%) (bnq?): ", int(($nx * 100) / $nlines));
		$a = <STDIN>;
		chop($a);
		$ac = substr($a, 0, 1);
		if ((length($ac) == 0) || ($ac eq 'n')) {
		    last;
		}
		if ($ac eq 'q') {
	    	    last main;
		}
		if ($ac eq 'b') {
	    	    if ($n >= (2 * $page)) {
			$n -= 2 * $page;
		    } else {
			$n = 0;
		    }
	    	    next main;
		}
		if ($ac eq '?') {
		    print << "EOF";
		    
b     Back one page
n     Next page (blank line equivalent to n)
q     Quit viewing--back to disposition menu
?     Print this message
EOF
		}
	    }
	} else {
	    last;
	}
    }
}

#   Search messages for pattern.  You can abort a search
#   with ^C, which returns to the position in the folder
#   where the search began.  Note that the pattern is a
#   Perl regular expression, which is matched case-insensitive,
#   except if the first character is "+" (which is not valid
#   in a regular expression), in which case the following text
#   is matched explicitly, again ignoring case.

sub blooie {	    	    # Allow ^C to stop runaway search
    $searching = 0;
    print("^C terminated search.\n");
}

sub search_messages {
    local($startpos, $s, $msgpos, $lpos, @bsback, $lcp, $lcs);

    $SIG{'INT'} = 'blooie';
    chop($disp);
    if (length($disp) > 1) {
    	$pattern = substr($disp, 1);
    }
    if (length($pattern) == 0) {
    	print("Search pattern: ");
	$pattern = <STDIN>;
	chop($pattern);
    }

    $startpos = tell(IN);
    $searching = 1;
    @bsback = @backStack;
    $lcp = substr($pattern, 1);
    $lcp =~ tr/A-Z/a-z/;
    while ($searching) {
    	$lpos = tell(IN);
    	if (!($s = <IN>)) {
	    last;
	}
    	if ($s =~ m/^From /) {
	    $msgpos = $lpos;
	    push(@backStack, $lpos);
	}
	if ($pattern =~ m/^\+/) {
	    $lcs = $s;
	    $lcs =~ tr/A-Z/a-z/;
#    print("($lcp) ($lcs)\n");
	    if (index($lcs, $lcp) != -1) {
    		seek(IN, $msgpos, 0);
    		$l = <IN>;
    		$SIG{'INT'} = 'DEFAULT';
    		return;
	    }
	} elsif ($s =~ m/$pattern/i) {
    	    seek(IN, $msgpos, 0);
    	    $l = <IN>;
    	    $SIG{'INT'} = 'DEFAULT';
    	    return;
	}
    }
    print("No find.\n");
    seek(IN, $startpos, 0);
    @backStack = @bsback;
    $SIG{'INT'} = 'DEFAULT';
}