File Coverage

blib/lib/Schedule/Load/Hosts/Host.pm

Criterion	Covered	Total	%
statement	123	154	79.8
branch	46	92	50.0
condition	17	52	32.6
subroutine	31	36	86.1
pod	17	26	65.3
total	234	360	65.0

# Schedule::Load::Hosts::Host.pm -- Loading information about a host
# See copyright, etc in below POD section.
######################################################################

package Schedule::Load::Hosts::Host;
require 5.004;
require Exporter;
require AutoLoader;
@ISA = qw(Exporter AutoLoader);

use Schedule::Load qw(_min _max);
use Schedule::Load::Hosts::Proc;
use Schedule::Load::Safe;

use Carp;
use strict;
use vars qw($VERSION $AUTOLOAD $Debug $Safer);

######################################################################
#### Configuration Section

# Other configurable settings.
$VERSION = '3.064';

######################################################################
#### Globals

$Debug = $Schedule::Load::Debug;
$Safer = Schedule::Load::Safe->new();

######################################################################
#### Special status

sub fields {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->hosts)';
    my @keys = keys %{$self->{const}};
    push @keys, keys %{$self->{stored}};
    push @keys, keys %{$self->{dynamic}};
    return (grep {$_ ne "procs"} @keys);
}

sub exists {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->get(field))';
    my $field = shift;
    return (exists ($self->{dynamic}{$field})
	    || exists ($self->{stored}{$field})
	    || exists ($self->{const}{$field}));
}

sub get {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->get(field))';
    my $field = shift;
    # Always look at dynamic info first, there might be a override of a const
    if (exists ($self->{dynamic}{$field})) {
	return $self->{dynamic}{$field};
    } elsif (exists ($self->{stored}{$field})) {
	return $self->{stored}{$field};
    } elsif (exists ($self->{const}{$field})) {
	return $self->{const}{$field};
    } else {
	croak __PACKAGE__.'->get($field): Unknown field';
    }
}

sub get_undef {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->get(field))';
    my $field = shift;
    # Always look at dynamic info first, there might be a override of a const
    if (exists ($self->{dynamic}{$field})) {
	return $self->{dynamic}{$field};
    } elsif (exists ($self->{stored}{$field})) {
	return $self->{stored}{$field};
    } elsif (exists ($self->{const}{$field})) {
	return $self->{const}{$field};
    } else {
	return undef;
    }
}

######################################################################
#### Matching

sub host_match {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->host_match(classesref))';
    # Params can be either a hash reference (for chooser)
    # or a list of parameters (simple user functions)
    my $paramref = $_[0];
    if (!ref $paramref) {
	$paramref = {#classes=>[],
		     #match_cb=> undef,
		     #allow_reserved=>1,
		     @_,
		 };
    }
    # For use of Hosts::hosts_match
    return ((!defined $paramref->{classes} || $self->classes_match($paramref->{classes}))
	    && (!defined $paramref->{match_cb} || $self->eval_match ($paramref->{match_cb}))
	    && (!defined $paramref->{allow_reserved} || $paramref->{allow_reserved}
		|| !$self->reserved)
	    );
}

sub host_match_chooser {
    my $self = $_[0];
    # Similar to host_match, but for internal use by the chooser - performance critical
    my $paramref = $_[1];
    my $scratchref = $_[2];
    # For use of Hosts::hosts_match
    return ((   !defined $paramref->{classes} || !defined $paramref->{classes}[0]
		|| _classes_match_chooser($self, $paramref->{classes})
		)
	    && (!defined $paramref->{match_cb}
		#Slow, so inlined:  || $self->eval_match ($paramref->{match_cb}, $scratchref)
		|| _eval_generic_cb($self, $paramref->{match_cb}, $scratchref)
		)
	    && (!defined $paramref->{allow_reserved} || $paramref->{allow_reserved}
		|| !$self->reserved)
	    );
}

sub classes_match {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->classes_match(classesref))';
    my $classesref = shift;
    return 1 if !defined $classesref || !defined $classesref->[0];  # Null reference means match everything
    (ref($classesref)) or croak 'usage: '.__PACKAGE__.'->classes_match(field, classesref))';
    foreach (@{$classesref}) {
	return 1 if get_undef($self, $_);
    }
    return 0;
}

sub _classes_match_chooser {
    my $self = $_[0];
    my $classesref = $_[1];
    foreach (@{$classesref}) {
	return 1 if get_undef($self, $_);
    }
    return 0;
}

sub eval_match {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->eval_match(subroutine)';
    my $subref = shift;
    # @_ are optional arguments
    # See inlined version in host_match_chooser
    return 1 if !defined $subref;  # Null reference means match everything
    return $self->_eval_generic_cb($subref,@_);
}

