#!/usr/bin/perl -w
#
#   DMT status script
#
sub getStat;
sub ebox; sub wbox;

#---------------------------------------  Check that the partition exists.
print "\n";
$Partition = $ENV{"LIGOSMPART"};
if (! getStat("exists") ) {
    ebox("Partition $Partition doesn't exist!");
    exit(1);
}

#---------------------------------------  Get the partition name (needed?)
$PartitionName = getStat("name");
print("Status of partition: ",$PartitionName," as of ",`when 0`, "\n");

#---------------------------------------  Print Partition flags
$PartitionFlags = getStat("pflags");
print("Partition Flags:              ",$PartitionFlags, "\n");

#---------------------------------------  Consumer counts
$MaxConsumers = getStat("maxcons");
$CurConsumers = getStat("ncons");
print("Current/Maximum consumers:    ",$CurConsumers,"/",$MaxConsumers,"\n");

#---------------------------------------  Total frames written to partition
$TotalBuf = getStat("buffer_tot");
print("Frames written to Partition:  ", $TotalBuf, "\n");

#---------------------------------------  Buffer counts
$UsedBuffers  = getStat("usedbuf");
$TotalBuffers = getStat("nbuf");
print("Full/Used/Free/Total Buffers: ", getStat("fullbuf"), "/", $UsedBuffers,
      "/", getStat("freebuf"), "/", $TotalBuffers,"\n");

#---------------------------------------  Last Buffer time stamp
$GPSNow = `when 0 "%s"`;
chomp $GPSNow;
$LastGPS = getStat("last_ID");
print("Most recent frame GPS:        ", `when $LastGPS`);

#---------------------------------------  Look for errors, print message 
#                                         if found
wbox("All consumers are in use.")       if ($CurConsumers == $MaxConsumers);
wbox("Latest buffer is not current.")   if ($GPSNow - $LastGPS > 5);
wbox("Latest buffer is in the future.") if ($LastGPS - $GPSNow > 5);
wbox("All buffers are in use.")         if ($UsedBuffers == $TotalBuffers);

#=======================================  Get a buffer status value
sub getStat {
    my $stat = `smstat $_[0] $Partition`;
    chomp $stat;
    return $stat
}

#=======================================  Print a boxed warning message
sub wbox {
    print "\n";
    print "*******************************************************\n";
    print "*                                                     *\n";
    print "*    Warning:                                         *\n";
    foreach my $i (@_) {
        print "*    ",$i,"\n";
    }
    print "*                                                     *\n";
    print "*******************************************************\n";
}

sub ebox {
    print "\n";
    print "*******************************************************\n";
    print "*                                                     *\n";
    print "*    Error:                                           *\n";
    foreach my $i (@_) {
        print "*    ",$i,"\n";
    }
    print "*                                                     *\n";
    print "*******************************************************\n";
}
