From tchrist@convex.COM Mon Mar  9 09:38:47 1992
To: Perl-Users@fuggles.acc.Virginia.EDU
From: tchrist@convex.COM (Tom Christiansen)
Crossposted-To: comp.mail.mh,alt.sources
Subject: finding links to msgs (was: Adventures with MH and xmh, mush, and elm)
Date: 29 Feb 92 00:26:18 GMT
Reply-To: tchrist@convex.COM (Tom Christiansen)
SUB: finding links to msgs (was: Adventures with MH and xmh, mush, and elm)
SUM: tchrist@convex.COM (Tom Christiansen), tchrist@convex.COM (Tom Christiansen)->Perl-Users@fuggles.acc.Virginia.EDU

Archive-name: shirt
Submitted-by: tchrist@convex.com

>From the keyboard of jerry@ora.com (Jerry Peek):
:> To do that you need to have some kind of database - either using hard
:> links in the file system, an index to your mail files, or a real DB.
:> You can probably do it with mh.  You can certainly do it (and the
:> inverse - here's the message, show me where else it is) in Poste.
:
:One of the few ;-) weaknesses of MH using the UNIX filesystem is that,
:once you've linked a message into some arbitrary folder, it's not easy
:to tell where the other links are.  The only time I care is when I'm
:trying to remove a mail message and all its links.
:
:I've set my crontab to build a database nightly.  It shows all links
:to all my messages.  I've got a shell script to ask the database
:"where are all the links?"  The next step will be to write a command
:that removes all links.  The command would:
:    - ask the database for the names of the links (the message
:      numbers and folder names),
:    - check the file's inode-change time to see if any links have been
:      added or removed since since the database was built last night,
:    - either remove all the links or tell you that it might not be
:      be able to.
:
:I've had that on my to-do list for a couple of years. :-(

Here's a quick prototype of such a system.  I store both links information
and msgid information.  I supply a library and 5 programs for dealing with
the database (all in under 200 lines. :-):

    file		contents

    mhdb.pl		common library of functions

    catmhdb		cat out whole dbase
    lnmhdb		create (with -c) or update dbase
    lsmhln		show links to given message
    rmmhln		remove (w/ unlink, not rmm) all links to a msg
    shirt		SHow In-Reply-To parent message

For example:

    $ lnmhdb -c 
    $ catmhdb | less
    $ lsmhln inbox/7
    $ rmmhln inbox/tmp/9
    $ shirt inbox/7

It need to be more robust in various ways, including taking more mh
looking filenames, but it's only about 40 minutes of hacking.  Also,
you'll want to store mhdb.pl in your own private PERLLIB, or use a
fullpath on the requires.  Guess it's time to make this stuff into 
plum modules. :-)  The rmmhln has the actual damage commented out
in case you want to test, or make calls to rmm or whatever.

Shirt is a nice program because if you send out stuff with -msgid
and keep copies around, it will show you the message the guy is 
replying to, kinda like [ in trn.  Anyway, I always wanted to 
call a program "shirt".  :-)  

--tom

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#	mhdb.pl
#	catmhdb
#	lnmhdb
#	lsmhln
#	rmmhln
#	shirt
# This archive created: Fri Feb 28 18:16:42 1992
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'mhdb.pl'" '(435 characters)'
if test -f 'mhdb.pl'
then
	echo shar: "will not over-write existing file 'mhdb.pl'"
else
sed 's/^	X//' << \SHAR_EOF > 'mhdb.pl'
	Xchop ($MHPATH =`mhpath +`);
	Xchdir $MHPATH  || die "can't chdir to $MHPATH: $!";
	X$MHDB = "$MHPATH/.MHDB";
	X
	Xsub dbcreate {
	X    unlink("$MHDB.pag", "$MHDB.dir");
	X    dbmopen(%LINKS, $MHDB, 0644)
	X	|| die "can't dbopen $MHDB for create: $!";
	X}
	X
	Xsub dbupdate {
	X    dbmopen(%LINKS, $MHDB, 0644)
	X	|| die "can't dbopen $MHDB for update: $!";
	X}
	X
	Xsub dbopen {
	X    dbmopen(%LINKS, $MHDB, undef)
	X	|| die "can't dbopen $MHDB for reading: $!";
	X}
	X
	X1;
