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


line stmt bran cond sub pod time code
1             #!/usr/local/bin/perl
2             #
3             #Part of Slurm::Sacctmgr: Perl wrapper for Slurm's sacctmgr cmd
4             #Represents a Resource
5              
6             package Slurm::Sacctmgr::Resource;
7 107     107   42813 use strict;
  107         147  
  107         2439  
8 107     107   321 use warnings;
  107         107  
  107         2088  
9 107     107   229 use base qw(Slurm::Sacctmgr::EntityBaseRW);
  107         107  
  107         35536  
10 107     107   38993 use Carp qw(carp croak);
  107         107  
  107         38247  
11              
12             #-------------------------------------------------------------------
13             # Globals
14             #-------------------------------------------------------------------
15              
16             #-------------------------------------------------------------------
17             # Accessors
18             #-------------------------------------------------------------------
19              
20             my @common_simple_accessors = qw(
21             cluster
22             count
23             description
24             name
25             percentallowed
26             server
27             servertype
28             type
29             );
30              
31             my @common_readonly_accessors = qw(
32             allocated
33             );
34              
35             my @preTRES_accessors = qw(
36             );
37              
38             my @postTRES_accessors = qw(
39             );
40              
41             my @common_aref_accessors = qw(
42             flags
43             );
44              
45             my @common_accessors = (
46             @common_simple_accessors,
47             @common_aref_accessors,
48             );
49              
50             my @rw_accessors = (
51             @common_accessors,
52             @preTRES_accessors,
53             @postTRES_accessors,
54             );
55              
56             my @ro_accessors = (
57             @common_readonly_accessors
58             );
59              
60             my @all_accessors = (
61             @rw_accessors,
62             @ro_accessors,
63             );
64              
65             my @simple_accessors = (@common_simple_accessors);
66              
67             __PACKAGE__->mk_accessors(@simple_accessors);
68             __PACKAGE__->mk_accessors(@common_readonly_accessors);
69              
70             #------------ Special accessors
71              
72             #Aref
73             __PACKAGE__->mk_arrayref_accessors(@common_aref_accessors);
74              
75             #-------------------------------------------------------------------
76             # Overloaded methods
77             #-------------------------------------------------------------------
78              
79             sub _rw_fields($)
80 4488     4488   4691 { my $class = shift;
81 4488         19524 return [ @rw_accessors ];
82             }
83              
84             sub _ro_fields($)
85 4488     4488   7416 { my $class = shift;
86 4488         10869 return [ @ro_accessors ];
87             }
88              
89             sub _sacctmgr_fields($$)
90 634     634   868 { my $class = shift;
91 634         2257 return [ @all_accessors ];
92             }
93              
94             sub _sacctmgr_name_field($)
95 270     270   469 { my $class = shift;
96 270         904 return 'name';
97             }
98              
99             sub _my_sacctmgr_where_clause($)
100             #Overloaded to match on name/cluster, which should be enough to uniquely specify???
101             #Remember cluster may be undef
102 2598     2598   3068 { my $obj = shift;
103 2598 50 33     12982 croak "Must be called as an instnace method at "
104             unless $obj && ref($obj);
105              
106 2598         5941 my $name = $obj->name;
107 2598   50     20345 my $cluster = $obj->cluster || '';
108              
109 2598         17572 my $where = {
110             name => $name,
111             cluster => $cluster,
112             };
113 2598         5525 return $where;
114             }
115              
116            
117            
118             sub _sacctmgr_fields_in_order($$)
119 3266     3266   4372 { my $class = shift;
120 3266         4337 my $sacctmgr = shift;
121 3266         19397 my @fields = (@common_accessors, @common_readonly_accessors);
122 3266 100       11986 if ( $sacctmgr->sacctmgr_cmd_supports('trackable_resources') )
123 796         1395 { push @fields, @postTRES_accessors;
124             } else
125 2470         3714 { push @fields, @preTRES_accessors;
126             }
127 3266         12428 return [ @fields ];
128             }
129              
130             sub _sacctmgr_fields_addable($$)
131 270     270   308 { my $class = shift;
132 270         461 my $sacctmgr = shift;
133 270         1733 return [ @rw_accessors ];
134             }
135              
136             sub _sacctmgr_fields_updatable($$)
137 532     532   519 { my $class = shift;
138 532         875 my $sacctmgr = shift;
139 532         2198 return [ @rw_accessors ];
140             }
141              
142             #Overload _sacctmgr_list_cmd to include 'withcluster' flag
143             sub _sacctmgr_list_cmd($$)
144 1636     1636   1824 { my $class = shift;
145 1636         1779 my $sacctmgr = shift;
146 1636         3994 my $me = $class . '::_sacctmgr_list_cmd';
147              
148 1636 50 33     8305 die "$me: Missing sacctmgr param at " unless $sacctmgr && ref($sacctmgr);
149              
150 1636         6043 my $tmp = $class->SUPER::_sacctmgr_list_cmd($sacctmgr);
151 1636 50 33     9311 return $tmp unless $tmp && ref($tmp) eq 'ARRAY';
152 1636         3135 push @$tmp, 'withcluster';
153 1636         3424 return $tmp;
154             }
155              
156             #-------------------------------------------------------------------
157             # Constructors, etc
158             #-------------------------------------------------------------------
159              
160             #All inherited
161              
162             1;
163             __END__