File Coverage

blib/lib/Slurm/Sacctmgr/Event.pm

Criterion	Covered	Total	%
statement	32	32	100.0
branch	5	6	83.3
condition	1	3	33.3
subroutine	7	7	100.0
pod			n/a
total	45	48	93.7

#!/usr/local/bin/perl
#
#Part of Slurm::Sacctmgr: Perl wrapper for Slurm's sacctmgr cmd
#Represents an Event

package Slurm::Sacctmgr::Event;
use strict;
use warnings;
use base qw(Slurm::Sacctmgr::EntityBaseListable);
use Carp qw(carp croak);

#-------------------------------------------------------------------
#	Globals
#-------------------------------------------------------------------

#-------------------------------------------------------------------
#	Accessors
#-------------------------------------------------------------------

#Fields common to all slurm versions
my @common_accessors = qw(
	cluster
	clusternodes
	duration
	end
	event
	eventraw
	nodename
	reason
	start
	state
	stateraw
	user
);

#Fields from pre-TRES Slurms
my @preTRES_accessors = qw(
	cpus
);

#Fields from post-TRES Slurms
my @postTRES_accessors = qw(
	tres
);

my @all_accessors = (
	@common_accessors,
	@preTRES_accessors,
	@postTRES_accessors,
);

my @simple_accessors = @common_accessors;

__PACKAGE__->mk_accessors(@simple_accessors);

#Handle the TRES/nonTRES variants
__PACKAGE__->mk_tres_nontres_accessors('tres', 'cpus' => 'cpu' );


#-------------------------------------------------------------------
#	Overloaded methods
#-------------------------------------------------------------------

sub _rw_fields($)
{	my $class = shift;
	return [ @all_accessors ];
}

#Do NOT overload this, should never get used
#Events cannot be identified by a singlle field
#sub _sacctmgr_name_field($)
#{	my $class = shift;
#	die "This needs work";
#	return 'event';
#}

sub _sacctmgr_fields_in_order($$)
{	my $class = shift;
	my $sacctmgr = shift;
	my @fields = @common_accessors;
	if ( $sacctmgr->sacctmgr_cmd_supports('trackable_resources') )
	{	push @fields, @postTRES_accessors;
	} else
	{	push @fields, @preTRES_accessors;
	}
	return [ @fields ];
}

sub _my_sacctmgr_where_clause($)
#Overload to match on enough fields to make the event unique
#Not like this will get used, but for completeness (and regression tests)
{	my $obj = shift;
	croak "Must be called as an instance method at "
		unless $obj && ref($obj);

	#Is this enough to uniquely identify an event?
	my @fields = qw(cluster clusternodes end event nodename start state user);
	my ($fld, $val, $meth);
	my $where = {};
	foreach $fld (@fields)
	{	$meth = $fld;
		$val = $obj->$meth;
		$val = '' unless defined $val;
		$where->{$fld} = $val;
	}
	return $where;
}



#-------------------------------------------------------------------
#	Constructors, etc
#-------------------------------------------------------------------

#All inherited

1;
__END__