File Coverage

blib/lib/NBI/Job.pm
Criterion Covered Total %
statement 75 128 58.5
branch 22 56 39.2
condition 0 3 0.0
subroutine 15 22 68.1
pod 14 14 100.0
total 126 223 56.5


line stmt bran cond sub pod time code
1             package NBI::Job;
2             #ABSTRACT: A class for representing a job for NBI::Slurm
3              
4 6     6   870 use 5.012;
  6         21  
5 6     6   41 use warnings;
  6         10  
  6         176  
6 6     6   28 use Carp qw(confess);
  6         10  
  6         296  
7 6     6   1910 use Data::Dumper;
  6         21295  
  6         374  
8 6     6   2880 use File::Spec::Functions;
  6         5015  
  6         509  
9             $Data::Dumper::Sortkeys = 1;
10 6     6   40 use File::Basename;
  6         12  
  6         10642  
11              
12             $NBI::Job::VERSION = $NBI::Slurm::VERSION;
13             my $DEFAULT_QUEUE = "nbi-short";
14             require Exporter;
15             our @ISA = qw(Exporter);
16              
17              
18             sub new {
19 104     104 1 1582 my $class = shift @_;
20 104         153 my ($job_name, $commands_array, $command, $opts);
21              
22             # Descriptive instantiation with parameters -param => value
23 104 50       245 if (substr($_[0], 0, 1) eq '-') {
24 104         271 my %data = @_;
25             # Try parsing
26 104         237 for my $i (keys %data) {
27 308 100       792 if ($i =~ /^-name/) {
    100          
    50          
    0          
28 104         164 $job_name = $data{$i};
29             } elsif ($i =~ /^-command$/) {
30 103         201 $command = $data{$i};
31             } elsif ($i =~ /^-opts$/) {
32             # Check that $data{$i} is an instance of NBI::Opts
33 101 50       301 if ($data{$i}->isa('NBI::Opts')) {
34             # $data{$i} is an instance of NBI::Opts
35 101         174 $opts = $data{$i};
36             } else {
37             # $data{$i} is not an instance of NBI::Opts
38 0         0 confess "ERROR NBI::Job: -opts must be an instance of NBI::Opts\n";
39             }
40            
41             } elsif ($i =~ /^-commands$/) {
42             # Check that $data{$i} is an array
43 0 0       0 if (ref($data{$i}) eq 'ARRAY') {
44 0         0 $commands_array = $data{$i};
45             } else {
46 0         0 confess "ERROR NBI::Job: -commands must be an array\n";
47             }
48             } else {
49 0         0 confess "ERROR NBI::Seq: Unknown parameter $i\n";
50             }
51             }
52             }
53            
54 104         200 my $self = bless {}, $class;
55            
56              
57 104 50       232 $self->{name} = defined $job_name ? $job_name : 'job-' . int(rand(1000000));
58 104         136 $self->{jobid} = 0;
59            
60             # Commands: if both commands_array and command are defined, append command to commands_array
61 104 50       220 if (defined $commands_array) {
    100          
62 0         0 $self->{commands} = $commands_array;
63 0 0       0 if (defined $command) {
64 0         0 push @{$self->{commands}}, $command;
  0         0  
65             }
66             } elsif (defined $command) {
67 103         194 $self->{commands} = [$command];
68             }
69              
70             # Opts must be an instance of NBI::Opts, check first
71 104 100       168 if (defined $opts) {
72             # check that $opts is an instance of NBI::Opts
73 101 50       206 if ($opts->isa('NBI::Opts')) {
74             # $opts is an instance of NBI::Opts
75 101         144 $self->{opts} = $opts;
76             } else {
77             # $opts is not an instance of NBI::Opts
78 0         0 confess "ERROR NBI::Job: -opts must be an instance of NBI::Opts\n";
79             }
80            
81             } else {
82 3         8 $self->{opts} = NBI::Opts->new($DEFAULT_QUEUE);
83             }
84 104         224 return $self;
85            
86             }
87              
88              
89             sub name : lvalue {
90             # Update name
91 406     406 1 773 my ($self, $new_val) = @_;
92 406 50       667 $self->{name} = $new_val if (defined $new_val);
93 406         1245 return $self->{name};
94             }
95              
96             sub jobid : lvalue {
97             # Update jobid
98 0     0 1 0 my ($self, $new_val) = @_;
99 0 0 0     0 if (defined $new_val and $new_val !~ /^-?(\d+)$/) {
100 0         0 confess "ERROR NBI::Job: jobid must be an integer ". $new_val ."\n";
101             }
102 0 0       0 $self->{jobid} = $new_val if (defined $new_val);
103 0         0 return $self->{jobid};
104             }
105              
106             sub outputfile : lvalue {
107             # Update name
108 202     202 1 278 my ($self, $new_val) = @_;
109 202 50       341 $self->{output_file} = $new_val if (defined $new_val);
110 202 100       350 if (not defined $self->{output_file}) {
111 101         152 $self->{output_file} = catfile( $self->opts->tmpdir , $self->name . ".%j.out");
112             } else {
113 101         183 return $self->{output_file};
114             }
115             }
116              
117             sub errorfile : lvalue {
118             # Update name
119 202     202 1 299 my ($self, $new_val) = @_;
120 202 50       325 $self->{error_file} = $new_val if (defined $new_val);
121 202 100       341 if (not defined $self->{error_file}) {
122 101         163 $self->{error_file} = catfile($self->opts->tmpdir, $self->name . ".%j.err");
123             } else {
124 101         158 return $self->{error_file};
125             }
126            
127             }
128             sub append_command {
129 1     1 1 3 my ($self, $new_command) = @_;
130 1         1 push @{$self->{commands}}, $new_command;
  1         4  
131             }
132              
133             sub prepend_command {
134 0     0 1 0 my ($self, $new_command) = @_;
135 0         0 unshift @{$self->{commands}}, $new_command;
  0         0  
136             }
137              
138             sub commands {
139 0     0 1 0 my ($self) = @_;
140 0         0 return $self->{commands};
141             }
142              
143             sub commands_count {
144 4     4 1 10 my ($self) = @_;
145 4         5 return 0 + scalar @{$self->{commands}};
  4         22  
146             }
147              
148             sub set_opts {
149 1     1 1 7 my ($self, $opts) = @_;
150             # Check that $opts is an instance of NBI::Opts
151 1 50       10 if ($opts->isa('NBI::Opts')) {
152             # $opts is an instance of NBI::Opts
153 1         4 $self->{opts} = $opts;
154             } else {
155             # $opts is not an instance of NBI::Opts
156 0         0 confess "ERROR NBI::Job: -opts must be an instance of NBI::Opts\n";
157             }
158             }
159              
160             sub get_opts {
161 0     0 1 0 my ($self) = @_;
162 0         0 return $self->{opts};
163             }
164              
165             sub opts {
166 410     410 1 529 my ($self) = @_;
167 410         838 return $self->{opts};
168             }
169              
170             ## Run job
171              
172             sub script {
173             # Generate the sbatch script
174 202     202 1 1290 my ($self) = @_;
175            
176 202         395 my $template = [
177             '#SBATCH -J NBI_SLURM_JOBNAME',
178             '#SBATCH -o NBI_SLURM_OUT',
179             '#SBATCH -e NBI_SLURM_ERR',
180             ''
181             ];
182 202         318 my $header = $self->opts->header();
183             # Replace the template
184 202         324 my $script = join("\n", @{$template});
  202         371  
185             # Replace the values
186            
187 202         358 my $name = $self->name;
188 202         310 my $file_out = $self->outputfile;
189 202         326 my $file_err = $self->errorfile;
190 202         677 $script =~ s/NBI_SLURM_JOBNAME/$name/g;
191 202         494 $script =~ s/NBI_SLURM_OUT/$file_out/g;
192 202         411 $script =~ s/NBI_SLURM_ERR/$file_err/g;
193              
194             # Add the commands
195 202         272 $script .= join("\n", @{$self->{commands}});
  202         358  
196              
197 202         650 return $header . $script . "\n";
198              
199             }
200              
201             sub run {
202 0     0 1   my $self = shift @_;
203             # Check it has some commands
204            
205            
206             # Check it has a queue
207 0 0         if (not defined $self->opts->queue) {
208 0           confess "ERROR NBI::Job: No queue defined for job " . $self->name . "\n";
209             }
210             # Check it has some opts
211 0 0         if (not defined $self->opts) {
212 0           confess "ERROR NBI::Job: No opts defined for job " . $self->name . "\n";
213             }
214             # Check it has some commands
215 0 0         if ($self->commands_count == 0) {
216 0           confess "ERROR NBI::Job: No commands defined for job " . $self->name . "\n";
217             }
218              
219             # Create the script
220 0           my $script = $self->script();
221              
222             # Create the script file
223 0           my $script_file = catfile($self->opts->tmpdir, $self->name . ".sh");
224 0 0         open(my $fh, ">", $script_file) or confess "ERROR NBI::Job: Cannot open file $script_file for writing\n";
225 0           print $fh $script;
226 0           close($fh);
227              
228             # Run the script
229              
230 0 0         if (_has_command('sbatch') == 0) {
231 0           $self->jobid = -1;
232 0           return 0;
233             }
234 0           my $job_output = `sbatch "$script_file"`;
235              
236             # Check the output
237 0 0         if ($job_output =~ /Submitted batch job (\d+)/) {
238             # Job submitted
239 0           my $job_id = $1;
240             # Update the job id
241 0           $self->{job_id} = $job_id;
242 0           return $job_id;
243             } else {
244             # Job not submitted
245 0           confess "ERROR NBI::Job: Job " . $self->name . " not submitted\n";
246             }
247 0           return $self->jobid;
248             }
249              
250              
251             sub _has_command {
252 0     0     my $command = shift;
253 0           my $is_available = 0;
254            
255 0 0         if ($^O eq 'MSWin32') {
256             # Windows system
257 0           $is_available = system("where $command >nul 2>nul") == 0;
258             } else {
259             # Unix-like system
260 0           $is_available = system("command -v $command >/dev/null 2>&1") == 0;
261             }
262            
263 0           return $is_available;
264             }
265              
266             sub _to_string {
267             # Convert string to a sanitized string with alphanumeric chars and dashes
268 0     0     my ($self, $string) = @_;
269 0           return $string =~ s/[^a-zA-Z0-9\-]//gr;
270             }
271             1;
272              
273             __END__