#! /usr/local/bin/perl
# $Id: rfl,v 1.3 1995/12/04 20:39:59 jerry Exp $
### rfl - add message(s) to digest archive(s)
### Usage: rfl [-help] [-verbose] [-inplace] [-query] [-keep]
###     [-noverbose] [-noinplace] [-noquery] [-nokeep]
##      [-add component [-add component...]]
###     [[-range msgrange] OR [-to msg]]
###     [-src folder] [msgs] [+dest-fdr OR @dest-fdr]

# NOTES TO HACKERS: TABSTOPS IN THIS CODE SET AT 4
# "***" MARKS COMMENTS ON THINGS THAT NEED TO BE THOUGHT ABOUT OR FIXED.

# DISCLAIMER: USE THIS CODE AT YOUR OWN RISK.  THE AUTHOR(S) CANNOT BE
# RESPONSIBLE FOR ANY PROBLEMS YOU HAVE WITH THE SCRIPT OR ANY DAMAGES
# THAT THIS SCRIPT CAUSES, DIRECTLY OR INDIRECTLY.  THE USER IS ASSUMED
# TO UNDERSTAND MH AND PERL WELL ENOUGH TO DECIDE WHETHER OR NOT THIS
# SCRIPT IS SUITABLE AND WILL WORK CORRECTLY.  ETC. ETC.
#
# THIS PROGRAM IS IN THE PUBLIC DOMAIN.  IF YOU MODIFY IT, PLEASE ADD
# COMMENTS TO THE CODE THAT MARK YOUR REVISIONS CLEARLY (SO PEOPLE WILL
# KNOW THAT IT ISN'T THE ORIGINAL rfl).  PLEASE ALSO SEND ME A COPY OF ANY
# CHANGES YOU MAKE SO THAT I CAN THINK ABOUT FOLDING THEM INTO A NEW RELEASE.
# I'M ALWAYS GLAD TO GET BUG REPORTS AND SUGGESTIONS!  MY ADDRESS IS
# jpeek@jpeek.com.  THANKS.  --Jerry Peek


# FOR PARSING MH PROFILE ENTRY (MAY HAVE QUOTING LIKE  -range "first:10 last:5")
require "shellwords.pl";
require 'ctime.pl';             # FOR &fake_date

($myname = $0) =~ s@/.*/@@;     # PROGRAM'S BASENAME (COULD BE NAME OF LINK)
$sepname = "rfl";               # USED IN $sepstring.  COULD CHANGE TO $myname.

#
# HANDLE SOME SIGNALS.  DON'T CATCH SIGQUIT SO WE CAN ABORT RIGHT AWAY --
# AN EASY WAY TO DUMP CORE AND NOT REMOVE MESSAGES.
#

$SIG{'HUP'} = 'handler';
$SIG{'INT'} = 'handler';
$SIG{'TERM'} = 'handler';


#
# SET DEFAULTS (PARTLY TO KEEP perl -w FROM COMPLAINING):
#

($no, $yes) = (0, 1);
($destfolname, $srcfolname) = ("","");
($destmsgline, $srcmsgline) = (0,0);    # INDEX INTO @destmsgtext, @srcmsgtext
($debug, $inplace, $keep, $query, $verbose) = ($no, $yes, $no, $no, $no);
($rflag, $tflag) = ($no, $no);  # SET TO $yes IF -r OR -t USED, RESPECTIVELY
$sflag = $no;                   # SET TO $yes IF -src USED
@tormm = ();                    # MESSAGES TO rmm BEFORE EXITING
$* = 1;                         # MAKE STRING-MATCHING EXPECT TO SEE NEWLINES 


#
# SET ASSORTED VARIABLES.
#
# NOTES: PICK ONE OF THE $mhprfprg VARIABLES (USE mhparam IF YOU HAVE MH 6.8).
# IF YOU CHANGE $marker, THEN rfl WON'T RECOGNIZE ANY OF ITS DIGESTS CREATED
# WITH THE PREVIOUS $marker HEADING!
#

$defpager = "/usr/bin/more";    # DEFAULT PAGER (IF NO $PAGER ENVARIABLE) FOR -q
# *** USE pick INSTEAD OF mhpath TO GET AROUND LIMIT?  IT'S A LOT SLOWER.  ***
$destrange = "last:998";        # DEFAULT -range; mhpath CAN ONLY HANDLE 998!
@digesthdr = ('subject','from','to');       # COPY TO DIGEST HEADER (WITH -add)
$folopts = "-norecurse -nopack -noheader";  # folder OPTS. (OVERRIDE MH PROFILE)
$marker = "X-mhglue";           # FIELD ADDED TO SHOW THAT rfl WAS USED
$list_shown = $no;
$mhbin = "/usr/local/mh/bin";       # WHERE (MOST) MH BINARIES LIVE
$mhprfprg = "$mhbin/mhparam";               # READS MH PROFILE  <<< PICK <<<
#$mhprfprg ="/home/jerry/.bin/mhprofile -b";    # READS MH PROFILE  <<< ONE  <<<
$scanopts = "-reverse -noheader -noclear";  # scan OPTIONS (OVERRIDE MH PROFILE)

$sepdashes = "------------------------------";  # BEFORE FIRST MESSAGE
($dummy, $sepnum, $dummy2) = split(/ /, '$Revision: 1.3 $');    # RCS EDITS THIS
$sepstring = "$sepdashes $sepname $sepnum";     # BETWEEN DIGEST MESSAGES


#
# VARIABLES SET BY COMMANDS:
#

$mhdirpath = `$mhbin/mhpath +` ||       # PATH TO MH DIRECTORY
    die "$myname quitting: can't get path to your MH directory.\n$!\n";
chop $mhdirpath;
$profline = `$mhprfprg $myname`;    # PROFILE SWITCHES FOR THIS SCRIPT
if ($profline ne "") {
    chop $profline;
    @profwords = &shellwords($profline);
    unshift(@ARGV, @profwords);     # Add profile to start of command line args
}

