File Coverage

blib/lib/Slurm/Sacctmgr/Account.pm

Criterion	Covered	Total	%
statement	81	86	94.1
branch	20	32	62.5
condition	6	15	40.0
subroutine	14	15	93.3
pod	3	3	100.0
total	124	151	82.1

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

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

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

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

my @simple_accessors = qw(
	account
	description
	organization
);

my @arrayref_accessors = qw(
	coordinators
);

my @rw_accessors = (@simple_accessors, @arrayref_accessors );

#The following fields can be set in sacctmgr add or update commands
#All but coordinators
my @modifiable_fields = @simple_accessors;

__PACKAGE__->mk_accessors(@simple_accessors);
__PACKAGE__->mk_arrayref_accessors(@arrayref_accessors);


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

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

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

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

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

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


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

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, 'withcoord';
	return $tmp;
}

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

#All inherited

#-------------------------------------------------------------------
#	Special class methods
#-------------------------------------------------------------------

sub zero_usage_on_account_cluster($$$$;$)
#Given account name and cluster name, zero the usage
{	my $class = shift;
	my $sacctmgr = shift;
	my $account = shift;
	my $cluster = shift;
	my $quiet = shift;

        my $me = 'zero_usage_on_account_cluster';
        croak "No/invalid Slurm::Sacctmgr object passed to $me at "
                unless $sacctmgr && ref($sacctmgr);
	croak "No account name passed to $me at " unless $account;
	croak "No cluster name passed to $me at " unless $cluster;

	my $where = { 	name => $account, cluster=>$cluster };
	my $set = { rawusage => 0 };

	$class->sacctmgr_modify($sacctmgr, $where, $set, $quiet);
}

sub set_cpumin_limit_on_account_cluster($$$$$)
#DEPRECATED.  Use set_grptresmin_on_account_cluster instead
{	my $class = shift;
	my @args = @_;
	return $class->set_grptresmin_on_account_cluster(@args);
}

sub set_grptresmin_on_account_cluster($$$$$;$)
#Given account name and cluster name, and cpumin, set GrpCpuMins to $cpumin
#for that account/cluster.  Use -1 to unset???
{	my $class = shift;
	my $sacctmgr = shift;
	my $account = shift;
	my $cluster = shift;
	my $tresmin = shift;
	my $quiet = shift;
        my $me = __PACKAGE__ . '::set_grptresmin_on_account_cluster';

        croak "$me: No/invalid Slurm::Sacctmgr object given at "
                unless $sacctmgr && ref($sacctmgr);
	croak "$me: No account name given at " unless $account;
	croak "$me: No cluster name given at " unless $cluster;
	croak "$me: No tresmin given at " unless defined $tresmin;

	unless ( $tresmin && ref($tresmin) )
	{	croak "$me: undef $tresmin given at " unless defined $tresmin;
		#See if looks like TRES string or number
		if ( $tresmin =~ /=/ )
		{	#Looks like a tresmin string
			$tresmin = $class->_string2hashref($tresmin, $me);
		} else
		{ 	#Assume we were given cpumin for GrpCPUMins
			#We need to round cpumin to the nearest minute
			my $cpumin = floor($tresmin + 0.5);
			$tresmin = { cpu => $cpumin };
		}
	}

	unless ( %$tresmin )
	{	#Empty hash given, nothing to do, but warn
		carp "$me: Ignoring empty GrpTRESmin hash at ";
		return;
	}

	my $where = { 	name => $account, cluster=>$cluster };
	my $set;
	if ( $sacctmgr->sacctmgr_cmd_supports( 'trackable_resources' ) )
	{	#Our sacctmgr command supports trackable resources, use them
		$set = { grptresmins => $tresmin };
	} else
	{	#We do NOT support TRES
		my $tmp = { %$tresmin }; #Make a copy
		my $cpumin = delete $tmp->{cpu};
		if ( %$tmp )
		{	my @tmp = keys %$tmp;
			$tmp = join ", ", @tmp;
			carp "$me: TRES names [ $tmp ] provided to non-TRES capable sacctmgr, will be ignored, at "
				unless $quiet;
		}
		$set = { grpcpumins => $cpumin };
	}

	$class->sacctmgr_modify($sacctmgr, $where, $set, $quiet);
}


1;
__END__