File Coverage

blib/lib/Slurm/Sacctmgr/Association.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 Association

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

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

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

#Accessors common to all versions of slurm
my @common_accessors = qw(
	account
	cluster
	defaultqos
	fairshare
	grpjobs
	grpsubmitjobs
	grpwall
	id
	lft
	maxjobs
	maxsubmitjobs
	maxwall
	parentid
	parentname
	partition
	qos
	rgt
	user
);

#Accessors in pre-TRES (< 15.x.y) versions of Slurm
my @preTRES_accessors = qw(
	grpcpumins
	grpcpurunmins
	grpcpus
	grpnodes
	maxcpumins
	maxcpus
	maxnodes
);

#Accessors in post-TRES versions of Slurm
my @postTRES_accessors = qw(
	grptresmins
	grptresrunmins
	grptres
	maxtresmins
	maxtres
	maxtrespernode
);

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

my @simple_accessors = ( @common_accessors );


__PACKAGE__->mk_accessors(@simple_accessors);

#-------------	Special accessors; handle TRES and non-TRES fields

__PACKAGE__->mk_tres_nontres_accessors('grptres', 'grpcpus' => 'cpu', 'grpnodes' => 'node' );
__PACKAGE__->mk_tres_nontres_accessors('grptresmins', 'grpcpumins' => 'cpu' );
__PACKAGE__->mk_tres_nontres_accessors('grptresrunmins', 'grpcpurunmins' => 'cpu' );
__PACKAGE__->mk_tres_nontres_accessors('maxtres', 'maxcpus' => 'cpu', 'maxnodes' => 'node' );
__PACKAGE__->mk_tres_nontres_accessors('maxtresmins', 'maxcpumins' => 'cpu' );


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

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

#Do NOT overload this, should never get used.
#Associations cannot be specified with one single field
#sub _sacctmgr_name_field($)
#{	my $class = shift;
#	return 'account';
#}

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($)
#OVerloaded to match on cluster, account, user, and partition
#Returns a where clause hash that should return the current entity.
{       my $obj = shift;
        croak "Must be called as an instance method at "
                unless $obj && ref($obj);

	my @fields = qw(cluster account user partition);
	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__