# FILE LISTING FIELDS NOT TO COPY TO SAVED MSGS
$skipfile = "$mhdirpath/$myname.skiphdrs";


#
#   ckfolder
#
# CHECK FOLDER ARGUMENT LIKE +fdr OR @fdr (IF NO ARGUMENT, DOES CURRENT FOLDER).
# RETURN ARRAY WITH FULL FOLDER NAME (LIKE folder -fast WOULD GIVE)
# AND FOLDER'S FULL PATHNAME (FROM mhpath).
# IF USER GIVES A BOGUS FOLDER NAME, folder WILL ASK IF YOU WANT TO Create?
# WE WANT TO DIE IF FOLDER DOESN'T EXIST, SO WE USE THIS KLUDGE (SIGH):
#
sub ckfolder {
    local($folpath) = `$mhbin/mhpath @_` ||
        die "$myname: ckfolder: mhpath @_ bombed!?!\n";
    chop $folpath;
    if (-d $folpath && -x $folpath) {
        if ($folpath =~ /^$mhdirpath\//o) { # FOLDER IS UNDERNEATH MH DIRECTORY
            local($folname);
            ($folname = $folpath) =~ s@^$mhdirpath/@@;
            return($folname, $folpath);
        }
        else {                              # FOLDER IS OUTSIDE MH DIRECTORY
            return($folpath, $folpath);
        }
    }
    else {
        print STDERR "$myname: ckfolder: bzzzzzt: can't access folder '@_'.\n";
        exit(1);
    }
}


#
#   cleansubj
#
# STRIP LEADING "Re:", "re:", etc. AND LEADING/TRAILING (Fwd) FROM $_
#
sub cleansubj {
    local($dirty) = @_;
    local($subj);
    # STRIP OFF ALL RE:'S (BY Owen Rees <rtor@ansa.co.uk>):
    ($subj = $dirty) =~ s/^(re:[ \t]*)*//i;
    # STRIP OFF LEADING/TRAILING (Fwd), (fwd), etc.:
    $subj =~ s/^\(fwd\) *//i;
    $subj =~ s/ *\(fwd\) *$//i;
    # STRIP OFF ALL RE:'S AFTER ANY LEADING (fwd), SIGH...:
    $subj =~ s/^(re:[ \t]*)*//i;
    return ($subj);
}

#
#   fake_date
#
# COMPUTE A VALID DATE FIELD SUITABLE FOR MAIL HEADER
# WRITTEN BY:  Raphael Manfredi <ram@acri.fr>
#
sub fake_date {
    local($date) = &ctime(time);    # Ctime adds final new-line
    # Traditionally, MTAs add a ',' right after week day
    $date =~ s/^(\w+)(\s)/$1,$2/;
    $date;
}


#
#   handler
#
# HANDLE SIGNALS.
#
# FIRST ARGUMENT IS SIGNAL NAME.
#
sub handler {
    local($sig) = @_;
    print STDERR "\n$myname: ouch!  (Caught signal $sig.)  Quitting early...\n";
    &rmm_exit(1);
}


#
#   help
#
# PRINT LIST OF OPTIONS
#
sub help {
    print <<EOH;
syntax: $myname [+dest-fdr] [msgs] [switches]
  switches are:
  -add component
  -[no]inplace
  -[no]keep
  -[no]query
  -range msgs
  -src +folder
  -to msg
  -[no]verbose
  -(help)

EOH
    print '$Id: rfl,v 1.3 1995/12/04 20:39:59 jerry Exp $', "\n";
}


