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

my $dbh = Mysql->connect("localhost","tbdb","script","none");

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

8
my $error = 0;
9
my $pid = shift;
Mac Newbold's avatar
Mac Newbold committed
10
11
12
13
14
15
16
17
my $eid = shift;
my @node_names=@ARGV;
my @machines = @node_names;
foreach my $m (@machines) { $m = "node_id='".$m."'"; }
my $list= join(" or ",@machines);

my $cmd = "";
my $sth = "";
18
19
20
21
22
23

$cmd = "select * from experiments where eid='$eid' and pid='$pid'";
$sth = $dbh->query($cmd);
if ($sth->numrows < 1) {	
  die("There is no experiment '$eid' in project '$pid'.\n");
}
Mac Newbold's avatar
Mac Newbold committed
24
25
 
foreach my $n (@node_names) { 
26
27
28
29
30
31
  $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";
32
      # Do not increment error code since that throws off tbprerun.
Mac Newbold's avatar
Mac Newbold committed
33
    } else {
34
      print "Someone else has already reserved node '$n'.\n";
35
      $error++;
36
37
38
39
40
41
    }
    next;
  } else {
    $sth = $dbh->query("select * from nodes where node_id='$n'");
    if ($sth->numrows < 1) {	
      print "Node '$n' does not exist.\n";
42
      $error++;
43
      next;
Mac Newbold's avatar
Mac Newbold committed
44
    }
45
46
47
48
  }
  print "Reserving node '$n'...";
  $cmd = "insert into reserved (node_id,pid,eid) values ('$n','$pid','$eid')";
  $sth = $dbh->query($cmd) && print "Succeeded.\n"
49
50
    || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
      && $error++);
Mac Newbold's avatar
Mac Newbold committed
51
}
52
53

exit($error);