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

use strict;
use IO::File;
use IO::Pipe;
use POSIX;
use Config;

use vars qw( %sig_num );

@sig_num{split(/\s+/, $Config{sig_name})} = split(/\s+/, $Config{sig_num});

use vars qw( $prog @args );

$prog = '/afs/athena.mit.edu/user/b/e/bert/Thesis/src/runner/run-point.pl';
#@args = ('-n');

use vars qw( $CHILD $number );

$number = ("$0 @ARGV" =~ /\d+/ ? $& : 1);
$CHILD = -1;

### status message etc

sub mail {
  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("master kaboom!", "ERROR: $0 @ARGV failed!\n@_\n");
  exit 80;
};

$SIG{'HUP'} = sub {
  return unless $CHILD;  # if we're in the forked child, *don't* spew
  print "Logging out.\n";
  kill( ($sig_num{'HUP'} || 1), $CHILD ) if $CHILD > 0;
  exit 0;
};

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

### set up environment for running stuff.

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

my $ss_msg = <<"EOF";
Crunching numbers...
Log me out if you need this machine!
(But please *don\'t* log me out if the cluster is empty.)
EOF

chomp $ss_msg;
( IO::Pipe->new->writer("xrdb -merge") )
  ->print("xscreensaver*logoutButtonTimeout: 1\n",
	  "xscreensaver*float.bitmap: /mit/bert/Bitmap/hell.xbm\n");
system('/bin/athena/attach', 'sipb');
system('/mit/sipb/bin/xscreensaver', '-L', '-l',
       '-ekey', 'AD3.u3aixB80Y', '-geometry', '+0-0',
       '-m', $ss_msg);

### OK, now run things.

while ($number > 0) {
  print "$number invocations to go...\n";

  $CHILD = fork;
  if ($CHILD < 0) {
    # error
    die "Augh!  Fork failed!  ($!)";

  } elsif ($CHILD == 0) {
    # child

    exec $prog, @args;
    die "Augh!  Exec failed!  ($!)";
  }

  # parent

  {
    local($SIG{'CHLD'});  $SIG{'CHLD'} = '';
    waitpid $CHILD, 0;
  }

  if ($? == 1<<8) {
    print "child requests looping; still $number left\n";
  } else {
    $number--;
  }
}

print "done!!!\n";
exit 0;