#!/usr/local/bin/perl -Tw
use vars qw( $IDENTITY %USERNAME $QUIET $DBHOST $DBTYPE $DATABASE $DBUSER
	     $DBPASS $DEBUG $version $CLASS $ROOTCLASS $DEBUG $SSH %ARGS
	     %CENTERS @CENTERS );
$version = "0.6";

###############################################################################
### Configuration + Private Data ##############################################
###############################################################################

## Load shared configurations and/or private data using 'do' commands, as
## seen below.  Note that several 'do's can be run if necessary.  

# do '/FULL/PATH/TO/CODE/TO/RUN';       

## This is the perl class that you will be using in this script.  

$CLASS   = "TCB::SysLoads";                     # Database class

## This is the root class of the above class.  Essentially a hack to let
## there be multiple modules using the same database.

$ROOTCLASS = "TCB::System";                     # Class of the database class

## Modify and uncomment this to use user modules instead of system-wide
## ones.  You'll need this unless you're installing as root.

# use lib '/PATH/TO/USER/CODE';
# use lib '/home/tskirvin/dev/mdtools/tcb-sysloads';

## What's the SSH identity file that we can use, without a passphrase, to 
## log into the SC centers?  This will have to be maintained by the
## sysadmin or someone similar; the file should also be kept read-only!

$IDENTITY = "/home/tskirvin/.ssh/id_supercomp";

## What's the username on the various systems? 

%USERNAME = ( 'PSC' => 'skirvin', 'NCSA' => 'tskirvin', 'SDSC' => 'ux452376' );

## Which centers should we connect to by default?

@CENTERS = qw( TCS NCSA Teragrid Teraroam );

## Supercomputer centers we have information to look at for

%CENTERS = ( 'TCS' => \&tcsstatus, 'NCSA' => \&ncsastatus, 
	     'Teragrid' => \&terastatus, 
	     'Teraroam' => \&teraroamstatus );

our %ARGS = ( 
	'NCSA'	   => [ "tungsten.ncsa.uiuc.edu" ],
	'Teragrid' => [ "TG-MCA93S028", 'tg-login.sdsc.teragrid.org' ],
	'Teraroam' => [ "TG-MCA93T028", 'tg-login.sdsc.teragrid.org' ],
	'TCS' 	   => [],
	    );

## Set this to not print status information by default; '-q' at the
## command-line will override this if necessary.

$QUIET    = 0;	

## Populate the database variables from an external file.  If you don't
## want to load this from an external file, you can just set the variables 
## by hand - but why?

# $DBHOST   = "";               # System that hosts the database
# $DBTYPE   = "";               # The type of database that we're working on
# $DATABASE = "";               # Name of the database we're connecting to
# $DBUSER   = "";               # Username to connect to the database
# $DBPASS   = "";               # Password to connect to the database

do "/home/webserver/dbaccess/user.sysloads";    

## Location of the SSH binary

$SSH = "/usr/local/bin/ssh -2";

## Debugging information?  Also set with '-D'

$DEBUG = 0;

###############################################################################
### main() ####################################################################
###############################################################################

use Getopt::Std;
use DBIx::Frame;
use strict;

# Load the appropriate class module
{ local $@; eval "use $CLASS";  die "$@\n" if $@; }

# Clean up defined variables
delete $ENV{'PATH'};	# So we can use 'system' and taint mode
$0 =~ s%.*/%%;		# Clear annoying path information

# Parse command-line options
use vars qw( $DB $opt_q $opt_v $opt_h $opt_d $opt_s $opt_D );
getopts('qdvhas:D');
$QUIET++  if $opt_q;	
Version() if $opt_v;
Usage()   if $opt_h;
$DEBUG++  if $opt_D;

# Connect to the database or exit if we're using -d
if ($opt_d) {
  $DB = $ROOTCLASS->connect( $DATABASE, $DBUSER, $DBPASS )
        or error("Couldn't connect to database: ", DBI->errstr);
}

my @systems = $opt_s ? ( $opt_s || "" ) : @CENTERS;

my @info;
foreach my $system (@systems) {
  next unless $CENTERS{$system};
  warn "Getting info for $system\n" if $DEBUG;
  my @args = $ARGS{$system} ? ( @{$ARGS{$system}} ) : ();
  push @info, $CENTERS{$system}(@args);
}

