#! /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 ): ($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 # 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 < # (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 <) { 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 = 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 = ) { 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 = ; 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 = ; 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 = ; 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 = ; 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 = ; 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 = ; 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);