#!/usr/bin/perl

#  Copyright 2002, 2003 University of Southern California
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#  Latest version of this software may be found at:
#      http://www-rcf.usc.edu/~garrick/pbstop
#  Please send comments to garrick@usc.edu.

# configurable defaults
my $columns      	= 30;      # columns in grid
my $sleeptime    	= 20;      # seconds between refreshes
my $colorize     	= 1;       # 1 or 0
my $show_summary 	= 1;       # 1 or 0
my $compact_summary	= 0;       # 1 or 0
my $show_grid    	= 1;       # 1 or 0
my $show_queue   	= 1;       # 1 or 0
my $show_qqueue  	= 1;       # 1 or 0
my $show_jobs    	= 1;       # 1 or 0
my @show_cpu     	= ("0");   # list of cpu numbers
my @host                = ();      # leave empty for localhost
my $maxy         	= 200;     # maximum number of rows
my $maxx         	= 200;     # maximum number of columns

my $qmgr         	= "/usr/local/pbs/bin/qmgr";
my $qstat        	= "/usr/local/pbs/bin/qstat";
my $pbsnodes     	= "/usr/local/pbs/bin/pbsnodes";



#########################################################
### Nothing else to adjust below here

use strict;
use vars qw/$VERSION/;
use Curses;
use Data::Dumper;

$VERSION = "3.3";


my %letter_colors;
my %Job_of_letter;
my %Letter_of_job;
my @Colors = init_colors();

my ( $y, $x, $Y, $X, $py, $px, $ly, $lx ) = ( 0, 0, 0, 0, 0, 0 );

-e $qmgr or chomp( $qmgr = `which qmgr 2>/dev/null` );
-e $qmgr     or die "qmgr: Command not found\n";
-e $qstat    or chomp( $qstat = `which qstat 2>/dev/null` );
-e $qstat    or die "qstat: Command not found\n";
-e $pbsnodes or chomp( $pbsnodes = `which pbsnodes 2>/dev/null` );
-e $pbsnodes or die "pbsnodes: Command not found\n";

#FIXME# I want to print to stdout if it's not a terminal
my $Batch = !-t STDOUT;