foreach my $info (@info) { 
  next unless ($info && ref $info);
  my ($remain, $alloc, $perc, $mach) = @{$info};
  print makestring(@{$info}), "\n" unless $QUIET;
  my $hash = { 'TimeStamp' => timestamp(),   'Machine' => $mach,
	       'SUs'       => $remain || "0.0",  'MaxSUs'  => $alloc };
  if ($DB) { 
    $DB->insert('SuperComp', $hash) 
	or warn "Couldn't insert into database - $$DB{ERROR}\n";
  }
}

$DB->disconnect if $DB;
exit(0);

###############################################################################
### Subroutines ###############################################################
###############################################################################

### makestring ( REMAINING, ALLOCATED, PERCENTAGE, MACHINE )
# Returns a string (using 'sprintf') that prints all of the above
# information in a standard format.  

sub makestring { sprintf("%7d / %7d SUs (%3d%%) remaining on %s", @_ ) }

### t3estatus ()
# Goes to the PSC T3E, gets the xbanner information, returns it (using
# xbanner())

sub t3estatus {
  my @lines = ssh('jaromir.psc.edu', $IDENTITY ? "-i $IDENTITY" : "",
			     $USERNAME{PSC} ? "-l $USERNAME{PSC}" : "", 
			     "xbanner");
  scalar @lines ? [ TCB::SysLoads->xbanner(@lines), "PSC T3E" ] : undef;
}

### tcsstatus ()
# Goes to the PSC TCSini, gets the xbanner information, returns it (using
# xbanner())

sub tcsstatus {
  my @lines = ssh('lemieux.psc.edu', $IDENTITY ? "-i $IDENTITY" : "",
			     $USERNAME{PSC} ? "-l $USERNAME{PSC}" : "", 
			     "xbanner");
  scalar @lines ? [ TCB::SysLoads->xbanner(@lines), "PSC TCS" ] : undef;
}

# sub jonasstatus {
#   my @lines = ssh('jonas.psc.edu', $IDENTITY ? "-i $IDENTITY" : "",
#                              $USERNAME{PSC} ? "-l $USERNAME{PSC}" : "",
#                              "xbanner");
#   scalar @lines ? [ TCB::SuperComp->xbanner(@lines), "PSC Jonas" ] : undef;
# }

### ncsastatus ( MACHINENAME )
# Goes to NCSA (the Origins at this point) and gets information about all
# NCSA accounts.  Returns an array of arrayrefs.

sub ncsastatus {
  my @lines = ssh( shift, $IDENTITY ? "-i $IDENTITY" : "",
			     $USERNAME{NCSA} ? "-l $USERNAME{NCSA}" : "", 
			     "usage | grep -v Deleted");
  my @return;
  foreach ( TCB::SysLoads->usage(@lines) )  { push @return, [ @{$_} ] }
  scalar @return ? @return : undef;
}

### terastatus ( ACCOUNT, MACHINENAME )
# Connects to the Teragrid and gets information about the teragrid.
sub terastatus {
  my @lines = ssh( $_[1], $IDENTITY ? "-i $IDENTITY" : "",
     $USERNAME{SDSC} ? "-l $USERNAME{SDSC}" : "", "/usr/local/bin/tgusage list",
     # $USERNAME{SDSC} ? "--user $USERNAME{SDSC}" : '',
     $_[0] ? "--account $_[0]" : "",
     "--resource teragrid" );
  scalar @lines ? [ TCB::SysLoads->tgusage(@lines), "Teragrid" ] : undef;
} 

### terastatus ( ACCOUNT, MACHINENAME )
# Connects to the Teragrid and gets information about the roaming teragrid
# allocation.
sub teraroamstatus {
  my @lines = ssh( $_[1], $IDENTITY ? "-i $IDENTITY" : "",
     $USERNAME{SDSC} ? "-l $USERNAME{SDSC}" : "", "/usr/local/bin/tgusage list",
     # $USERNAME{SDSC} ? "--user $USERNAME{SDSC}" : '',
     $_[0] ? "--account $_[0]" : "",
     "--resource teragrid" );
  scalar @lines ? [ TCB::SysLoads->tgusage(@lines), "Teragrid Roaming" ] : undef;
} 

