File Coverage

blib/lib/Slurm/Sacctmgr/Resource.pm

Criterion	Covered	Total	%
statement	47	47	100.0
branch	5	8	62.5
condition	4	11	36.3
subroutine	13	13	100.0
pod			n/a
total	69	79	87.3

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

package Slurm::Sacctmgr::Resource;
use strict;
use warnings;
use base qw(Slurm::Sacctmgr::EntityBaseRW);
use Carp qw(carp croak);

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

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

my @common_simple_accessors = qw(
	cluster
	count
	description
	name
	percentallowed
	server
	servertype
	type
);

my @common_readonly_accessors = qw(
	allocated
);

my @preTRES_accessors = qw(
);

my @postTRES_accessors = qw(
);

my @common_aref_accessors = qw(
	flags
);

my @common_accessors = (
	@common_simple_accessors,
	@common_aref_accessors,
);

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

my @ro_accessors = (
	@common_readonly_accessors
);

my @all_accessors = (
	@rw_accessors,
	@ro_accessors,
);

my @simple_accessors = (@common_simple_accessors);

__PACKAGE__->mk_accessors(@simple_accessors);
__PACKAGE__->mk_accessors(@common_readonly_accessors);

#------------	Special accessors

#Aref
__PACKAGE__->mk_arrayref_accessors(@common_aref_accessors);

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

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

sub _ro_fields($)
{	my $class = shift;
	return [ @ro_accessors ];
}

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

sub _sacctmgr_name_field($)
{	my $class = shift;
	return 'name';
}

sub _my_sacctmgr_where_clause($)
#Overloaded to match on name/cluster, which should be enough to uniquely specify???
#Remember cluster may be undef
{	my $obj = shift;
	croak "Must be called as an instnace method at "
		unless $obj && ref($obj);

	my $name = $obj->name;
	my $cluster = $obj->cluster || '';

	my $where = {
		name => $name,
		cluster => $cluster,
	};
	return $where;
}



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

sub _sacctmgr_fields_addable($$)
{	my $class = shift;
	my $sacctmgr = shift;
	return [ @rw_accessors ];
}

sub _sacctmgr_fields_updatable($$)
{	my $class = shift;
	my $sacctmgr = shift;
	return [ @rw_accessors ];
}

#Overload _sacctmgr_list_cmd to include 'withcluster' flag
sub _sacctmgr_list_cmd($$)
{	my $class = shift;
	my $sacctmgr = shift;
	my $me = $class . '::_sacctmgr_list_cmd';

	die "$me: Missing sacctmgr param at " unless $sacctmgr && ref($sacctmgr);

	my $tmp = $class->SUPER::_sacctmgr_list_cmd($sacctmgr);
	return $tmp unless $tmp && ref($tmp) eq 'ARRAY';
	push @$tmp, 'withcluster';
	return $tmp;
}

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

#All inherited

1;
__END__