#
#   prochdr
#
# PROCESS HEADER FROM MESSAGE LINES ARRAY IN FIRST ARGUMENT.
#
# RETURNS FOUR SCALAR VARIABLES:
#   - HEADER LINES FOR DIGEST TOP (LISTED IN @digesthdr)
#   - HEADER LINES FOR BODY OF DIGEST (THE FIELDS NOT IN @skiplist)
#   - SUBJECT TEXT WITHOUT Subject:; OR LEADING Re:, re:; OR (Fwd) AT START/END
#   - INTEGER INDEX INTO MESSAGE LINES ARRAY AT END OF HEADER (START OF BODY)
#   - $yes IF MESSAGE HAS A $marker FIELD, $no IF IT DOESN'T
#
sub prochdr {
    local(@msg) = @_;
    local($text, $subject, $dhdr, $digesthdrs, $bodyhdrs, $header, $isdigest) =
        ("","","","","","",$no);    # INITIALIZE ALL TO KEEP perl -w HAPPY

    local($again) = $no;
    READHDR:
    for ($msgline = 0; $msgline <= @msg; $msgline++) {
        $text = $msg[$msgline];
        last if ($text =~ /^$/);    # QUIT AT END OF HEADER

        # IF WE'RE NOT REPEATING LOOP TO BUILD HEADER (IF $again IS $no),
        # INITIALIZE LOOP STUFF.  ELSE, APPEND $text TO $header:
        if ($again == $no) {
            $header = $text;
            # PUT LOWER-CASE FIELD NAME (LIKE from) INTO $_:
            $_ = $header;
            s/^([^:]+):.*/\1/;
            tr/A-Z/a-z/;
            chop;
        }
        else {
            $again = $no;
            $header = "$header$text";
        }

        # LOOK AHEAD AT NEXT LINE.  IF IT'S A CONTINUATION, APPEND TO $header
        # BY SETTING $again AND RE-STARTING THE LOOP.
        if ($msg[$msgline + 1] =~ /^[ \t]/) {
            $again = $yes;
            next READHDR;
        }

        # SAVE $digesthdrs (FIELDS WE WANT COPIED TO TOP OF THE DIGEST):
        foreach $dhdr (@digesthdr) {
            if ($dhdr eq $_) {
                if (/subject/ && $subject eq "") {
                    #
                    # PUT SUBJECT TEXT (NO Subject:, Re:, OR (Fwd))
                    # INTO $subject.
                    # WE ONLY GRAB THE FIRST SUBJECT IN A MESSAGE; IF MESSAGE
                    # IS ALREADY A rfl DIGEST, THIS GRABS THE "DIGEST SUBJECT".
                    #
                    chop($subject = $header);
                    $subject =~ s/^subject:[ \t]*(.*)/\1/i;
                    # STRIP OFF ALL RE:'S AND (FWD)'S:
                    $subject = &cleansubj($subject);
                    # repl COMPRESSES NEWLINES AND MULTIPLE SPACES/TABS INTO
                    # ONE SPACE.  SO THAT WE CAN FIND ORIGINAL MESSAGES AND
                    # REPLIES, WE DO THAT TOO.
                    $subject =~ s/\n/ /g;
                    $subject =~ s/[ \t][ \t]+/ /g;
                }
                # STRIP OFF TRAILING WHITESPACE:
                $header =~ s/[ \t]*$//;
                $subject =~ s/[ \t]*$//;
                # COPY OR APPEND NEW FIELD TO $digesthrs.
                # FOR Subject:, USE HEADER WITH MASHED NEWLINES AND WHITESPACE.
                $digesthdrs .= (/subject/ ? "Subject: $subject\n" : $header);
                last;
            }
        }

        # IF IT'S A MARKER FIELD, SET FLAG:
        if (/$marker/i) {
            $isdigest = $yes;
        }

        # BUILD LIST OF FIELDS TO COPY TO BODY IN $bodyhdrs VARIABLE.
        # IF FIELD IS IN @skiplist (IGNORE CASE!), SKIP IT.
        # BIG WIN OVER mhl: WILDCARDS LIKE x-.* SKIP ALL X-WHATEVER: FIELDS!
        #
        # DO TEST HERE SO THAT WE CAN GRAB $digesthdrs (ABOVE) FOR DIGEST HEADER
        # BUT NOT COPY SOME OF THOSE TO DIGEST BODY IF THEY DON'T WANT TO:
        foreach $skiphdr (@skiplist) {
            next READHDR if /^$skiphdr$/i;
        }
        $bodyhdrs .= "$header";
    }
    return($digesthdrs, $bodyhdrs, $subject, $msgline, $isdigest);
}


#
#   rmm_exit
#
# REMOVE ANY MESSAGES IN @tormm AND EXIT WITH THE STATUS IN FIRST ARGUMENT.
# IF THERE'S A MESSAGE IN THE SECOND ARGUMENT, PRINT TO STDERR BEFORE EXITING.
# THIS LETS YOU USE rmm_exit AS A REPLACEMENT FOR die OR exit.
#
# ONLY USE THIS SUBROUTINE AFTER WE START TO READ THE SOURCE MESSAGES.
# (@srcfolder WILL BE DEFINED THEN.)  BEFORE THAT, USE die OR exit.
#
sub rmm_exit {
    ($status, $msg) = @_;
    # REMOVE MESSAGES IF THEY DIDN'T USE -keep:
    if ($keep == $no && @tormm != 0) {
        if ($verbose == $yes) {
            print "$myname: removing @tormm from $srcfolder[0].\n";
        }
        # USE +$srcfolder[0] IN CASE USER CHANGED FOLDER SOMEHOW WHILE THIS
        # WAS RUNNING (LIKE MAYBE DURING -query, TO VIEW A MESSAGE).
        # *** TEST rmm EXIT STATUS; CHANGE $status IF rmm BOMBS?
        system("$mhbin/rmm @tormm +$srcfolder[0]");
    }
    if ($msg ne "") {
        print STDERR "$msg\n";
    }
    exit($status);
}


#
#   uniqhdr
#
# REMOVE DUPLICATE HEADER LINES FROM ARGUMENT
#
# RETURNS ONE SCALAR VARIABLE
#   - ONE OF EACH LINE IN ORDER OF APPEARANCE
#
# WRITTEN BY Owen Rees <rtor@ansa.co.uk>
# (ADAPTED FOR MULTIPLE-LINE FIELDS BY JERRY)
#
# *** SOME DAY, SHOULD PARSE ADDRESSES (WITH ap, ETC.) FOR COMPARISONS...
sub uniqhdr {
    local(%seen);
    local($line,$result)=("","");
    local($toread) = @_;

    # READ THROUGH $toread.  SLICE OFF ONE (POSSIBLY MULTI-LINE) FIELD
    # IN EACH PASS OF THE LOOP; LEAVE THE REST IN $toread FOR THE NEXT PASS.
    until ($toread eq "\n") {
        $toread =~ s/(^[^\n]+\n([ \t][^\n]*\n)*)//;
        $line = $1;     # THE FIELD WE PROCESS NOW
        
        $line =~ s/^(subject:\s+)((re:\s+)+)/$1/i;
        unless ($seen{$line}) {
            $result .= "$line";
            $seen{$line} = $yes;
        }
    }
    return("$result\n");    # UNIQUE FIELDS, PLUS NEWLINE EATEN ABOVE
}


#
#   usage
#
# PRINT USAGE MESSAGE AND EXIT WITH STATUS GIVEN IN ARGUMENT:
sub usage {
    local($status) = @_;
    print STDERR <<EOH;
Usage: $myname [-help] [-verbose] [-inplace] [-query] [-keep]
    [-noverbose] [-noinplace] [-noquery] [-nokeep]
    [-add header [-add header...]]
    [[-range msgrange] OR [-to msg]]
    [-src folder] [msgs] [+dest-fdr OR \@dest-fdr]

EOH
    print STDERR '$Id: rfl,v 1.3 1995/12/04 20:39:59 jerry Exp $', "\n";
    exit($status);
}


