nalloc.in 2.33 KB
Newer Older
Mac Newbold's avatar
Mac Newbold committed
1 2
#!/usr/local/bin/perl -w
use Mysql;
3
use English;
Mac Newbold's avatar
Mac Newbold committed
4

5 6 7
#
# Configure variables
#
mac's avatar
mac committed
8
my $TB     = "@prefix@/libexec";
9 10 11
my $DBNAME = "@TBDBNAME@";

my $dbh = Mysql->connect("localhost",$DBNAME,"script","none");
Mac Newbold's avatar
Mac Newbold committed
12

13
if ($#ARGV < 1) {die("Usage: nalloc <pid> <eid> <node> <node> <...>\n");}
Mac Newbold's avatar
Mac Newbold committed
14

15
my $consetup="$TB/console_setup";
16
my $error = 0;
17
my $pid = shift;
Mac Newbold's avatar
Mac Newbold committed
18 19
my $eid = shift;
my @node_names=@ARGV;
mac's avatar
mac committed
20 21
my @vals = ();
my @nodes= ();
Mac Newbold's avatar
Mac Newbold committed
22 23 24

my $cmd = "";
my $sth = "";
25

26 27 28 29 30
my $self = (getpwuid($UID))[0]
  || die "Cannot figure out who you are!\n";

$cmd = "select uid from proj_memb as pm left join experiments as e on ".
  "e.pid=pm.pid where e.eid='$eid' and uid='$self' and e.pid='$pid'";
31
$sth = $dbh->query($cmd);
32 33
if ( ($sth->numrows < 1) && ($UID != 0) && ($EUID != 0)) {	
  die("You are not a member of experiment '$eid' in project '$pid'.\n");
34
}
Mac Newbold's avatar
Mac Newbold committed
35
 
mac's avatar
mac committed
36 37 38 39
$cmd = "lock tables nodes read, reserved write";
$sth = $dbh->query($cmd) 
  || die("Locking error:\n$cmd\nError string is:".$dbh->errstr."\n");

Mac Newbold's avatar
Mac Newbold committed
40
foreach my $n (@node_names) { 
41 42 43 44 45 46
  $sth = $dbh->query("select * from reserved where node_id='$n'");
  if ($sth->numrows > 0) {
    $cmd="select * from reserved where node_id='$n' and eid='$eid' and pid='$pid'";
    $sth = $dbh->query($cmd);
    if ($sth->numrows > 0) {	
      print "You have already reserved node '$n'.\n";
47
      # Do not increment error code since that throws off tbprerun.
Mac Newbold's avatar
Mac Newbold committed
48
    } else {
49
      print "Someone else has already reserved node '$n'.\n";
50
      $error++;
51 52 53 54 55 56
    }
    next;
  } else {
    $sth = $dbh->query("select * from nodes where node_id='$n'");
    if ($sth->numrows < 1) {	
      print "Node '$n' does not exist.\n";
57
      $error++;
58
      next;
mac's avatar
mac committed
59 60 61 62
    } else {
      # No one has reserved it, and it exists, so add it to my list
      push(@vals,"('$n','$pid','$eid')");
      push(@nodes,"$n");
Mac Newbold's avatar
Mac Newbold committed
63
    }
64
  }
Mac Newbold's avatar
Mac Newbold committed
65
}
66

mac's avatar
mac committed
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
if (!$error && @vals) {
  print "Reserving nodes...";
  $cmd = "insert into reserved (node_id,pid,eid) values ".join(",",@vals);
  if ($sth = $dbh->query($cmd)) {
    print "Succeeded.\n";    
  } else { 
    print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n";
    $error++;
  }
}

$cmd = "unlock tables";
$sth = $dbh->query($cmd) 
  || die("Locking error:\n$cmd\nError string is:".$dbh->errstr."\n");

Mac Newbold's avatar
Mac Newbold committed
82 83 84 85 86 87 88
if (!$error && @nodes) {
  foreach $n ( @nodes ) { 
    system("$consetup $n") == 0 or
      print STDERR "WARNING: $consetup $n failed!\n";
  }
}

89
exit($error);