while ( my $arg = shift @ARGV ) {
    if ( $arg eq '-c' ) {
        $columns = shift @ARGV;
        $columns =~ /^\d+$/ or $ARGV[0] = '-h';
        $columns > 0 or $ARGV[0] = '-h';
    }
    elsif ( $arg eq '-s' ) {
        $sleeptime = shift @ARGV;
        $sleeptime =~ /^\d+$/ or $ARGV[0] = '-h';
        $sleeptime > 0 or $ARGV[0] = '-h';
    }
    elsif ( $arg eq '-C' ) {
        $colorize = !$colorize;
    }
    elsif ( $arg eq '-S' ) {
        $show_summary = !$show_summary;
    }
    elsif ( $arg eq '-G' ) {
        $show_grid = !$show_grid;
    }
    elsif ( $arg eq '-Q' ) {
        $show_queue = !$show_queue;
    }
    elsif ( $arg eq '-t' ) {
        $show_qqueue = !$show_qqueue;
    }
    elsif ( $arg eq '-J' ) {
        $show_jobs = !$show_jobs;
    }
    elsif ( $arg =~ /^-(\d+)$/ ) {
        @show_cpu = split ( //, $1 );
    }
    elsif ( $arg =~ /^@(.*)/ ) {
        push(@host, $1);
    }
    elsif ( $arg eq '-V' ) {
        print
          "pbstop $VERSION\nCopyright 2002-2003 University of Southern California\n";
        exit(0);
    }
    else {
        print "Usage:  pbstop [-c columns] [-s seconds] [options] [\@host ...]\n";
        print "   Version: $VERSION\n";
        print "   Copyright 2002-2003 University of Southern California\n";
        print "   garrick\@usc.edu http://www-rcf.usc.edu/~garrick/pbstop\n";
        print "   grep FIXME `which pbstop` if you want to help out\n\n";
        print "   -s  seconds between refreshes\n";
        print "   -c  number of columns to display in the grid\n";
        print "   -C  toggle colorization\n";
        print "   -S  toggle state summary display\n";
        print "   -G  toggle grid display\n";
        print "   -Q  toggle queue display\n";
        print "   -t  toggle showing queued jobs in queue display\n";
        print "   -[0-9]...  cpu numbers for grid display\n";
        print "   -J  toggle jobs in grid display\n";
        print "   -V  print version and exit\n";
        exit(1);
    }
}

defined($host[0]) or $host[0] = defined $ENV{"PBS_DEFAULT"}
                                    ? $ENV{"PBS_DEFAULT"}
                                    : `hostname`;
chomp( @host );


#FIXME# need to handle SIGWINCH some day
$SIG{'INT'} = sub { endwin; exit(0); };

-t STDOUT or filter();

initscr;
cbreak;
noecho;
getmaxyx( $Y, $X );
start_color;

my $pr = 0;

#FIXME# The way I'm handling colors blows.
#FIXME# need to redesign this to get more than 16 color combos
#FIXME# color combos are getting better, still room for improvement
init_pair( ++$pr, COLOR_RED,     COLOR_BLACK );
init_pair( ++$pr, COLOR_GREEN,   COLOR_BLACK );
init_pair( ++$pr, COLOR_YELLOW,  COLOR_BLACK );
init_pair( ++$pr, COLOR_BLUE,    COLOR_BLACK );
init_pair( ++$pr, COLOR_MAGENTA, COLOR_BLACK );
init_pair( ++$pr, COLOR_CYAN,    COLOR_BLACK );
init_pair( ++$pr, COLOR_WHITE,   COLOR_BLACK );
#init_pair( ++$pr, COLOR_BLACK,   COLOR_BLACK );
#init_pair( ++$pr, COLOR_RED,     COLOR_WHITE );
#init_pair( ++$pr, COLOR_GREEN,   COLOR_WHITE );
#init_pair( ++$pr, COLOR_YELLOW,  COLOR_WHITE );
#init_pair( ++$pr, COLOR_BLUE,    COLOR_WHITE );
#init_pair( ++$pr, COLOR_MAGENTA, COLOR_WHITE );
#init_pair( ++$pr, COLOR_CYAN,    COLOR_WHITE );
#init_pair( ++$pr, COLOR_WHITE,   COLOR_WHITE );
init_pair( ++$pr, COLOR_BLACK,   COLOR_WHITE );
#init_pair( ++$pr, COLOR_RED,     COLOR_YELLOW );
#init_pair( ++$pr, COLOR_GREEN,   COLOR_YELLOW );
#init_pair( ++$pr, COLOR_YELLOW,  COLOR_YELLOW );
#init_pair( ++$pr, COLOR_BLUE,    COLOR_YELLOW );
init_pair( ++$pr, COLOR_MAGENTA, COLOR_YELLOW );
#init_pair( ++$pr, COLOR_CYAN,    COLOR_YELLOW );
#init_pair( ++$pr, COLOR_WHITE,   COLOR_YELLOW );
#init_pair( ++$pr, COLOR_BLACK,   COLOR_YELLOW );
init_pair( ++$pr, COLOR_RED,     COLOR_CYAN );
#init_pair( ++$pr, COLOR_GREEN,   COLOR_CYAN );
init_pair( ++$pr, COLOR_YELLOW,  COLOR_CYAN );
#init_pair( ++$pr, COLOR_BLUE,    COLOR_CYAN );
init_pair( ++$pr, COLOR_MAGENTA, COLOR_CYAN );
#init_pair( ++$pr, COLOR_CYAN,    COLOR_CYAN );
init_pair( ++$pr, COLOR_WHITE,   COLOR_CYAN );
init_pair( ++$pr, COLOR_BLACK,   COLOR_CYAN );
init_pair( ++$pr, COLOR_RED,     COLOR_MAGENTA ); 
init_pair( ++$pr, COLOR_GREEN,   COLOR_MAGENTA );  # current 16th
init_pair( ++$pr, COLOR_YELLOW,  COLOR_MAGENTA );
init_pair( ++$pr, COLOR_BLUE,    COLOR_MAGENTA );
#init_pair( ++$pr, COLOR_MAGENTA, COLOR_MAGENTA );
init_pair( ++$pr, COLOR_CYAN,    COLOR_MAGENTA );
init_pair( ++$pr, COLOR_WHITE,   COLOR_MAGENTA );
#init_pair( ++$pr, COLOR_BLACK,   COLOR_MAGENTA );
#init_pair( ++$pr, COLOR_RED,     COLOR_RED );
init_pair( ++$pr, COLOR_GREEN,   COLOR_RED );
init_pair( ++$pr, COLOR_YELLOW,  COLOR_RED );
init_pair( ++$pr, COLOR_BLUE,    COLOR_RED );
init_pair( ++$pr, COLOR_MAGENTA, COLOR_RED );
init_pair( ++$pr, COLOR_CYAN,    COLOR_RED );
init_pair( ++$pr, COLOR_WHITE,   COLOR_RED );
init_pair( ++$pr, COLOR_BLACK,   COLOR_RED );
init_pair( ++$pr, COLOR_RED,     COLOR_GREEN );
#init_pair( ++$pr, COLOR_GREEN,   COLOR_GREEN );
init_pair( ++$pr, COLOR_YELLOW,  COLOR_GREEN );
init_pair( ++$pr, COLOR_BLUE,    COLOR_GREEN );
init_pair( ++$pr, COLOR_MAGENTA, COLOR_GREEN );
init_pair( ++$pr, COLOR_CYAN,    COLOR_GREEN );
init_pair( ++$pr, COLOR_WHITE,   COLOR_GREEN );
init_pair( ++$pr, COLOR_BLACK,   COLOR_GREEN );

sub init_colors {
    return ( 1 .. 36 );
}

my $pad = newpad( $maxy, $maxx );
my $cmdwin = newwin( 1, $X - 1, $Y - 1, 0 );
keypad( $cmdwin, 1 );


main_loop(\@host);

#   The original color set that I actually spent some time planning
#        "\033[07;34m",    "\033[07;35m",    "\033[07;36m",
#        "\033[07;37m",    "\033[01;37m",    "\033[35m",
#        "\033[36m",       "\033[37m",       "\033[34m",
#        "\033[33m",       "\033[32m",       "\033[01;36;45m",
#        "\033[01;30;47m", "\033[01;30;46m", "\033[36;45m",
#        "\033[30;47m",    "\033[30;46m",    "\033[01;33m",
#        "\033[01;34m",    "\033[01;35m",    "\033[01;36m",
#        "\033[01;31m",    "\033[01;32m",

###############################################################
## All subroutines below here
###############################################################

sub main_loop {
    my $host = shift;
    my $maxlen;
    my %Nodes;
    my %Jobs;
    my %State_count;

    # Main event loop.
    while (1) {

        %Nodes       = ();
        %Jobs        = ();
        %State_count = ();

        $State_count{_nodes}  = 0;
        $State_count{_anodes} = 0;
        $State_count{_procs}  = 0;
        $State_count{_aprocs} = 0;
        $State_count{_mprocs} = 0;
        $State_count{_rjobs}  = 0;
        $State_count{_njobs}  = 0;

        #FIXME# Would a single call to 'qstat -f' be better? The queue
        #FIXME# and jobnames wouldn't get truncated.
        #FIXME# qstat -f would be a pain in the arse to parse
        #FIXME# Maybe I need to write a real openpbs perl module.

        #my $hoststring=join ' ', map { "\@$_" } @$host;
        foreach my $server (@$host) {
            my @qmgr = `$qmgr -c 'l n \@$server' $server`;    # find out everything
            $? and do { endwin; die "Connection to pbs failed.\n" };
    
            my @qstat = `$qstat -a \@$server`;
            $? and do { endwin; die "Connection to pbs failed.\n" };
    
            my $node;
            my $jobs;
            my $eatingjobs=0;
            foreach (@qmgr) {
                chomp;
    
                #FIXME# Should store node names in an array to preserve order.
                if (/^Node /) {
                    $node = $';
                    $State_count{_nodes}++;
                }
                elsif (/\s+np = (.*)/) {
                    $Nodes{$server}{$node}{np} = $1;
                    $State_count{_procs} += $1;
                    $State_count{_mprocs} =
                      $State_count{_mprocs} > $1
                      ? $State_count{_mprocs}
                      : $1;
                }
                elsif (/\s+state = (.*)/) {
                    $Nodes{$server}{$node}{state} = $1;
                    $State_count{$1}++;
                }
                elsif (/\s+jobs = (.*)/) {
                    $eatingjobs=1;
                    $jobs = $1;
                    $State_count{"_anodes"}++;
                    foreach my $job ( split ( /, /, $jobs ) ) {
                        if ( $job =~ m{(\d+)/(\d+)} ) {
                            $Nodes{$server}{$node}{job}{$1} = $2;
                            $State_count{"_aprocs"}++;
                        }
                    }
                }
                elsif ($eatingjobs) {
                   if ($_ =~ /\w/) {
                      /^\s+(.*)$/;
                      $jobs = $1;
                      foreach my $job ( split ( /, /, $jobs ) ) {
                        if ( $job =~ m{(\d+)/(\d+)} ) {
                            $Nodes{$server}{$node}{job}{$1} = $2;
                            $State_count{"_aprocs"}++;
                        }
                      }
                   }
                   else {
                     $eatingjobs=0;
                   }
                }
            }
    
            my $job;
            foreach (@qstat) {
                my @qs = split ( " ", $_ );
                if ( scalar @qs == 11 and $qs[0] =~ /^\d+/ ) {
                    ( $job = $qs[0] ) =~ s/(\d+)\.[a-z0-9A-Z-.]+/$1/;
                    $Jobs{$job}{server} = $server;
                    $Jobs{$job}{user}   = $qs[1];
                    $Jobs{$job}{queue}  = $qs[2];
                    $Jobs{$job}{jname}  = $qs[3];
                    $Jobs{$job}{ncount} = $qs[5];
                    $Jobs{$job}{reqt}   = $qs[8];
                    $Jobs{$job}{state}  = $qs[9];
                    $Jobs{$job}{elpt}   = $qs[10];
                    $qs[9] eq "R" and $State_count{"_rjobs"}++;
                    $State_count{"_njobs"}++;
                }
            }
        }
    
        $maxlen |= getmaxkeylen( \%Nodes );
        letterize( \%Jobs );

        update_display( \%State_count, \%Nodes, \%Jobs, $maxlen,
            $State_count{"_mprocs"} );
        -t STDOUT or do { endwin; exit; };
        top_sleep( \%State_count, \%Nodes, \%Jobs, $maxlen,
            $State_count{"_mprocs"} );

    }
}

sub update_display {
    my $foo;
    move( $pad, 0, 0 );
    getmaxyx( $Y, $X );

    $y = 0, $x = 0;

    #FIXME# hrm, perhaps these routines should return printable strings.
    #FIXME# it would make batch vs. non-batch easier.
    $show_summary and show_state_summary( $_[0] );
    $show_grid and show_grid( $_[1], $_[3], $_[4] );
    $show_queue and show_queue( $_[2] );
    $show_grid
      and addstr( $pad, ++$y, 0,
        "[?] unknown  [@] busy  [*] down  [.] idle  [%] offline  [!] other" );
    getyx( $pad, $ly, $foo );
    clrtobot($pad);

    prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
    mvwin( $cmdwin, $Y - 1, 0 );
    refresh($cmdwin);
}

sub show_state_summary {
    my $t  = 1;
    my $t2 = 1;

    addstr $pad,
      sprintf(
        "Usage Totals: %d/%d %s, %d/%d %s, %d/%d %s",
        ${ $_[0] }{_aprocs},
        ${ $_[0] }{_procs},
        "Procs",
        ${ $_[0] }{_anodes},
        ${ $_[0] }{_nodes},
        "Nodes",
        ${ $_[0] }{_rjobs},
        ${ $_[0] }{_njobs},
        "Jobs Running"
      );

    my ( $y1, $x1 );
    getyx( $pad, $y1, $x1 );
    addstr $pad, " " x ( $X - $x1 - 8 );

    # Asbed asked for the time
    addstr $pad, sprintf( "%02d:%02d:%02d", ( localtime() )[ 2, 1, 0 ] );

    my $line;
    my @states = sort grep !/^_/, keys %{ $_[0] };

    if ( $compact_summary ) {
    move( $pad, ++$y, $x = 0 );
    addstr( $pad, 1, 0, "Node States:" );
    for ( my $i = 0 ; defined $states[$i] ; $i++ ) {
        $line= " ".${ $_[0] }{ $states[$i] }." ". $states[$i];
        $line.= defined $states[$i+1] ? "," : "";
        getyx( $pad, $y1, $x1 );
        if ( $X-$x1-1 < length($line) ) {
            clrtoeol($pad);
            move( $pad, ++$y, $x = 0 );
            addstr ($pad, " " x 12);
        }
        addstr ($pad, $line);
    }
    move( $pad, ++$y, $x = 0 );
    clrtoeol($pad);
            
    } else {
       
        for ( my $i = 0 ; defined $states[$i] ; $i++ ) {
            move( $pad, ++$y, $x = 0 );
            $line = " " x 14;
            $line.= sprintf( "%4s %-20s", ${ $_[0] }{ $states[$i] }, $states[$i] );
    
            $i++;
            $line .= sprintf( "%4s %-20s", ${ $_[0] }{ $states[$i] }, $states[$i] )
              if defined $states[$i];
            $line .= " " x ( $X - ( length($line) + 14 ) );
            addstr $pad, $line;
            clrtoeol($pad);
        }
        addstr( $pad, 1, 0, "Node States:" );
        move( $pad, ++$y, $x = 0 );
    }
}

sub show_grid {
    my ( $allnodes, $maxlen, $maxprocs ) = @_;
    my ( $foo, $tmpx );
    $lx = 0;

    clrtoeol($pad);
    move( $pad, ++$y, $x = 0 );

    if ( !scalar @show_cpu ) {
        addstr $pad, "  No CPUs selected!";
        clrtoeol($pad);
        return;
    }

    printvcpuline($maxlen);

    foreach my $server (keys %$allnodes ) {

        my (@cluster, @ts);
        foreach my $node ( sort keys %{$allnodes->{$server}} ) {
            $$allnodes{$server}{$node}{np} > 7
                ? push(@ts, $node)
                : push(@cluster, $node);
        }



        # loop through each node, in lines and columns
        my $col  = 0;
        
        if(defined $cluster[0]) {
            my $headerspaces = scalar @show_cpu;
            printnumberline ( $maxlen, $headerspaces, $columns );
            printdashline( $maxlen, $headerspaces, $columns );

            foreach my $node ( @cluster ) {
                $col = 0 if $col >= $columns;
                (addstr $pad, sprintf "  %${maxlen}s ", $node) if $col == 0;
        
                addstr $pad, "  " if ( $col != 0 and $col % 10 == 0 );
        
                foreach my $this_cpu (@show_cpu) {
                    if ( $this_cpu > $$allnodes{$server}{$node}{np} - 1 ) {
                        addstr $pad, " ";
    
                    } else {
                        my $job   = $$allnodes{$server}{$node}{job}{$this_cpu};
                        my $state = $$allnodes{$server}{$node}{state};
                        printcpustate($job, $state);
        
                    }
                }
    
                addstr $pad, " ";
                $col++;
                getyx( $pad, $foo, $tmpx );
                $lx = $lx > $tmpx ? $lx : $tmpx;

                clrtoeol($pad);
                move( $pad, ++$y, $x = 0 ) if $col >= $columns;
                
        
                #return if $y >= $Y;
            }
            clrtoeol($pad);
            move( $pad, ++$y, $x = 0 ) if $col != $columns;
            printdashline( $maxlen, $headerspaces, $columns );
            clrtoeol($pad);
            move( $pad, ++$y, $x = 0 );
        }
        foreach my $node (@ts) {
            my $headerspaces=1;
            printnumberline ( $maxlen, $headerspaces, $columns );
            printdashline( $maxlen, $headerspaces, $columns );
        
            my $col  = 0;
            foreach my $this_cpu (0 .. $$allnodes{$server}{$node}{np}-1) {
                $col = 0 if $col >= $columns;
                (addstr $pad, sprintf "  %${maxlen}s ", $node) if $col == 0;
        
                addstr $pad, "  " if ( $col != 0 and $col % 10 == 0 );
                my $job   = $$allnodes{$server}{$node}{job}{$this_cpu};
                my $state = $$allnodes{$server}{$node}{state};
                printcpustate($job, $state);
    
                addstr $pad, " ";
                $col++;
                getyx( $pad, $foo, $tmpx );
                $lx = $lx > $tmpx ? $lx : $tmpx;
    
                clrtoeol($pad);
                move( $pad, ++$y, $x = 0 ) if $col >= $columns;
            }
            clrtoeol($pad);
            move( $pad, ++$y, $x = 0 ) if $col != $columns;
            printdashline( $maxlen, 1, $columns );
            clrtoeol($pad);
            move( $pad, ++$y, $x = 0 );
        }

    }

    clrtoeol($pad);

}

sub show_queue {
    my $jobs = shift;

    # print out the job queue
    move( $pad, ++$y, $x = 0 );

    #return if $y >= $Y;
    attron( $pad, A_BOLD );
    addstr( $pad,
        "      Job#  Username  Queue    Jobname    Nodes   S  Elapsed/Requested"
    );
    attroff( $pad, A_BOLD );
    clrtoeol($pad);
    move( $pad, ++$y, $x = 0 );

    # Sort first by server, then by queue, last by jobid
    foreach my $job ( sort {$jobs->{$a}{server} cmp $jobs->{$b}{server} || 
                            $jobs->{$a}{queue} cmp $jobs->{$b}{queue} || 
                            $a <=> $b} keys %{$jobs} ) {

        #return if $y >= $Y;
        my $l = $Letter_of_job{$job};
        if ( defined $jobs->{$job}{user} ) {
            if ( !( $jobs->{$job}{state} =~ /Q|H/ and !$show_qqueue ) ) {
                addstr $pad, "  ";
                if ( defined $l and $jobs->{$job}{state} eq "R" ) {
                    colorize_letter($l);
                    addstr $pad, " = ";
                }
                else {
                    addstr $pad, "    ";
                }

                addstr $pad,
                  sprintf(
                    "%-5s %-8s  %-8s %-10s   %3s   %1s  %7s/%s    ",
                    $job,                  $jobs->{$job}{user},
                    $jobs->{$job}{queue},  $jobs->{$job}{jname},
                    $jobs->{$job}{ncount}, $jobs->{$job}{state},
                    $jobs->{$job}{elpt},   $jobs->{$job}{reqt}
                  );
                clrtoeol($pad);
                move( $pad, ++$y, $x = 0 );
            }
        }
    }

    clrtoeol($pad);
}

# this process seems kludgy to me, but it actually works fine
sub letterize {
    my $Jobs    = shift;
    my $letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";

    # remove info about old jobs and jobs already assigned a letter
    foreach my $l ( keys %Job_of_letter ) {
        if ( exists $Jobs->{ $Job_of_letter{$l} }{user} ) {
            $letters =~ s/$l//;
        }
        else {
            delete $Job_of_letter{$l};
        }
    }
    foreach my $job ( keys %Letter_of_job ) {
        delete $Letter_of_job{$job} if ( !exists $Jobs->{$job} );
    }

    # pick a letter if not already choosen
    foreach my $job ( keys %{$Jobs} ) {
        next if !defined $Jobs->{$job}{state};
        next if $Jobs->{$job}{state} eq "Q";
        my $user = $Jobs->{$job}{user};
        if ( !exists $Letter_of_job{$job} ) {

            # find a letter that isn't already taken
            my $l = substr( $user, 0, 1 );
            if ( exists $Job_of_letter{$l} ) {
                $l = uc($l);
                if ( exists $Job_of_letter{$l} ) {
                    $letters =~ s/(.)//;
                    $l = $1;
                }
            }
            $Job_of_letter{$l}   = $job;
            $Letter_of_job{$job} = $l;
            $letters =~ s/$l//;
        }
    }
}

sub getmaxkeylen {

    # find the longest hostname
    my $maxlen = 0;
    foreach my $server ( keys %{ $_[0] } ) {
        foreach ( keys %{${ $_[0] }{$server}} ) {
            $maxlen =
              length($_) > $maxlen
              ? length($_)
              : $maxlen;
        }
    }
    return $maxlen;
}


sub printcpustate {
    my ($job, $state) = @_;

                if ( $state =~ /down/ and $job ) {
                    colorize_letter( $Letter_of_job{$job}, "*" );
                }
                elsif ( $job and $show_jobs ) {
                    colorize_letter( $Letter_of_job{$job} );
                }
                elsif ( $state =~ /offline/ ) {
                    addch $pad, "%";
                }
                elsif ( $state =~ /down/ ) {
                    attron( $pad, A_BOLD | COLOR_PAIR(1) );
                    addch $pad, "*";
                    attroff( $pad, A_BOLD | COLOR_PAIR(1) );
                }
                elsif ( $state =~ /job-exclusive/ ) {
                    addch $pad, '@';
                }
                elsif ( $state =~ /busy/ ) {
                    addch $pad, "@";
                }
                elsif ( $state =~ /unknown/i ) {
                    attron( $pad, A_BOLD | COLOR_PAIR(1) );
                    addch $pad, "?";
                    attroff( $pad, A_BOLD | COLOR_PAIR(1) );
                }
                elsif ( $state =~ /free/ ) {
                    addch $pad, ".";
                }
                else {
                    attron( $pad, A_BOLD | COLOR_PAIR(1) );
                    addch $pad, "!";
                    attroff( $pad, A_BOLD | COLOR_PAIR(1) );
                }
}

sub printvcpuline {
    my $maxlen=shift;
    # inform the user of the visible CPUs.
    if ( scalar @show_cpu == 1 ) {
        addstr $pad, "  CPU $show_cpu[0]" . " " x ( $maxlen - 4 );
    }
    #elsif ( scalar @show_cpu == $maxprocs ) {
    #addstr "   " . " " x ($maxlen);
    #}
    else {
        addstr $pad, " " x ( $X - 1 );
        move( $pad, $y, 0 );
        addstr $pad, " visible CPUs: " . join ( ",", @show_cpu );
    }
    clrtoeol($pad);
    move( $pad, ++$y, $x = 0 );
}

sub printdashline {
    my $maxlen = shift;
    my $spaces = shift;
    my $columns = shift;

    my $line = "   " . " " x $maxlen;
    for ( my $i = 0 ; $i < $columns ; $i++ ) {
        $line .= "--" if ( $i != 0 and $i % 10 == 0 );
        $line .= "-" . "-" x $spaces;
    }
    $line =~ s/-$//;    # oops, we printed one extra, erase it
    addstr $pad, $line;
    clrtoeol($pad);
    move( $pad, ++$y, $x = 0 );
}

sub printnumberline {
    my $maxlen = shift;
    my $spaces = shift;
    my $columns = shift;

    my $line = "   " . " " x $maxlen;
    for ( my $i = 0, my $j = 0 ; $i < $columns ; $i++, $j++ ) {
        if ( $i != 0 and $i % 10 == 0 ) {
            $line .= "  ";
            $j = 0;
        }
        $line .= ( ( $j + 1 ) % 10 ) . " " x $spaces;
    }
    addstr $pad, $line;
    clrtoeol($pad);
    move( $pad, ++$y, $x = 0 );

}

# First arguement is a letter, figure out a color for it,
# then print the letter _or_ any remaining args in that color
sub colorize_letter {

    $colorize or do { addstr $pad, "@_"; return };

    my $l = shift or return;
    scalar @Colors == 0 and @Colors = init_colors();
    if ( !exists $letter_colors{$l} ) {
        $letter_colors{$l} = shift @Colors;
    }

    # This sucks, I wanted to seperate printing from colors,
    # but I can't just pass back color escape strings.
    # I'm forced to combine them here.
    attron( $pad, A_BOLD | COLOR_PAIR( $letter_colors{$l} ) );
    addstr $pad, defined $_[0] ? "@_" : $l;
    attroff( $pad, A_BOLD | COLOR_PAIR( $letter_colors{$l} ) );

}

sub printwarning {
    attron( $cmdwin, A_REVERSE );
    addstr $cmdwin, 0, 0, join(" ", @_);
    attroff( $cmdwin, A_REVERSE );
    refresh($cmdwin);
    sleep 3;
    move( $cmdwin, 0, 0 );
    clrtoeol($cmdwin);
    refresh($cmdwin);
}

sub getstring {
    my $input="";
    addstr $cmdwin, 0, 0, join(" ", @_);
    refresh($cmdwin);
    echo;
    nodelay( $cmdwin, 0 );
    getstr( $cmdwin,  $input );
    noecho;
    move( $cmdwin, 0, 0 );
    clrtoeol($cmdwin);
    refresh($cmdwin);
    return $input;
}

#FIXME#  top_sleep() is a kludge, I know it... It just keeps growing
#FIXME#  as I add new commands.  *shrug*
sub top_sleep {

    my $targettime = time() + $sleeptime;

    while ( time() < $targettime ) {
        halfdelay(1);
        my $input = getch($cmdwin);
        if ( defined $input ) {
            if ( $input eq "q" ) {
                endwin;
                exit(0);
            }
            #FIXME# $helpwin should be a scrollable pad
            elsif ( $input eq "h" || $input eq "?" ) {
                my $helpwin = newwin( 0, 0, 0, 0 );
                attron( $helpwin, A_REVERSE );
                addstr $helpwin, "pbstop Version $VERSION";
                attroff( $helpwin, A_REVERSE );
                move( $helpwin, 2, 0 );
                addstr $helpwin, "Seconds Refresh ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, "$sleeptime";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nGrid Columns ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, "$columns";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nColorization ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $colorize ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nState Summary Display ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $show_summary ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nGrid Display ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $show_grid ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nGrid Job Display ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $show_jobs ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nShow CPU Number ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, join ( " ", @show_cpu );
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nQueue Display ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $show_queue ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nShow Queued Jobs ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $show_qqueue ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, <<"__EOF__";


Interactive commands are:

 space   Update Display
 q       Quit
 h       Print this help
 c       Grid Columns
 s       Seconds to refresh,
            accepts math operators (ie: 2*60)
 C       Toggle Colorization
 S       Toggle State Summary
 G       Toggle Grid Display
 Q       Toggle Queue Display
 t       Toggle Queued Jobs in Queue Display
 J       Toggle Show Jobs in Grid
 0-9     CPU number to display

Press any key to continue
__EOF__
                refresh($helpwin);
                cbreak;
                nodelay( $helpwin, 0 );
                getch($helpwin);
                halfdelay(1);
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
                move( $cmdwin, 0, 0 );
                clrtoeol($cmdwin);
                refresh($cmdwin);

                delwin($helpwin);
            }

            elsif ( $input =~ /^\d$/ ) {
                if ( grep /^$input$/, @show_cpu ) {
                    @show_cpu = grep !/$input$/, @show_cpu;
                }
                else {
                    my %seen = ();
                    foreach ( @show_cpu, $input ) {
                        $seen{$_} = 1;
                    }
                    @show_cpu = sort keys %seen;
                }

                update_display(@_);
            }

            elsif ( $input eq "s" ) {
                $input=getstring("Number of seconds for refresh[$sleeptime]? ");

                if ($input) {
                    my $tmp;

                    # *grin* I love this use of eval
                    if ( $tmp = eval $input and $tmp > 0 ) {
                        $sleeptime  = $tmp;
                        $targettime = time() + $sleeptime;
                    }
                    else {
                        printwarning("Invalid number!");
                    }
                }

            }

            elsif ( $input eq "c" ) {
                $input=getstring("Number of columns[$columns]? ");

                if ($input) {
                    if ( $input =~ /^\d+$/ and $input > 0 ) {
                        $columns = $input;
                        update_display(@_);
                    }
                    else {
                        printwarning("Invalid number!");
                    }
                }

            }

            #FIXME# had to remove the offline/clear options when I started
            #FIXME# to support multiple servers.  I haven't figured out
            #FIXME# a decent replacement interface yet
            #elsif ( $input eq "o" ) {
                #$input=getstring("Node to mark offline? ");
#
                #if ($input) {
                    #if ( exists $_[1]->{$input} ) {
                        #system( $pbsnodes, "-o", "$input", "-s", "$host" );
                    #}
                    #else {
                        #printwarning("Invalid nodename!");
                    #}
                #}
            #}
            #elsif ( $input eq "r" ) {
                #$input=getstring("Node to clear offline? ");
#
                #if ($input) {
                    #if ( exists $_[1]->{$input} ) {
                        #system( $pbsnodes, "-r", "$input", "-s", "$host" );
                    #}
                    #else {
                        #printwarning("Invalid nodename!");
                    #}
                #}
            #}

            elsif ( $input eq "C" ) {
                $colorize = !$colorize;
                update_display(@_);
            }
            elsif ( $input eq "G" ) {
                $show_grid = !$show_grid;
                update_display(@_);
            }
            elsif ( $input eq "S" ) {
                $show_summary = !$show_summary;
                update_display(@_);
            }
            elsif ( $input eq "Q" ) {
                $show_queue = !$show_queue;
                update_display(@_);
            }
            elsif ( $input eq "t" ) {
                $show_qqueue = !$show_qqueue;
                update_display(@_);
            }
            elsif ( $input eq "J" ) {
                $show_jobs = !$show_jobs;
                update_display(@_);
            }

            elsif ( $input eq "\014" ) {
                clear($pad);
                update_display(@_);
            }

            elsif ( $input eq KEY_HOME or $input eq KEY_SHOME ) {
                $py = 0;
                $px = 0;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq KEY_END or $input eq KEY_SEND ) {
                $py = $ly + 2 - $Y;
                $px = 0;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq KEY_PPAGE or $input eq KEY_SPREVIOUS 
                    or $input eq chr(2)) {
                $py -= $Y -2;
                $py <= 0 and $py = 0;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq KEY_NPAGE or $input eq KEY_SNEXT 
                    or $input eq chr(6)) {
                $py += $Y - 2;
                $py >= $ly - $Y + 2 and $py = $ly + 2 - $Y;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq "k" or $input eq KEY_UP ) {
                $py <= 0 and $py = 0, next;
                $py--;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq "j" or $input eq KEY_DOWN) {
                $py >= $ly - $Y + 2 and next;
                $py++;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq "h" or $input eq KEY_LEFT ) {
                $px <= 0 and $px = 0, next;
                $px -= 2;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq "l" or $input eq KEY_RIGHT ) {
                $px >= $lx - $X + 1 and next;
                $px += 2;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }

            elsif ( $input eq " " ) {
                addstr $cmdwin, 0, 0, "Updating...";
                refresh($cmdwin);
                move( $cmdwin, 0, 0 );
                clrtoeol($cmdwin);
                return;
            }
            #else {
                #addstr $cmdwin, 0, 0, ord($input);
            #}

        }

    }
}