SHAR_EOF
if test 435 -ne "`wc -c < 'mhdb.pl'`"
then
	echo shar: "error transmitting 'mhdb.pl'" '(should have been 435 characters)'
fi
chmod 664 'mhdb.pl'
fi
echo shar: "extracting 'catmhdb'" '(417 characters)'
if test -f 'catmhdb'
then
	echo shar: "will not over-write existing file 'catmhdb'"
else
sed 's/^	X//' << \SHAR_EOF > 'catmhdb'
	X#!/usr/bin/perl
	X
	Xrequire 'mhdb.pl';
	X
	X&dbopen;
	X
	Xwhile ( ($devino, $links) = each %LINKS) {
	X    if (index($devino, $;) >= 0) {
	X	($dev, $ino) = split($;, $devino);
	X	($ctime, @links) = split($;, $links);
	X	printf "$dev,$ino: @links\n";
	X    } else {
	X	print "<$devino>: ";
	X	$devino = $links;
	X	$links = $LINKS{$devino};
	X	($dev, $ino) = split($;, $devino);
	X	($ctime, @links) = split($;, $links);
	X	printf "@links\n";
	X    } 
	X} 
SHAR_EOF
if test 417 -ne "`wc -c < 'catmhdb'`"
then
	echo shar: "error transmitting 'catmhdb'" '(should have been 417 characters)'
fi
chmod 775 'catmhdb'
fi
echo shar: "extracting 'lnmhdb'" '(943 characters)'
if test -f 'lnmhdb'
then
	echo shar: "will not over-write existing file 'lnmhdb'"
else
sed 's/^	X//' << \SHAR_EOF > 'lnmhdb'
	X#!/usr/bin/perl
	X
	X# $debug = 1;
	X
	Xrequire 'mhdb.pl';
	X
	Xrequire 'find.pl'; 
	X
	X
	X
	Xif ($ARGV[0] =~ /^-c$/) {
	X    shift;
	X    &dbcreate;
	X} else {
	X    &dbupdate;
	X} 
	X
	X@ARGV = $MHPATH if !@ARGV;
	X
	Xfor (@ARGV) { &find($_); }
	X
	Xdbmclose(LINKS);
	X
	Xprint "$0: $count msgs in $uniq files\n";
	X
	Xsub wanted {
	X     if (/^\d+$/ && -f) {
	X	$count++;
	X	($dev, $ino, $ctime) = (lstat($_))[0,1,10];
	X	if (!defined $LINKS{$dev, $ino}) {
	X	    $LINKS{$dev, $ino} = $ctime;
	X	    $uniq++;
	X	}
	X	$name =~ s!^\./!!;
	X	if (index("$LINKS{$dev, $ino}$;", "$;$name$;") >= 0) {
	X	    warn "already saw $name for $dev,$ino\n" if $debug;
	X	} else {
	X	    $LINKS{$dev, $ino} .= "$;$name";
	X	    if ($mid = &getmsgid($_)) {
	X		$LINKS{$mid} = "$dev$;$ino";
	X	    } 
	X	}
	X     } 
	X} 
	X
	Xsub getmsgid {
	X    local($FILE) = $_;
	X    if (!open FILE) {
	X	warn "can't open $FILE: $!";
	X	return 0;
	X    } 
	X    local($_);
	X    local($/) = '';
	X    $_ = <FILE>;
	X    local($*) = 1;
	X    /^message-id:\s*<([^>]+)>/i && $1;
	X} 
SHAR_EOF
if test 943 -ne "`wc -c < 'lnmhdb'`"
then
	echo shar: "error transmitting 'lnmhdb'" '(should have been 943 characters)'
fi
chmod 775 'lnmhdb'
fi
echo shar: "extracting 'lsmhln'" '(383 characters)'
if test -f 'lsmhln'
then
	echo shar: "will not over-write existing file 'lsmhln'"
else
sed 's/^	X//' << \SHAR_EOF > 'lsmhln'
	X#!/usr/bin/perl
	X
	Xrequire "mhdb.pl";
	X
	X&dbopen;
	X
	X$multi = @ARGV > 1;
	X
	Xwhile ($file = shift) {
	X    ($dev, $ino, $ctime) = (lstat($file))[0,1,10];
	X    unless ($links =  $LINKS{$dev, $ino}) {
	X	print STDERR "$0: $file: no db entry\n";
	X    } else {
	X	($otime, @links) = split($;, $links);
	X	print "$file: " if $multi;
	X	print "@links";
	X	print ' *' if $otime != $ctime;
	X	print "\n";
	X    } 
	X} 
	X
