Path: utzoo!censor!geac!torsqnt!lethe!yunexus!ists!helios.physics.utoronto.ca!news-server.csri.toronto.edu!cs.utexas.edu!sdd.hp.com!usc!apple!agate!ucbvax!eng.sun.COM!smarks
From: smarks@eng.sun.COM (Stuart Marks)
Newsgroups: comp.mail.mh
Subject: Re: Refiling deleted messages into archive folder
Message-ID: <9101250029.AA02085@trantor.Eng.Sun.COM>
Date: 25 Jan 91 00:29:52 GMT
References: <9101241743.AA01997@sunspot.acs.syr.edu>
Sender: daemon@ucbvax.BERKELEY.EDU
Organization: The Internet
Lines: 130


    I had a shell script that did the same thing.  I set the script in
    my MH profile as the "rmmproc:".  Around the same time, I noticed that my
    sequences were getting screwed up.  I didn't figure it out for a while...
    
    I realized that the "refile" command will update your sequences... but
    "mv" doesn't.  So if you use any sequences, you'll probably want to use
    refile instead of mv.

I don't understand.  I have a perl script that I use as my rmmproc, and it
seems to work fine with sequences.  Note:  I don't use this script in place
of rmm; I let rmm invoke it through the rmmproc mechanism.  rmm seems to
update the sequences before it invokes the rmmproc.

Unfortunately, refile uses the rmmproc, so I end up with an extra link to
every refiled message in the archive folder.  To work around this problem,
I've added a -normmproc option to refile that causes it to use unlink(2)
instead of invoking the rmmproc.  I can supply a patch for this if anyone
is interested (it's really simple).

Here's the perl script.  It works on perl 3.0 patchlevel 18 (I haven't
tried it on a higher patchlevel yet; yes, I'm behind).  It has the
advantage of being much faster than shell scripts, because it avoids forks
of "mhpath new" and "mv" for each message.  However, it doesn't annotate
the messages as they are archived.  That should be pretty simple to add.
It touches them so that "find -mtime ..."  can be used to expire them
effectively.  It also detects if you're rmm'ing from the archive folder,
and if you are, simply unlinks the messages.

Improvements welcome.  Enjoy.

s'marks

=============================== cut here =================================
#! /bin/sh
# @(#)rmmsafe 2.1 90/07/19
# 
# Implements an MH rmmproc.  Moves deleted messages to the folder indicated
# by Deleted-Folder in the user's MH profile.  Called with target folder as
# the working directory, and file names (message numbers) as arguments.

perl - "$@" << \EOF

# Initialize some variables to default values.

$dfolder = 'wastebasket';
$home = $ENV{'HOME'};
$path = $home . '/Mail';
$profile = $ENV{'MH'};

# Subroutine to extract a profile entry.  Assumes $_ is the line from
# the profile.

sub profentry {
    chop;				# remove trailing newline
    ($junk, $_) = split(/:  */, $_, 2);	# split into label and value
    s/ *$//;				# remove trailing whitespace
    return $_;
}

# If the MH environment variable isn't set, use $HOME/.mh_profile instead.

if ( ! $profile ) {
    $profile = $ENV{'HOME'} . '/.mh_profile';
}

# Scan the profile for some data: mail path and deleted-folder.

if (open(PROFILE, $profile)) {
    while (<PROFILE>) {
	if (/^Path:/) {
	    $path = do profentry();
	    # If mail path doesn't begin with a /, prepend $HOME.
	    if ( $path !~ m#^/# ) {
		$path = $home . '/' . $path;
	    }
	    next;
	}
	if (/^Deleted-Folder:/) {
	    $dfolder = do profentry();
	    next;
	}
    }
    close(PROFILE);
}

# Absolute pathname of the delete-folder.

$dfolderpath = $path . '/' . $dfolder;

die "rmmsafe: folder +$dfolder not found\n"
    unless -d $dfolderpath;

# Get timestamp for touching files.

$now = time;

# Get device and inode numbers of current directory and the deleted-folder.
# If cwd is the deleted-folder, really remove messages.  Otherwise, move
# messages from here to the deleted-folder.

($curdev, $curino, $junk) = stat('.');
($deldev, $delino, $junk) = stat($dfolderpath);

if ( $curdev == $deldev && $curino == $delino ) {
    unlink @ARGV;
} else {

    # Scan the deleted-folder and look for the highest numbered file.
    # Non-numeric filenames are treated as zero by perl.
    $next = 0;
    opendir(DIR, $dfolderpath)
	|| die "rmmsafe: can't open $dfolderpath\n";
    while ($_ = readdir(DIR)) {
	$next = $_
	    if ($_ > $next);
    }

    # For each named message, touch it, and move it to the next
    # available message number in the deleted-folder.
    foreach $msg (@ARGV) {
	++$next;
	# print "rename $msg $dfolderpath/$next\n";
	utime $now, $now, $msg;
	rename($msg, $dfolderpath . '/' . $next) ||
	    die "rmmsafe: can't move $msg to $dfolderpath/$next\n";
    }
}

EOF