#
# PARSE COMMAND LINE.
#

for ($i = 0; $i <= $#ARGV; $i++) {
    $_ = $ARGV[$i];
    if (/^-h/) {
        &help;
        exit(0);
    }
    elsif (/^-a/) {
        $i++;
        local($nextarg) = $ARGV[$i];
        if ($nextarg =~ /:$/) {
            print STDERR "$myname quitting: no colon (:) in '$_ $nextarg', please.\n";
            &usage(1);
        }
        else {
            push(@digesthdr, $nextarg);
        }
    }
    elsif (/^-d/) {
        $debug = $yes;
    }
    elsif (/^-i/) {
        $inplace = $yes;
    }
    elsif (/^-k/) {
        $keep = $yes;
    }
    elsif (/^-nod/) {
        $debug = $no;
    }
    elsif (/^-noi/) {
        $inplace = $no;
    }
    elsif (/^-nok/) {
        $keep = $no;
    }
    elsif (/^-noq/) {
        $query = $no;
    }
    elsif (/^-nov/) {
        $verbose = $no;
    }
    elsif (/^-q/) {
        $query = $yes;
    }
    elsif (/^-r/) {
        $i++;
        local($nextarg) = $ARGV[$i];
        if ($nextarg eq "" || $nextarg =~ /^[-+@]/) {
            print STDERR "$myname quitting: bogus range in '$_ $nextarg'.\n";
            &usage(1);
        }
        else {
            if ($tflag == $yes) {
                $tflag = $no;
                if ($verbose == $yes) {
                    print STDERR "$myname warning: '-range $nextarg'",
                        " overriding previous '-to $destrange'.\n";
                }
            }
            $rflag = $yes;
            $destrange = $nextarg;
        }
    }
    elsif (/^-s/) {
        $i++;
        local($nextarg) = $ARGV[$i];
        if ($nextarg !~ /^[+@]/) {
            print STDERR "$myname quitting: bogus folder in '$_ $nextarg'.\n";
            &usage(1);
        }
        else {
            $sflag = $yes;
            $srcfolname = $nextarg;
        }
    }
    elsif (/^-t/) {
        $i++;
        local($nextarg) = $ARGV[$i];
        if ($nextarg eq "" || $nextarg =~ /^[-+@]/) {
            print STDERR "$myname quitting: bogus message number",
                " in '$_ $nextarg'.\n";
            &usage(1);
        }
        else {
            if ($rflag == $yes) {
                $rflag = $no;
                if ($verbose == $yes) {
                    print STDERR "$myname warning: '-to $nextarg'",
                        " overriding previous '-range $destrange'.\n";
                }
            }
            $tflag = $yes;
            $destrange = $nextarg;
        }
    }
    elsif (/^-v/) {
        $verbose = $yes;
    }
    elsif (/^[+@]/) {
        if ($destfolname eq "") {
            $destfolname = $_;
        }
        else {
            print STDERR "$myname quitting: $_?",
                "  Only one destination folder, please!\n";
            &usage(1);
        }
    }
    elsif (/^-/) {
        print STDERR "$myname: unknown option '$_'.\n";
        &usage(1);
    }
    else {
        push(@msgargs, $_);
    }
}


#
# CHECK/SET DEFAULTS.
#

# IF -query AND -to BOTH SET, IGNORE THE -query BECAUSE IT MAKES CODING SIMPLER.
# ALSO DO THIS BECAUSE THEY PROBABLY HAVE -query SET IN THE MH PROFILE AND
# WANT -to TO WORK THIS WAY:
if ($tflag == $yes && $query == $yes) {
    $query = $no;
    if ($verbose == $yes) {
        print STDERR "$myname WARNING: '-to $destrange' is overriding -query.\n";
    }
}

@msgargs = "cur" if @msgargs == 0;          # DEFAULT SOURCE MESSAGE: cur
$srcfolname = "@." if $srcfolname eq "";    # DEFAULT SOURCE FOLDER: CURRENT
$destfolname = "@." if $destfolname eq "";  # DEFAULT DESTINATION FOLDER: CURRENT


#
# MORE OVERALL SETUP:
#
# SET/CHECK SOURCE FOLDER AND DESTINATION FOLDER:
# ARRAY[0] HAS FULL FOLDER NAME, ARRAY[1] HAS FOLDER'S FULL PATHNAME:
#
@destfolder = &ckfolder($destfolname);
@srcfolder = &ckfolder($srcfolname);
# IF SOURCE FOLDER IS SAME AS DESTINATION, SET FLAG:
$samesrcdest = ($srcfolder[1] eq $destfolder[1]) ? $yes : $no;
# READ $skipfile FILE (FIELDS NOT TO COPY TO DEST MSG) INTO @skiplist ARRAY:
if (-f $skipfile && -r $skipfile) {
    open(SKIPFILE, $skipfile) || die ("$myname: can't open $skipfile.\n$!\n");
}
$i = 0;
while (<SKIPFILE>) {
    tr/A-Z/a-z/;
    chop;
    @skiplist[$i] = $_;
    $i++;
}


#
# GET DESTINATION MESSAGE NUMBERS (THIS IS MUCH FASTER THAN USING pick)
# AND cd TO DESTINATION FOLDER.
#

# *** HOW CAN WE MAKE THIS DIE IF mhpath RETURNS A 1 STATUS? ***
open(DESTMSGFILES, "$mhbin/mhpath $destrange +$destfolder[0] |") ||
    die "$myname quitting: can't get message numbers: $!\n";