SHAR_EOF
if test 383 -ne "`wc -c < 'lsmhln'`"
then
	echo shar: "error transmitting 'lsmhln'" '(should have been 383 characters)'
fi
chmod 775 'lsmhln'
fi
echo shar: "extracting 'rmmhln'" '(1221 characters)'
if test -f 'rmmhln'
then
	echo shar: "will not over-write existing file 'rmmhln'"
else
sed 's/^	X//' << \SHAR_EOF > 'rmmhln'
	X#!/usr/bin/perl
	X
	Xrequire 'mhdb.pl';
	X
	Xrequire 'timelocal.pl';
	X
	X&dbupdate;
	X
	X$| = 1;
	X
	Xwhile ($file = shift) {
	X    $! = 0;
	X    $file = "$MHPATH/$file" unless $file =~ m#^/#;
	X    ($dev, $ino, $nlinks, $ctime) = (lstat($file))[0,1,3,10];
	X    if ($!) {
	X	warn "can't stat $file: $!";
	X	next;
	X    } 
	X    unless ($links =  $LINKS{$dev, $ino}) {
	X	print STDERR "$0: $file: no db entry for $dev, $ino\n";
	X    } else {
	X	($otime, @links) = split($;, $links);
	X	if ($otime != $ctime) {
	X	    print "warning: ctime on $file differs from dbase time\n";
	X	    print "  was ", &cdate($otime), ", now ", &cdate($ctime);
	X	    print "; continue? ";
	X	    next unless <STDIN> =~ /^y/i; 
	X	} 
	X	if ($nlinks != @links) {
	X	    print "warning: $file has $nlinks links, not ", scalar(@links), "\n";
	X	    print "continue? ";
	X	    next unless <STDIN> =~ /^y/i; 
	X	} 
	X	for (@links) {
	X	    ($ndev, $nino) = (lstat($_))[0,1];
	X	    if ($ndev != $dev || $nino != $ino) {
	X		print "$_ no longer linked to $file... skipping\n";
	X		next;
	X	    } 
	X	    print "unlink $_\n";
	X	    # unlink $_;
	X	} 
	X	# delete $LINKS{$dev,$ino}
	X    } 
	X} 
	X
	Xsub cdate {
	X    ($sec,$min,$hr,$mday,$mon,$year) = gmtime($_[0]);
	X    sprintf("%02d/%02d/%02d %02d:%02d",$mon+1,$mday,$year,$hr,$min);
	X}
SHAR_EOF
if test 1221 -ne "`wc -c < 'rmmhln'`"
then
	echo shar: "error transmitting 'rmmhln'" '(should have been 1221 characters)'
fi
chmod 775 'rmmhln'
fi
echo shar: "extracting 'shirt'" '(461 characters)'
if test -f 'shirt'
then
	echo shar: "will not over-write existing file 'shirt'"
else
sed 's/^	X//' << \SHAR_EOF > 'shirt'
	X#!/usr/bin/perl
	X
	Xrequire 'mhdb.pl';
	X
	X&dbopen();
	X
	Xwarn "reading msg from tty" if -t && !@ARGV;
	X
	X$/ = '';
	X$_ = <>;
	X$* = 1;
	Xs/\n\s+/ /g;
	Xdie "can't find msgid" unless /^in-reply-to:.*<([^>]+)>/i;
	X
	X$devino = $LINKS{$1};
	Xdie "no message id in dbase for $1" unless $devino;
	X
	X$links = $LINKS{$devino};
	X($ctime, @links) = split($;, $links);
	X
	X($folder, $msg) = $links[0] =~ m!(.+)/(\d+)$!;
	X
	Xdie "no folder or msg" unless $folder && $msg;
	X
	Xexec 'show', $msg, "+$folder";
SHAR_EOF
if test 461 -ne "`wc -c < 'shirt'`"
then
	echo shar: "error transmitting 'shirt'" '(should have been 461 characters)'
fi
chmod 775 'shirt'
fi
exit 0
#	End of shell archive