#!/usr/local/perl -s
eval "exec /usr/local/perl -s -S $0 $*"
    if $running_under_some_shell;
			# this emulates #! processing on NIH machines.
			# (remove #! line above if indigestible)

#   This perl script is designed to find lost queue files on a mailhub

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

	$qd = "/usr/spool/mqueue";
	$sd = "/usr/spool/mqueue.stall";
	if (! -e $sd) {
		die "$sd does not exist!\n";
	}
	opendir(QUEUEDIR, $qd);
	@directory = readdir(QUEUEDIR);
	closedir(QUEUEDIR);
	foreach (@directory) {
		if ($request_exit) {
			last;
		}
		if (! /^df/) {
			next;
		} 
		($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, 
			 $size, $atime, $mtime, $ctime, $blksize, 
			 $blocks) = stat($qd . "/" . $_);
		if ((time() - $mtime) > 60*60*6) {
			# This file is older than 6 hours.  Let's 
			# move it to the stall directory.
			if ($show) {
				# if the user gives the -show option
				print $_, "\n";
				next;
			}
			$id = substr($_, 2);
			$lf = $qd . "/lf" . $id;
			$qf = $qd . "/qf" . $id;
			if (! link($qf, $lf)) {
				printf("Already locked! ($!)\n");
				next;
			}
			printf("Moving %s\n", $id);
			opendir(QUEUEDIR, $qd);
			eval '@files = grep(/' . $id . 
				'$/, readdir(QUEUEDIR));';
			foreach $i (@files) {
				if ($i eq ("lf" . $id)) {
					next;
				}
				rename($qd . "/" . $i, $sd . "/" . $i);
			}
			closedir(QUEUEDIR);
			unlink($lf);
		}
	}
	exit 0;

sub handle_exitsig
{
	$request_exit++;
	printf("Requesting exit\n");	
}