# REVERSE LIST OF DESTINATION MESSAGES (WE WANT TO FIND MOST-RECENT MATCH):
{ local(@temp) = <DESTMSGFILES>; @destmsgfiles = reverse(@temp); }
close DESTMSGFILES;
if (@destmsgfiles == 0) {
    print STDERR "$myname quitting: no destination message(s)?\n";
    exit(1);
}
elsif ($tflag == $yes && @destmsgfiles != 1) {
    print STDERR "$myname quitting: '-to $destrange' is bogus.",
        "  Only one message, please.\n";
    exit(1);
}
# cd TO FOLDER -- MORE EFFICIENT THAN READING EACH MSG THROUGH LONG PATHNAME:
chdir $destfolder[1] ||
    die "$myname quitting: Can't cd to $destfolder[1]:\n$!\n";
# STRIP LEADING PATHNAMES.  THIS LEAVES JUST THE MESSAGE FILENAMES (NUMBERS):
for (@destmsgfiles) {
    chop;
    s@/.*/@@;
}

#
# GET FIRST SUBJECT ("DIGEST SUBJECT") OF EACH MESSAGE INTO @destsubj ARRAY.
# (BUT SKIP THIS IF THEY USED -to OR -query; WE WON'T NEED SUBJECT THEN.)
#

if ($tflag != $yes && $query != $yes) {
    for (@destmsgfiles) {
        local($destmsgfile) = $_;
        open(DESTMSGFILE, $destmsgfile) ||
            warn "$myname WARNING: can't open message $destmsgfile in +$destfolder[0]:\n$!\n";
        local($thissubj,$readmore) = ("",$no);
        while($line = <DESTMSGFILE>) {
            last if $line =~ /^$/;  # QUIT AT END OF HEADER
            last if (($readmore == $yes) && ($line !~ /^[ \t]/));

            if ($line =~ /^subject:[ \t]*(.*)/i) {
                $thissubj = $1;     # IMPLICIT chop
                $readmore = $yes;   # SEE IF THE SUBJECT HAS MORE LINES
                $thissubj = &cleansubj($thissubj);  # STRIP RE:'S AND (FWD)'S
            }
            elsif ($readmore == $yes) {
                # PREVIOUS LINE(S) WERE Subject:.  CONTINUATIONS ARE INDENTED.
                # READ MORE LINES UNTIL WE GET TO THE NEXT FIELD,
                # EMPTY LINE, OR EOF.  THIS GRABS MULTI-LINE SUBJECTS.
                #
                # NOTE: THIS DOES *NOT* GRAB MULTIPLE LINES THAT ALL START
                # WITH Subject:.  THAT MEANS THAT THE SCRIPT WILL ONLY GRAB
                # THE FIRST Subject: (WHAT I'M CALLING THE "DIGEST SUBJECT")
                # IN AN rfl DIGEST.
                if ($line =~ /^[ \t]/) {
                    chop $line;
                    $line =~ s/[ \t]*$//;   # NUKE TRAILING WHITESPACE
                    $thissubj .= " $line";  # EMBED A SPACE
                }
                else {
                    last;
                }
            }
        }
        $thissubj =~ s/[ \t]*$//;   # NUKE TRAILING WHITESPACE
        # repl COMPRESSES NEWLINES AND MULTIPLE SPACES/TABS INTO ONE SPACE.
        # SO THAT WE CAN FIND ORIGINAL MESSAGES AND REPLIES, WE DO THAT TOO:
        $thissubj =~ s/\n/ /g;
        $thissubj =~ s/[ \t][ \t]+/ /g;
        $destsubj[$destmsgfile] = $thissubj;
        close DESTMSGFILE ||
            die "$myname quitting: can't close $destfolder[1]/$destmsgfile:\n$!\n";
    }
}


#
# READ SOURCE MESSAGES
#

# CHANGE FOLDER TO SOURCE FOLDER; BE SURE folder GIVES SAME ANSWER.
# DON'T NEED TO CHANGE FOLDER IF DIDN'T USE -src SWITCH, SO TEST $sflag FIRST:
if ($sflag == $yes) {
    if (`$mhbin/folder -fast $folopts +$srcfolder[0]` ne "$srcfolder[0]\n") {
        print STDERR "$myname quitting: can't set current folder",
            " to '$srcfolder[0]'!?!\n";
        exit(1);
    }
}


#
# GET ALL MESSAGE NUMBERS (THIS IS MUCH FASTER THAN scan -format '%(msg)'):
#
# *** HOW CAN WE MAKE THIS DIE IF mhpath RETURNS A 1 STATUS? ***
# *** (LIKE WHEN YOU GET mhpath: no cur message)? ***
open(SRCMSGFILES, "$mhbin/mhpath @msgargs |") ||
    die "$myname quitting: can't run mhpath: $!\n";
@srcmsgfiles = <SRCMSGFILES>;
close SRCMSGFILES;
if (@srcmsgfiles == 0) {
    print STDERR "$myname quitting: can't find source message(s)?\n";
    exit(1);
}
chdir $srcfolder[1] ||
    die "$myname quitting: Can't cd to $srcfolder[1]:\n$!\n";
# STRIP LEADING PATHNAMES.  THIS LEAVES JUST THE MESSAGE FILENAMES (NUMBERS):
for (@srcmsgfiles) {
    s@/.*/@@;
}


#
# LOOP THROUGH SOURCE MESSAGES ONE BY ONE AND PROCESS THEM.
#
# *** OPTIMIZATION: IF HAVE MORE THAN ONE SOURCE MESSAGE THAT'll BE ADDED
# *** TO SAME DESTINATION MESSAGE, PROGRAM SHOULD BE DIFFERENT.
# *** INSTEAD OF RE-READING AND RE-BUILDING THE DESTINATION MESSAGE
# *** FOR EACH SOURCE MESSAGE, SHOULD ADD ALL SOURCE MESSAGES AT ONCE.
# *** WITH -query, IT'S HARDER BECAUSE WE DON'T KNOW ALL THE DESTINATION
# *** MESSAGES UNTIL LATER.  MAYBE WAIT UNTIL END, BUILDING A BIG ARRAY
# *** WITH ALL DESTINATION MESSAGE NUMBERS AND SOURCE MESSAGE(S) TO ADD
# *** TO THEM?  THEN WE COULD DO ALL MERGING IN ONE BIG OPERATION.