### ssh ( OPTIONS ) 
# Connects via SSH to a system, runs a command, and returns the entire
# output as an array (or an arrayref, if invoked as a scalar).  OPTIONS is
# the full command line list of options.

sub ssh {
  my @return;
  open(SSH, "$SSH @_ |");
  while (<SSH>) { chomp; push @return, $_ }
  close(SSH);
  wantarray ? @return : join("\n", @return);
}

### timestamp ( [TIME] )
# Retuns a standard MySQL timestamp for the given TIME (or, if not given, 
# the current time).

sub timestamp {
  my $time = shift || time;
  sprintf("%04d-%02s-%02d", (localtime($time))[5] + 1900, 
	(localtime($time))[4] + 1, (localtime($time))[3] );
}

### error ( [ ERROR [, ERROR [...]]] )
# Offers each of ERROR up as a warning, then exits.

sub error { foreach (@_) { warn "$_\n" } exit(1) }

### Usage ( )
# Prints the usage information and exits.

sub Usage {  
  warn <<EOM;
$0 v$version
Retrieves supercomputer information from centers.  Prints information off 
to STDOUT, and possibly sends it to the proper databases as well.  

	-q	Quiet mode; don't print the information to STDOUT.
	-h	Prints this information and exits.
	-v	Prints the version number and exits.
	-d	Enter information into supercomputer databases.
	-s site	Connect to just this center, instead of default list.

Connects to the following centers by default:
  @CENTERS
EOM
  exit 0;
}

### Version () 
# Prints the version number and exits.

sub Version { warn "$0 v$version\n"; exit 0; }

###############################################################################
### Documentation #############################################################
###############################################################################

=head1 NAME

scstatus - Retrieves supercomputer information from centers.  

=head1 SYNOPSIS

  scstatus [-qhv] [-d] [-s site]

  Retrieves supercomputer information from centers.  Prints information off 
  to STDOUT, and possibly sends it to the proper databases as well.  

	-q	Quiet mode; don't print the information to STDOUT.
	-h	Prints this information and exits.
	-v	Prints the version number and exits.
	-d	Enter information into supercomputer databases.
	-s site	Connect to just this center, instead of default list.

Connects to the following centers by default:

  	TCS NCSA Teragrid 

=head1 DESCRIPTION

This script is used to query information from the supercomputer centers
and possibly send it to the TCB::SuperComp database for storage.  The
above synopsis should explain pretty well what it does; internally, there
are separate scripts for each supercomputer center that we connect to.  

Note that the configuration is set up internally to the script!  There are
no configuration files at 

=head1 NOTES

You must have your SSH configuration set up properly to connect to the
supercomputer sites without a password!  

=head1 REQUIREMENTS

Perl 5.6.0 or better, MySQL, C<DBIx::Frame>, B<TCB::System>,
B<TCB::SysLoads>

=head1 SEE ALSO

B<sc-times.cgi>, B<TCB::SysLoads>

=head1 AUTHOR

Written by Tim Skirvin <tskirvin@ks.uiuc.edu>.

=head1 HOMEPAGE

B<http://www.ks.uiuc.edu/Development/MDTools/tcb-sysloads>

=head1 LICENSE

This code is distributed under the University of Illinois Open Source
License.  See
C<http://www.ks.uiuc.edu/Development/MDTools/tcb-sysloads/license.html>
for
details.

=head1 COPYRIGHT

Copyright 2002-2004 by the University of Illinois Board of Trustees and
Tim Skirvin <tskirvin@ks.uiuc.edu>.

=cut

###############################################################################
#### Version History ##########################################################
###############################################################################
# 0.2 		Fri Jun 14 10:03:34 CDT 2002
### Commented and ready to go as a script.  It would be nice if I could
### figure out a way to get this information without running it as me.  
# 0.5		Fri May 14 11:09:48 CDT 2004 
### Combined the database and no-database functions into a single script.
### Commented it and made it useful for distribution.		
# 0.6		Wed Mar 23 09:50:01 CST 2005 
### Fixed up to better match how teragrid stuff works.
