package CheckLoad;

use strict;
use vars qw (@ISA @EXPORT_OK);
use Exporter;
@ISA = ('Exporter');
@EXPORT_OK = qw( CheckLoad );

# Author : Gavin Sherlock
# Date   : 25th September 2000

# This package exports a function call that checks to see if the load on the 
# machine on which a cgi is running is too high

###################################################################################
sub CheckLoad{
###################################################################################
# This function will check the load of the machine on which a process is running.
# It will repeatedly check the load, until it drops below some specified threshold,
# at which time it will return to the calling cgi.  While checking the load, it
# will periodically print out it's progress.

# Usage : CheckLoad(maxload=>$maxload,
#                   loadlog=>$loadlog);

# if no maxload variable is passed in, it will default to a value of 10
# in addition a machine name may be specified, and, via rsh, it will check the load
# on that machine

# if a noprint variable is passed in, messages will not be printed back to the
# browser.

    my (%args) = @_;

    my $maxload = $args{'maxload'} || 10 ;
    my $loadLog = $args{'loadlog'};
    my $machine = $args{'machine'};
    my $noprint = $args{'noprint'}; # if they want printing suppressed
    my $checkOnce = $args{'checkOnce'}; # if they only want to check once
    
    my $remotehost = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} ;
    
    my $success = 0;

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    
    if ($year > 99) {
	$year -= 100;
    }

    my $thetime = sprintf ("%2d/%2d/%2d:%2d:%2d:%2d", $mday,$mon+1,$year,$hour,$min,$sec);
    
    $thetime =~ s/ /0/g;
    
    my $loadfirst = 1;
    
    while (&LoadTooHigh($maxload, $machine)) { # simply wait until the load drops, if it's too high
	
	if ($checkOnce){

	    return ($success);

	}

	if ( $loadfirst ) {
	    $noprint || print "Please wait... The load on the server is too high. Your request will start once the load drops.<br>\n";
	    $loadfirst = 0;
	    if ($loadLog){
		open (LOADLOG, ">>$loadLog") || warn "$0: could not open loadlog\n";
		print LOADLOG "$thetime $remotehost $0\n";
		close (LOADLOG);
	    }
	}else{
	    $noprint || print "waiting...\n<br>";
	}
	sleep 10;
    }

    # if we get here, we must have been successful, ie the load wasn't too high

    $success = 1;

    return ($success);
    
}

################################################################################################################
sub LoadTooHigh {
################################################################################################################
# This subroutine checks the load, to see if the machine is too busy
# by making a system call to w and parsing out the most recent load mesurement
    
# if the load was too high it returns a 1, otherwise it returns a 0
    
    my ($maxload, $machine) = @_;

    my @lines;

    if ($machine){
	@lines= `rsh $machine /usr/ucb/w`;
    }else{
	@lines= `/usr/ucb/w`;
    }

    my $load;
    
    if ( $lines[0] =~ /load average: (\d+.\d+)/ ) {
	$load = $1;
    }
    
    return ($load > $maxload);
    
}