File Coverage

blib/lib/Schedule/Load/Hold.pm

Criterion	Covered	Total	%
statement	33	37	89.1
branch	5	8	62.5
condition	1	6	16.6
subroutine	9	12	75.0
pod	2	5	40.0
total	50	68	73.5

# See copyright, etc in below POD section.
######################################################################

package Schedule::Load::Hold;
require 5.004;
use Schedule::Load;
use Sys::Hostname;

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

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

$VERSION = '3.064';

######################################################################
#### Creators

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {
	req_hostname=>hostname(),# Host making the request
	req_pid=>$$,		# Process ID making the request
	req_time=>time(),	# When the request was issued
	req_user=>$ENV{USER},	# User name
	req_pri=>0,		# Request priority, maybe negative for better
	hold_key=>undef,	# Key for looking up the request
	hold_load=>1,		# Load to apply to the host
	hold_time=>70,		# Seconds to hold for
	comment=>"",		# Information for printing
	allocated=>undef,	# If set, chooser allocated this hold
	@_,};
    bless $self, $class;
    $self->hold_key or carp "%Warning: No hold_key specified,";
    return $self;
}

sub set_fields {
    my $self = shift;
    my %params = (@_);
    foreach my $key (keys %{$self}) {
	$self->{$key} = $params{$key} if exists $params{$key};
    }
}

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

sub req_age { return (time() - $_[0]->req_time); }

sub compare_pri_time {
    # Sort comparison for ordering requests
    # This must return a consistent order, thus the hold_key is required as part of the compare.
    # For speed this doesn't use accessors - generally don't do this.
    return ($_[0]->{req_pri} <=> $_[1]->{req_pri}
	    || $_[0]->{req_time} <=> $_[1]->{req_time}
	    || $_[0]->{hold_key} cmp $_[1]->{hold_key});
}

######################################################################
#### 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->{$field})) {
	eval "sub $field { return \$_[0]->{$field}; }";
	return $self->{$field};
    } else {
	croak "$type->$field: Unknown ".__PACKAGE__." field $field";
    }
}
sub DESTROY {}

######################################################################
######################################################################
1;
__END__