SRCMSGLOOP:
for ($i = 0; $i <= $#srcmsgfiles; $i++) {
    local($newdigest) = $no;    # IF $yes, CREATE NEW -noinplace DIGEST
    chop($srcmsgfiles[$i]);
    local($srcmsgfile) = $srcmsgfiles[$i];
    if (!open(SRCMSGFILE, $srcmsgfile)) {
        warn "$myname WARNING: can't open message $srcmsgfile in +$srcfolder[0]:\n$!\n";
        next;
    }
    
    @srcmsgtext = <SRCMSGFILE>;
    close SRCMSGFILE ||
        &rmm_exit (1, "$myname quitting: can't close $srcfolder[1]/$srcmsgfile:\n$!\n");
    ($srcdigesthdrs, $srcbodyhdrs, $srcsubj, $srcmsgline, $srcisdigest) =
        &prochdr(@srcmsgtext);
    if ($debug == $yes) {
        print "\n$myname: srcdigesthdrs has:\n$srcdigesthdrs\n\n";
        print "$myname: srcbodyhdrs has:\n$srcbodyhdrs\n\n";
    }

    # I'M NOT SMART ENOUGH TO HANDLE THIS YET:
    if ($srcisdigest == $yes) {
        print STDERR "$myname WARNING: skipping message $srcmsgfile:\n";
        print STDERR "  I can't add an $myname digest",
            " to another $myname digest (yet).\n";
        next SRCMSGLOOP;
    }

    #
    # IF -to USED, WE'VE GOT DESTINATION MESSAGE NUMBER (WE HOPE!).
    # ELSE, TEST FOR -query SWITCH AND DO THE RIGHT THING.
    # ELSE, IF -noinplace IS SET AND WE'VE ALREADY FOUND A NEW MESSAGE NUMBER
    # FOR THE MESSAGE, USE IT.
    #
    # BUT NEVER LET THEM ADD A MESSAGE TO ITSELF.  IT WOULD WORK,
    # BUT IT'S ALWAYS A MISTAKE (I THINK!).  TO FIND OUT, CHECK PATHNAME.
    if ($tflag == $yes) {
        $destmsgnum = $destmsgfiles[0];
        if ($samesrcdest == $yes && $destmsgnum == $srcmsgfile) {
            print STDERR "$myname WARNING: skipping message $srcmsgfile:";
            print STDERR " I won't add that message to itself!\n";
            next SRCMSGLOOP;
        }
    }
    elsif ($query == $yes) {
        #
        # scan DESTINATION MESSAGES.
        # USE TEMPORARY CONTEXT SO WE DON'T CHANGE MH CURRENT FOLDER.
        #

        local($ans, $maybe_ans) = ("", "");
        GETMSGNUM:
        for (;;) {
            # NOTE: IF PAGER CLEARS SCREEN OR USES ALTERNATE SCREEN,
            # THAT MIGHT HIDE rfl'S PROMPTS.  ANSWER: FIX THE STUPID PAGER.
            # FOR NOW, THOUGH, WE ASK THEM TO PRESS RETURN TO RUN PAGER:
            print "\n$myname: this message is:\n  $srcmsgfile $srcsubj\n";
            print "Press RETURN to list messages you can append it to";
            print "\n    or enter message number now" if ($list_shown == $yes);
            print ": ";
            $maybe_ans = <STDIN>;
            chop $maybe_ans;

            # NOTE: scan LIST OF MESSAGE NUMBERS (@destmsgfiles), *NOT*
            # ORIGINAL $destmsgrange (LIKE last:20), BECAUSE $destmsgrange
            # CAN BE A MOVING TARGET IF -noinplace CREATES NEW DIGEST MESSAGES.
            #
            # IF $maybe_ans LOOKS LIKE A MESSAGE NUMBER, COPY IT TO $ans.
            # ELSE, scan LIST AND PROMPT FOR NUMBER.
            #
            if ($maybe_ans =~ /^[ \t]*[1-9]/) {
                $ans = "$maybe_ans";
            }
            else {
                # NOTE: VARIABLES WITHOUT \ BEFORE THE $ ARE EXPANDED BY PERL:
                system("MHCONTEXT=/tmp/RFL$$ $mhbin/scan $scanopts +$destfolder[0] @destmsgfiles | \${PAGER-$defpager}; /bin/rm -f /tmp/RFL$$");
                $list_shown = $yes;
                print "Enter message number to append to; 0 to skip, q to quit: ";
                $ans = <STDIN>;
                chop $ans;
            }
            $maybe_ans = "";

            if ($ans =~ /^[ \t]*[qQ]/) {
                print "$myname: quitting early.\n";
                &rmm_exit(0);
            }
            elsif ($ans =~ /^[ \t]*0/) {
                print "$myname: skipping message $srcmsgfile.\n";
                next SRCMSGLOOP;
            }
            elsif ($samesrcdest == $yes && $ans == $srcmsgfile) {
                print "$myname: '$ans'?",
                    "  Sorry, I won't add message $srcmsgfile to itself.\n";
                print "Please try again.\n";
                next GETMSGNUM;
            }

            # IF WE GET HERE, THEY GAVE A VALID MESSAGE NUMBER (MAYBE).
            # IF ANSWER ISN'T IN @destmsgfiles, REPEAT LOOP:
            foreach $temp (@destmsgfiles) {
                if ($ans eq $temp) {
                    $destmsgnum = $ans;
                    last GETMSGNUM;
                }
            }
            print "'$ans'?  Please try again...\n";
        }
    }
    else {
        # $query NOT SET.  FIND LAST MESSAGE IN @destmsgfiles WITH $srcsubj.

        local($gotdest) = $no;      # FOUND DESTINAION MESSAGE?

        if ($srcsubj eq "") {
            print STDERR "$myname: skipping message $srcmsgfile because",
                " it doesn't have a subject.\n";
            print STDERR "Try the -to or -query options instead.\n";
            next SRCMSGLOOP;
        }
        if ($debug == $yes) {
            print "$myname: src $srcmsgfile subject is '$srcsubj'...\n";
        }
        foreach $ldestmsgnum (@destmsgfiles) {
            # IF SOURCE AND DESTINATION MESSAGES ARE THE SAME, SKIP:
            if ($samesrcdest == $yes && $ldestmsgnum == $srcmsgfile) {
                print "$myname warning: ignoring message $ldestmsgnum in",
                    " '+$destfolder[0] $destrange':\n";
                print "  That's the same message you're trying to add.\n";
                next;
            }
            if ($debug == $yes) {
                print "...and dest $ldestmsgnum subject",
                    " is '$destsubj[$ldestmsgnum]'\n";
            }
            if ($srcsubj eq $destsubj[$ldestmsgnum]) {
                $gotdest = $yes;
                $destmsgnum = $ldestmsgnum; # $ldesmsgnum IS LOCAL TO foreach LOOP
                last;
            }
        }

        # IF NO MATCH, SKIP TO NEXT SOURCE MESSAGE:
        if ($gotdest == $no) {
            print "$myname: can't find message in",
                " '+$destfolder[0] $destrange'\n";
            print "  with subject '$srcsubj'.\n",
                " Skipping message $srcmsgfile...\n";
            next SRCMSGLOOP;
        }
    }

    #
    # IF WE GET HERE, WE KNOW USER WANTS DESTINATION MESSAGE NUMBER $destmsgnum.
    #
    # IF -noinplace IS SET, CHECK TO SEE IF THIS DESTINATION MESSAGE HAS
    # A $newmsgnum OF NEW DIGEST WE'VE ALREADY CREATED FOR IT.
    # IF WE DO AND IF -query, *ASK* WHETHER TO USE IT... OTHERWISE, DO IT.
    #
    if ($inplace == $yes) {
        # GET PATH TO USER'S CHOICE:
        $destmsgpath = "$destfolder[1]/$destmsgnum";
        print "$myname: adding message $srcmsgfile to",
            " $destmsgnum in +$destfolder[0].\n";
    }
    else {
        # CHECK FOR NEW DIGEST:
        local($tempmsgnum);
        if ($tempmsgnum = $newmsgnum{$destmsgnum}) {
            # THIS DESTINATION MESSAGE HAS ALREADY BEEN COPIED TO A NEW DIGEST
            if ($query == $no) {
                $destmsgpath = "$destfolder[1]/$tempmsgnum";
                if ($verbose == $yes) {
                    print "$myname: adding $srcmsgfile to message $tempmsgnum,",
                        " the copy (-noinplace) of message $destmsgnum.\n";
                }
            }
            else {
                print "$myname: I've already copied message $destmsgnum",
                    " into a new digest (-noinplace).\n";
                print "   The digest is in message number $tempmsgnum.\n";
                print "Answer y if you want to add to the digest",
                    " ($tempmsgnum) I just made,\n";
                print "   or n to create a new digest: ";
                local($ans);
                $ans = <STDIN>;
                chop $ans;
                if ($ans =~ /^[ \t]*y/i) {
                    $destmsgpath = "$destfolder[1]/$tempmsgnum";
                }
                else {
                    # MAKE NEW DIGEST FROM COPY OF ORIGINAL DESTINATION MESSAGE:
                    $newdigest = $yes;
                    $destmsgpath = "$destfolder[1]/$destmsgnum";
                }
            }
        }
        else {
            # NO -inplace DIGEST FOR THIS MESSAGE YET.  MAKE ONE AT END OF LOOP:
            $newdigest = $yes;
            $destmsgpath = "$destfolder[1]/$destmsgnum";
            if ($verbose == $yes) {
                print "$myname: adding $srcmsgfile to copy of message",
                    " $destmsgnum, and creating new digest.\n";
            }
        }
    }

    # READ DESTINATION MSG FOR $marker FIELD. IF NONE, NEED TO MAKE DIGEST:
    open(DESTMSGFILE, "$destmsgpath") ||
        &rmm_exit(1, "$myname quitting: can't open $destmsgpath for reading:\n$!\n");
    @destmsgtext = <DESTMSGFILE>;
    close DESTMSGFILE ||
        &rmm_exit(1, "$myname quitting: can't close $destmsgpath:\n$!\n");
    ($destdigesthdrs, $destbodyhdrs, $dummy, $destmsgline, $destisdigest) =
        &prochdr(@destmsgtext);
    if ($debug == $yes) {
        print "\n$myname: destdigesthdrs has:\n$destdigesthdrs\n\n";
        print "$myname: destbodyhdrs has:\n$destbodyhdrs\n\n";
    }

    #
    # BUILD NEW DESTINATION MESSAGE HEADER AND BODY IN $newdestmsg VARIABLE:
    #

    # ADD MARKER FIELD (MADE BY RCS) AT TOP OF DIGEST HEADER.
    $Id = "";   # MAKE PERL OMIT $Id FROM STRING BELOW AND LEAVE COLON:
    local($newdestmsg) = "$marker$Id: rfl,v 1.3 1995/12/04 20:39:59 jerry Exp $ \\n";
    # ADD CREATION DATE SO THAT scan DOES NOT EMIT ANY '*' ON DIGESTS TO WARN
    # THE USER ABOUT THE ABSENCE OF Date: FIELD.  MAYBE THIS SHOULD BE DATE
    # OF FIRST MESSAGE IN DIGEST -- BUT THAT HAS GOOD AND BAD POINTS.
    $newdestmsg .= 'Date: ' . &fake_date;

    if ($destisdigest == $no) {
        #
        # DESTINATION ISN'T AN rfl DIGEST.  CONVERT TO DIGEST BY FILTERING
        # OUT @skiphdrs, MUNGING DASHES IN ITS BODY, AND ADDING DIGEST
        # SEPARATORS (DASHED LINES) TO BODY.  WE PUT SOURCE MESSAGE DIGEST
        # ABOVE DESTINATION DIGEST HEADER, THEN ADD FILTERED SOURCE HEADER
        # AND FILTERED SOURCE MESSAGE (WITH DASHES MUNGED) TO END OF DIGEST.
        # 
        if ($verbose == $yes) {
            print "$myname: converting '+$destfolder[0] $destmsgnum'",
                " into a digest.\n";
        }

        # FIRST SET OF FIELDS COMES FROM ORIGINAL DESTINATION MESSAGE.
        # ADD FIELDS FROM SOURCE MESSSAGE BELOW THEM.  THIS WAY,
        # DESTINATION MESSAGE WILL ALWAYS scan WITH SAME SUBJECT/TO/FROM
        # BECAUSE scan SHOWS THE FIRST MATCHING FIELD IT FINDS.
        $newdestmsg .= &uniqhdr("$destdigesthdrs$srcdigesthdrs\n");

        # PRINT MESSAGE SEPARATOR:
        $newdestmsg .= "\n$sepdashes\n\n";

        # ADD FILTERED HEADER OF ORIGINAL SOURCE MESSAGE AND AN EMPTY LINE:
        $newdestmsg .= "$destbodyhdrs\n";

        # ADD BODY; MUNGE DASHES (SEE RFC 934):
        while (++$destmsgline <= @destmsgtext) {
            $_ = $destmsgtext[$destmsgline];
            $newdestmsg .= ((/^-/) ? "- " : "") . $_;
        }

        # PRINT MESSAGE SEPARATOR:
        $newdestmsg .= "\n$sepstring\n\n";

        # ADD FILTERED HEADER OF ORIGINAL DESTINATION MESSAGE AND AN EMPTY LINE:
        $newdestmsg .= "$srcbodyhdrs\n";

        # ADD BODY; MUNGE DASHES (SEE RFC 934):
        while (++$srcmsgline <= @srcmsgtext) {
            $_ = $srcmsgtext[$srcmsgline];
            $newdestmsg .= ((/^-/) ? "- " : "") . $_;
        }

        # PRINT MESSAGE SEPARATOR:
        $newdestmsg .= "\n$sepstring\n\n";

        if ($debug == $yes) {
            print "\n$myname: newdestmsg has:\n$newdestmsg\n";
        }
    }
    else {
        #
        # DESTINATION IS AN rfl DIGEST.  ADD DIGEST-FORMAT HEADER FROM SOURCE
        # MESSAGE TO TOP OF DESTINATION MESSAGE.  AT END OF DESTINATION
        # BODY, ADD SOURCE HEADER AND BODY (WITH DASHES MUNGED).
        # DON'T RE-MUNGE DASHES IN DESTINATION BODY!
        # 

        # ADD HEADERS FROM DESTINATION AND SOURCE MESSSAGES
        # AND EMPTY LINE.
        $newdestmsg .= &uniqhdr("$destdigesthdrs$srcdigesthdrs\n");

        # COPY MESSAGE SEPARATORS + BODY TEXT FROM ORIGINAL DESTINATION MESSAGE:
        while (++$destmsgline <= @destmsgtext) {
            $newdestmsg .= $destmsgtext[$destmsgline];
        }

        # ADD FILTERED HEADER OF ORIGINAL DESTINATION MESSAGE AND AN EMPTY LINE:
        $newdestmsg .= "$srcbodyhdrs\n";

        # ADD BODY; MUNGE DASHES (SEE RFC 934):
        while (++$srcmsgline <= @srcmsgtext) {
            $_ = $srcmsgtext[$srcmsgline];
            $newdestmsg .= ((/^-/) ? "- " : "") . $_;
        }

        # PRINT MESSAGE SEPARATOR:
        $newdestmsg .= "\n$sepstring\n\n";

        if ($debug == $yes) {
            print "\nDEBUG: newdestmsg has:\n$newdestmsg\n";
        }
    }


    #
    # ADD SOURCE MESSAGE TO DIGEST.
    # IF $newdigest SET ABOVE, CREATE A NEW DIGEST (FOR -noinplace).
    #

    if ($newdigest == $no) {
        open(DESTMSGFILE, ">$destmsgpath") ||
            &rmm_exit (1, "$myname quitting: can't open $destmsgpath for writing:\n$!\n");
    }
    else {
        local($tempout);
        $tempout = `$mhbin/mhpath new +$destfolder[0]` ||
            &rmm_exit (1, "$myname quitting: can't get new destination message number from mhpath:\n$!\n");
        chop $tempout;

        # REMEMBER THE NEW MESSAGE NUMBER IN CASE MORE MESSAGES MATCH:
        ($newmsgnum{$destmsgnum}) = $tempout =~ /(\d+)$/;
        if ($verbose == $yes) {
            print "$myname: creating (-noinplace) new digest",
                " '+$destfolder[0] $newmsgnum{$destmsgnum}'.\n";
        }

        open(DESTMSGFILE, ">$tempout") ||
            &rmm_exit (1, "$myname quitting: can't open $tempout for writing:\n$!\n");
    }

    print DESTMSGFILE $newdestmsg ||
        &rmm_exit(1, "$myname quitting: can't write new message to $tempout:\n$!\n");
    if (close DESTMSGFILE) {    # FOR WRITING
        # ADD MESSAGE TO LIST OF MESSAGES TO REMOVE:
        push (@tormm, $srcmsgfile);
    }
    else {
        &rmm_exit(1, "$myname quitting: can't close digest message file:\n$!\n");
    }
}
&rmm_exit(0);
