[oclug] Corrected perl script...

[David F. Skoll]

Hi,

Sorry, there was a typo.  Here's the correct script.

Regards,

David.

#!/usr/bin/perl
#***********************************************************************
#
# killthread.pl
#
# Kills entire threads on mailing lists
#
# Copyright (C) 2001 Roaring Penguin Software Inc.
#
# This program may be distributed according to the terms of the GNU
# General Public License, version 2 or (at your option) any later version.
#
# $Id: killthread.pl,v 1.4 2001/02/19 20:19:58 dfs Exp $
#***********************************************************************

use DB_File;
use Fcntl ':flock';

# DB file
$DBFile = $ENV{"HOME"} . "/.deadthreads";

# Look-ahead line
$Lookahead = "";
$EOH = 0;

#***********************************************************************
# %PROCEDURE: addMessageID
# %ARGUMENTS:
#  msgid -- message-ID to add to database
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Adds a message ID with today's date to the database.
#***********************************************************************
sub addMessageID {
    my($msgid) = @_;
    my($now) = time();

    $Database{$msgid} = $now;
}

#***********************************************************************
# %PROCEDURE: readHeader
# %ARGUMENTS:
#  None
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Reads a single header from stdin
#***********************************************************************
sub readHeader {
    my($line);
    my($tmp);
    if ($EOH) {
	return "";
    }
    while ($line = <STDIN>) {
	chomp($line);
	if ($line eq "") {
	    $line = $Lookahead;
	    $Lookahead = "";
	    $EOH = 1;
	    return $line;
	}
	if ($line =~ /^\s/) {
	    $Lookahead .= $line;
	} else {
	    $tmp = $Lookahead;
	    $Lookahead = $line;
	    if ($tmp ne "") {
		return $tmp;
	    }
	}
    }
    $tmp = $Lookahead;
    $Lookahead = $line;
    return $tmp;
}
#***********************************************************************
# %PROCEDURE: killThisEmail
# %ARGUMENTS:
#  None
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Reads an e-mail message from STDIN; extracts Message-ID; adds it to
#  database.
#***********************************************************************
sub killThisEmail {
    my($line);
    my($mid);
    $mid = "";
    while(($line = readHeader()) ne "") {
	next unless ($line =~ /^Message-ID:\s+(\S+)/i);
	$mid = $1;
	last;
    }
    exit(1) if ($mid eq "");
    $Database{$mid} = time();
    exit(0);
}

#***********************************************************************
# %PROCEDURE: conditionallyKill
# %ARGUMENTS:
#  None
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Reads an e-mail message from STDIN; if it belongs to a killed thread,
#  then returns 1 and adds its message-ID to the database.  Otherwise,
#  returns 0.
#***********************************************************************
sub conditionallyKill {
    my($line, $mid, $shouldKill);
    my($id, @ids);
    $mid = "";
    $shouldKill = 0;
    while(($line = readHeader()) ne "") {
	if (($line =~ /^Message-ID:\s+(<\S+>)/i)) {
	    $mid = $1;
	}
	if (($line =~ /^In-Reply-To:\s+(<\S+>)/i)) {
	    if ($Database{$1}) {
		$shouldKill = 1;
	    }
	}
	if (($line =~ /^References:\s+(.*)/i)) {
	    @ids = split(/\s/, $1);
	    foreach $id (@ids) {
		if ($Database{$id}) {
		    $shouldKill = 1;
		}
	    }
	}
    }
    exit(1) if ($mid eq "");
    if ($shouldKill) {
	$Database{$mid} = time();
    }
    exit(!$shouldKill);
}

#***********************************************************************
# %PROCEDURE: cleanDB
# %ARGUMENTS:
#  days -- any entries older than "days" days are removed from databas.
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Removes old message-ID's from the database.
#***********************************************************************
sub cleanDB {
    my($days) = @_;
    my($k, $v);
    my(@toKill);
    my($secs) = $days * 86400;
    my($now) = time();
    while (($k, $v) = each %Database) {
	push @toKill, $k if (($now - $v) > $secs);
    }
    foreach $k (@toKill) {
	delete $Database{$k};
    }
    exit(0);
}

# Main program:
# Invoke as:
# killthread.pl kill  -- KILL thread starting with this e-mail.
# killthread.pl check -- conditionally kill this e-mail if it's part of a dead
#                        thread
# killthread.pl clean <days> -- Clean database.

tie %Database, 'DB_File', $DBFile;

# Lock the DB file
open(DB, "<$DBFile") or die "Can't open $DBFile: $!";
flock(DB, LOCK_EX);

killThisEmail() if ($ARGV[0] eq "kill");
conditionallyKill() if ($ARGV[0] eq "check");
cleanDB($ARGV[1]) if ($ARGV[0] eq "clean" && $ARGV[1] > 0);

print STDERR <<"EOF";
Usage: killthread.pl kill  -- Kill thread starting with this e-mail
       killthread.pl check -- Kill this e-mail if part of a dead thread
       killthread.pl clean days -- Remove entries older than "days" days.
EOF
exit(0);