File Coverage

blib/lib/Slurm/Sacctmgr/WCKey.pm
Criterion Covered Total %
statement 28 30 93.3
branch 2 4 50.0
condition 1 3 33.3
subroutine 7 8 87.5
pod n/a
total 38 45 84.4


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 an WCKey
5              
6             package Slurm::Sacctmgr::WCKey;
7 60     60   23089 use strict;
  60         70  
  60         1359  
8 60     60   189 use warnings;
  60         60  
  60         1149  
9 60     60   180 use base qw(Slurm::Sacctmgr::EntityBaseListable);
  60         60  
  60         19933  
10 60     60   223 use Carp qw(carp croak);
  60         60  
  60         10317  
11              
12             #-------------------------------------------------------------------
13             # Globals
14             #-------------------------------------------------------------------
15              
16             #-------------------------------------------------------------------
17             # Accessors
18             #-------------------------------------------------------------------
19              
20             my @rw_accessors = qw(
21             wckey
22             cluster
23             user
24             );
25              
26             __PACKAGE__->mk_accessors(@rw_accessors);
27              
28             #-------------------------------------------------------------------
29             # Overloaded methods
30             #-------------------------------------------------------------------
31              
32             sub _rw_fields($)
33 3824     3824   2681 { my $class = shift;
34 3824         7857 return [ @rw_accessors ];
35             }
36              
37             sub _sacctmgr_name_field($)
38 0     0   0 { my $class = shift;
39 0         0 return 'wckey';
40             }
41            
42             sub _sacctmgr_fields_in_order($$)
43 1862     1862   2058 { my $class = shift;
44 1862         1653 my $sacctmgr = shift;
45 1862         6243 return [ @rw_accessors ];
46             }
47              
48             sub _my_sacctmgr_where_clause($)
49             #Overloaded to match on wckey, user, and cluster.
50             #Sort of pointless, think we need to match everything
51 230     230   289 { my $obj = shift;
52 230 50 33     1066 croak "Must be called as an instance method at "
53             unless $obj && ref($obj);
54              
55             #Do everything, because nothing else is necessarily unique
56 230         479 my @fields = @rw_accessors;
57              
58 230         229 my ($fld, $val, $meth);
59 230         255 my $where = {};
60 230         550 foreach $fld (@fields)
61 690         504 { $meth = $fld;
62 690         1183 $val = $obj->$meth;
63 690 50       3750 $val = '' unless defined $val;
64 690         1032 $where->{$fld} = $val;
65             }
66 230         679 return $where;
67             }
68             #-------------------------------------------------------------------
69             # Constructors, etc
70             #-------------------------------------------------------------------
71              
72             #All inherited
73              
74             1;
75             __END__