sub _eval_generic_cb {
    my $self = shift;
    my $subref = shift;
    # @_ are optional arguments
    # Call &$subref($self) in safe container
    return $Safer->eval_cb($subref,$self,@_);
}

######################################################################
#### Special accessors

sub cpus_slash {
    my $self = shift;
    if ($self->cpus != $self->physical_cpus) {
	return $self->physical_cpus."/".$self->cpus;
    } else {
	return $self->cpus;
    }
}

sub top_processes {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->key(key))';
    my @keys = (values %{$self->{dynamic}{proc}});
    grep {bless $_, 'Schedule::Load::Hosts::Proc'} @keys;
    #print "TOP PROC @keys\n";
    return (wantarray ? @keys : \@keys);
}

sub holds {
    my $self = shift;
    return if !$self->{dynamic}{holds};
    return (sort {$a->compare_pri_time($b)} (@{$self->{dynamic}{holds}}));
}

sub free_cpus {
    my $self = shift;
    # How many more jobs host can take before we should turn off new jobs
    my $free = ($self->cpus - $self->adj_load);
    $free = 0 if ($free < 0);
    $free = int ($free + .7);
    return $free;
}

sub rating_cb {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->key(key))';
    # How fast can we process a single job?
    # 0 indicates can't load this host
    # closer to 0 are the best ratings (as 'bad' is open-ended)
    if ($self->get_undef('load_limit')
	&& $self->load_limit <= $self->adj_load) {
	# Illegal to load this host more
	return 0;
    }

    my $rate = 1e9;
    # Multiply badness by cpu loading
    # Scale it to be between .8 and 1.0, else a large number of inactive jobs would
    # result in a very good rating, which would make that machine always be picked.
    $rate *= ((($self->total_pctcpu+1)/100) * 0.2 + 0.8);
    # Multiply that by number of jobs
    $rate *= ($self->adj_load+1);
    # Discount by cpus & frequency
    $rate /= $self->cpus;
    $rate /= $self->max_clock * 0.4;   # 1 free cpu at 300Mhz beat 50% of a 600 Mhz cpu
    $rate *= ($self->get_undef('rating_mult') || 1.0);

    #printf "%f * (%d+%d+1) / %f / %f = %f\n", ($self->total_pctcpu+1), $self->report_load, $self->adj_load, $self->cpus, $self->max_clock, $rate if $Debug;
    return 0 if $rate<=0;
    $rate = log($rate);		# Make a more readable number
    $rate += ($self->get_undef('rating_adder') || 0);
    return $rate;
}

sub rating {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->rating(subroutine)';
    my $subref = shift;
    return $self->rating_cb() if !defined $subref;  # Null reference means default callback
    return $self->_eval_generic_cb($subref);
}

sub rating_chooser {
    # Similar to rating, but for internal use by the chooser - performance critical
    my $self = $_[0];
    my $subref = $_[1];
    my $scratchref = $_[2];
    return $self->rating_cb() if !defined $subref;  # Null reference means default callback
    return $self->_eval_generic_cb($subref, $scratchref);
}

sub rating_text {
    my $self = shift; ($self && ref($self)) or croak 'usage: '.__PACKAGE__.'->rating(subroutine)';
    return "inf" if $self->reserved;
    return "inf" if !$self->rating;
    return "slow" if $self->get_undef('slreportd_unresponsive');
    return sprintf("%4.2f", $self->rating);
}

######################################################################
#### Accessors

sub AUTOLOAD {
    my $self = shift;
    my $type = ref($self) or croak "$self is not an ".__PACKAGE__." object";

    (my $field = $AUTOLOAD) =~ s/.*://; # Remove package

    if (exists ($self->{dynamic}{$field})) {
	# Dynamic variables stay dynamic
	eval "sub $field { return \$_[0]->{dynamic}{$field}; }";
	return $self->{dynamic}{$field};
    } elsif (exists ($self->{stored}{$field})) {
	# Stored variables can move to/from const variables
	eval "sub $field { return (exists \$_[0]->{stored}{$field} "
	    ."? \$_[0]->{stored}{$field} : \$_[0]->{const}{$field}); }";
	return $self->{stored}{$field};
    } elsif (exists ($self->{const}{$field})) {
	eval "sub $field { return (exists \$_[0]->{stored}{$field} "
	    ."? \$_[0]->{stored}{$field} : \$_[0]->{const}{$field}); }";
	return $self->{const}{$field};
    } else {
	croak "$type->$field: Unknown ".__PACKAGE__." field $field";
    }
}

sub DESTROY {}

######################################################################
######################################################################
#### Package return
1;

######################################################################
__END__