#!/afs/sipb/project/perldev/p -w

use strict;
use IO::File;
use IO::Pipe;
use POSIX;
use Fcntl ':flock';

### kludge: punt old, more-buggy version.

print "ARGV: $0 @ARGV\n";

exit 0 unless @ARGV;
my $REALLY = 1;
if ($ARGV[0] eq '-n') { $REALLY = 0;  shift(@ARGV); }
exit 0 unless @ARGV;

my ($REPEAT) = @ARGV;

### find hostname

my $HOST = `hostname`;
$HOST =~ s/\s+//g;

### variables

use vars qw( $BINDIR $DESTDIR );

$BINDIR = '/afs/athena.mit.edu/user/b/e/bert/Thesis/exact';
$DESTDIR = '/afs/zone.mit.edu/user/bert/THESIS_DATA/current';

use vars qw( $return @xterm );

$return = $BINDIR . '/return';
@xterm = qw( xterm -geometry 80x48+0+0 );

use vars qw( $lockfile $queuefile $logfile $stopfile );

$lockfile =  $DESTDIR . '/.lock';
$queuefile = $DESTDIR . '/queue';
$logfile =   $DESTDIR . '/log';
# $stopfile =  $DESTDIR . '/.stop';

use vars qw( $tag $param $global );

chdir($DESTDIR);

### status message etc

sub status {
  print @_;
  return unless $REALLY;
  my $log = IO::File->new($logfile, 'a')
    or die "Can't open the log file: $!\n(@_)\n";
  flock($log, LOCK_EX)
    or die "Can't lock the log file: $!\n(@_)\n";  
  print {$log} @_;
  $log->close;
}

sub mail {
  return unless $REALLY;
  my $sm = IO::Pipe->new->writer('/usr/lib/sendmail bert@mit.edu');
  $sm->print("Subject: " . shift(@_) . "\n\n");
  $sm->print(@_);
  $sm->close;
}

### event and signal handlers

$SIG{'__DIE__'} = sub {
  mail("$HOST -- kaboom!", "ERROR: command failed!\n@_\n");
  status("X $tag $HOST --- $param\n");
  exit 10;
};

$SIG{'HUP'} = sub {
  mail("$HOST -- logout", "I just got logged out!");
  status("L $tag $HOST --- $param\n");
  exit 8;
};

$SIG{'CHLD'} = sub {
  my $pid;
  print "reaped child: $pid\n" while ($pid = waitpid(-1,WNOHANG)) > 0;
};

### get, remove and parse the first line, ensuring atomicity in the process
{
  # get a lock, open the queue
  my $lock = IO::File->new($lockfile, 'w')
    or die "Can't open the lock file: $!\n";
  flock($lock, LOCK_EX)
    or die "Can't lock the lock file: $!\n";

  my $queue = IO::File->new($queuefile, 'r')
    or die "Can't open the old queue file: $!\n";
  # if this were UFS, we could link and keep reading.  but AFS sucks. =(
  my ($common, $line, @rest) = <$queue>;
  defined($common) or die "Queue is broken (no lines)!\n";
  defined($line)   or die "Queue is empty!\n";
  $queue->close;

  if ($REALLY) {
    $queue = IO::File->new($queuefile, 'w')
      or die "Can't create the new queue file: $!\n";
    print {$queue} $common, @rest;
    $queue->close;
  }

  # unlock the files
  flock($lock, LOCK_UN)
    or die "Can't unlock the lock file: $!\n";
  $lock->close;

  # parse data
  chomp $common;
  ($tag, $global) = split(/>\s*/, $common, 2);
  defined($global) or die "Invalid common line: '$common'";
  chomp $line;
  ($tag, $param) = split(/>\s*/, $line, 2);
  defined($param) or die "Invalid line: '$line'";
}

### set up environment for running stuff.

$ENV{'XSESSION'} = $$;  $ENV{'SHELL'} = '/bin/athena/tcsh';
system("twm &");

( IO::Pipe->new->writer("xrdb -merge") )
  ->print("xscreensaver*logoutButtonTimeout: 1\n");
system('/bin/athena/attach', 'sipb');
system('/mit/sipb/bin/xscreensaver', '-L', '-l',
       '-ekey', 'AD3.u3aixB80Y', '-geometry', '+0-0',
       '-m', "crunching numbers...\nlog me out if you need the machine");

### OK, now run things.

status "+ $tag $HOST --- $param\n";
if ($REALLY) {
  system( @xterm, '-T', $tag,
	  '-e', $return, split(/\s+/, $global), split(/\s+/, $param))
    and do { status("E $tag $HOST --- $param\n"); exit 0 };
} else {
  print "(sleeping)\n";
  sleep(3);
}
status "- $tag $HOST --- $param\n";

if ((time - $^T) < 300  &&  $REALLY) {
  print "LOOPED: redoing $REPEAT...\n";
} else {
  $REPEAT--;
}

if ($REPEAT <= 0) {
  print "Loop done, exiting.\n";
  exit 0;
}

chdir($ENV{'HOME'});
exec $0, ($REALLY ? () : ('-n')), $REPEAT;