File Coverage

blib/lib/NBI/Slurm.pm
Criterion Covered Total %
statement 28 106 26.4
branch 4 40 10.0
condition 0 6 0.0
subroutine 8 13 61.5
pod 7 7 100.0
total 47 172 27.3


line stmt bran cond sub pod time code
1             #ABSTRACT: NBI Slurm module
2 15     15   2234197 use strict;
  15         31  
  15         616  
3 15     15   77 use warnings;
  15         24  
  15         1001  
4              
5             package NBI::Slurm;
6 15     15   7248 use NBI::Job;
  15         55  
  15         936  
7 15     15   7552 use NBI::Opts;
  15         47  
  15         1037  
8 15     15   101 use base qw(Exporter);
  15         27  
  15         3964  
9             our @ISA = qw(Exporter);
10             our @EXPORT = qw(Job Opts load_config has_squeue timelog execute_command %FORMAT_STRINGS);
11              
12             $NBI::Slurm::VERSION = '0.16.1';
13              
14              
15              
16              
17             our %FORMAT_STRINGS = (
18             'account' => '%a',
19             'jobid' => '%A',
20             'jobname' => '%j',
21             'cpus' => '%C',
22             'end_time' => '%E',
23             'start_time' => '%S',
24             'total_time' => '%l',
25             'time_left' => '%L',
26             'memory' => '%m',
27             'command' => '%o',
28             'queue' => '%P',
29             'reason' => '%r',
30             'status' => '%T', # short: %t
31             'workdir' => '%Z',
32             'user' => '%u',
33             );
34              
35             sub execute_command {
36 0     0 1 0 my ($command) = @_;
37            
38             # Use File::Temp functionality available in core Perl
39 15     15   14643 use File::Temp qw(tempfile);
  15         337324  
  15         17854  
40            
41             # Create temporary files for capturing output
42 0         0 my ($stdout_fh, $stdout_file) = tempfile(UNLINK => 1);
43 0         0 my ($stderr_fh, $stderr_file) = tempfile(UNLINK => 1);
44 0         0 close($stdout_fh); # Close handles so system() can write to files
45 0         0 close($stderr_fh);
46            
47             # Execute command with output redirection
48 0         0 my $full_command = "$command >$stdout_file 2>$stderr_file";
49 0         0 system($full_command);
50            
51             # Capture exit code (system() returns exit code << 8)
52 0         0 my $exit_code = $? >> 8;
53            
54             # Read stdout
55 0         0 my $stdout = '';
56 0 0       0 if (open(my $stdout_read_fh, '<', $stdout_file)) {
57 0         0 $stdout = do { local $/; <$stdout_read_fh> };
  0         0  
  0         0  
58 0         0 close($stdout_read_fh);
59             }
60            
61             # Read stderr
62 0         0 my $stderr = '';
63 0 0       0 if (open(my $stderr_read_fh, '<', $stderr_file)) {
64 0         0 $stderr = do { local $/; <$stderr_read_fh> };
  0         0  
  0         0  
65 0         0 close($stderr_read_fh);
66             }
67            
68             # Files are automatically cleaned up due to UNLINK => 1
69            
70             return {
71 0         0 stdout => $stdout,
72             stderr => $stderr,
73             exit_code => $exit_code
74             };
75             }
76              
77             sub load_config {
78 1     1 1 2 my $filename = shift;
79 1 50       4 if (! $filename) {
80 0         0 $filename = "$ENV{HOME}/.nbislurm.config";
81             }
82 1         4 my $config = {};
83 1 50       367 if (! -e "$filename") {
84 1 50       6 say STDERR "# Config file not found: $filename" if ($ENV{"DEBUG"});
85 1         5 return $config;
86             }
87 0 0       0 open(my $fh, "<", $filename) or die "Cannot open $filename: $!";
88 0         0 while (<$fh>) {
89 0         0 chomp;
90 0 0       0 next if (/^\s*$/);
91 0 0       0 next if (/^#/);
92 0 0       0 next if (/^;/);
93 0         0 my ($key, $value) = split(/=/, $_);
94             # discard keys with spaces
95 0 0       0 next if ($key =~ /\s/);
96 0         0 $config->{$key} = $value;
97             }
98 0         0 close $fh;
99 0         0 return $config;
100             }
101              
102              
103             sub has_squeue {
104 1     1 1 140158 my $cmd = "squeue --version";
105 1         8145 my $output = `$cmd 2>&1`;
106 1 50       64 if ($? == 0) {
107 0         0 return 1;
108             } else {
109 1         71 return 0;
110             }
111             }
112              
113             sub queues {
114 0     0 1   my $can_fail = shift;
115             # Retrieve queues from SLURM
116 0           my $has_sinfo = undef;
117 0           eval {
118 0           $has_sinfo = `sinfo --version > /dev/null 2>&1`;
119             };
120            
121 0 0         chomp($has_sinfo) if defined $has_sinfo;
122 0 0 0       if (not defined $has_sinfo and ! $can_fail) {
123 0           Carp::croak "ERROR NBI::Slurm: sinfo failed. Are you in a SLURM cluster?\n";
124             }
125 0           my $cmd = "timeout 5s sinfo --format '%P' --noheader";
126 0           my @output = `$cmd 2>/dev/null`;
127 0 0 0       if ($? != 0 and ! $can_fail) {
128 0           Carp::croak "ERROR NBI::Slurm: sinfo did not find queues. Are you in a SLURM cluster?\n";
129             }
130            
131 0           chomp @output;
132 0           return @output;
133             }
134              
135             sub valid_queue {
136 0 0   0 1   if ($ENV{'SKIP_SLURM_CHECK'}) {
137 0           return 1;
138             }
139 0           my $queue = shift;
140 0           my @queues = queues('CAN_FAIL');
141 0           my @input_queues = split(/,/, $queue);
142              
143 0 0         if (scalar(@input_queues) == 0) {
144             # Let's assume it exists... TODO CHECK
145 0           return 1;
146             }
147 0           foreach my $input_queue (@input_queues) {
148 0 0         if (! grep { $_ eq $input_queue } @queues) {
  0            
149 0           return 0;
150             }
151             }
152 0           return 1;
153             }
154              
155              
156             sub days_since_update {
157 0     0 1   my $file_path = shift;
158              
159             # Check if the required modules can be loaded
160 0           eval {
161 0           require File::Spec;
162 0           require Time::Piece;
163 0           require Time::Seconds;
164             };
165 0 0         if ($@) {
166 0           return -1; # Failed to load required module(s)
167             }
168              
169             # Check if the file exists
170 0 0         unless (-e $file_path) {
171 0           return -1; # File not found
172             }
173              
174             # Get the file's last modification time
175 0           my $last_modified = (stat($file_path))[9];
176              
177             # Calculate the number of days since the last modification
178 0           my $current_time = time();
179 0           my $days_since_update = int(($current_time - $last_modified) / (24 * 60 * 60));
180              
181 0           return $days_since_update;
182             }
183              
184             sub timelog {
185 0     0 1   my $tag = shift;
186 0 0         $tag = "nbi-slurm" unless defined $tag;
187 0           my ($sec, $min, $hour, $day, $month, $year) = localtime(time);
188 0           $year += 1900; # Adjust year (localtime returns years since 1900)
189 0           $month += 1; # Adjust month (localtime returns 0-11)
190            
191             # Format with leading zeros
192 0           return sprintf("[%s:%04d-%02d-%02d %02d:%02d:%02d]\t",
193             $tag, $year, $month, $day, $hour, $min, $sec);
194             }
195              
196             1;
197              
198             __END__