File Coverage

blib/lib/NBI/Opts.pm
Criterion Covered Total %
statement 132 151 87.4
branch 61 100 61.0
condition 0 2 0.0
subroutine 22 23 95.6
pod 14 14 100.0
total 229 290 78.9


line stmt bran cond sub pod time code
1             package NBI::Opts;
2             #ABSTRACT: A class for representing a the SLURM options for NBI::Slurm
3              
4 7     7   2236 use 5.012;
  7         32  
5 7     7   70 use warnings;
  7         27  
  7         238  
6 7     7   41 use Carp qw(confess);
  7         11  
  7         357  
7 7     7   715 use Data::Dumper;
  7         7119  
  7         438  
8             $Data::Dumper::Sortkeys = 1;
9 7     7   86 use File::Basename;
  7         29  
  7         829  
10              
11             $NBI::Opts::VERSION = $NBI::Slurm::VERSION;
12              
13             my $SYSTEM_TEMPDIR = $ENV{'TMPDIR'} || $ENV{'TEMP'} || "/tmp";
14             require Exporter;
15             our @ISA = qw(Exporter);
16              
17             sub _yell {
18 7     7   6735 use Term::ANSIColor;
  7         62099  
  7         15694  
19 0     0   0 my $msg = shift @_;
20 0   0     0 my $col = shift @_ || "bold green";
21 0         0 say STDERR color($col), "[NBI::Opts]", color("reset"), " $msg";
22             }
23             sub new {
24 107     107 1 2433 my $class = shift @_;
25 107         220 my ($queue, $memory, $threads, $opts_array, $tmpdir, $hours, $email_address, $email_when) = (undef, undef, undef, undef, undef, undef, undef);
26            
27             # Descriptive instantiation with parameters -param => value
28 107 100       270 if (substr($_[0], 0, 1) eq '-') {
29            
30 104         383 my %data = @_;
31              
32             # Try parsing
33 104         287 for my $i (keys %data) {
34            
35             # QUEUE
36 811 100       2855 if ($i =~ /^-queue/) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
37 103 50       191 next unless (defined $data{$i});
38 103         175 $queue = $data{$i};
39            
40              
41             # THREADS
42             } elsif ($i =~ /^-threads/) {
43 101 50       180 next unless (defined $data{$i});
44             # Check it's an integer
45 101 50       315 if ($data{$i} =~ /^\d+$/) {
46 101         201 $threads = $data{$i};
47             } else {
48 0         0 confess "ERROR NBI::Seq: -threads expects an integer\n";
49             }
50            
51            
52             # MEMORY
53             } elsif ($i =~ /^-memory/) {
54 101 50       182 next unless (defined $data{$i});
55 101         207 $memory = _mem_parse_mb($data{$i});
56            
57              
58             # TMPDIR
59             } elsif ($i =~ /^-tmpdir/) {
60 101 50       180 next unless (defined $data{$i});
61 101         157 $tmpdir = $data{$i};
62            
63             # MAIL ADDRESS
64             } elsif ($i =~ /^-(mail|email_address)/) {
65 101 50       212 next unless (defined $data{$i});
66 101         179 $email_address = $data{$i};
67            
68             # WHEN MAIL
69             } elsif ($i =~ /^-(when|email_type)/) {
70 101 50       193 next unless (defined $data{$i});
71 101         163 $email_when = $data{$i};
72            
73              
74             # OPTS ARRAY
75             } elsif ($i =~ /^-opts/) {
76 101 50       196 next unless (defined $data{$i});
77             # in this case we expect an array
78 101 50       254 if (ref($data{$i}) ne "ARRAY") {
79 0         0 confess "ERROR NBI::Seq: -opts expects an array\n";
80             }
81 101         157 $opts_array = $data{$i};
82            
83              
84             # TIME
85             } elsif ($i =~ /^-time/) {
86 101         195 $hours = _time_to_hour($data{$i});
87            
88             } else {
89 1         261 confess "ERROR NBI::Seq: Unknown parameter $i\n";
90             }
91             }
92             }
93            
94 106         236 my $self = bless {}, $class;
95            
96             # Set attributes
97 106 100       291 $self->queue = defined $queue ? $queue : "nbi-short";
98 106 100       233 $self->threads = defined $threads ? $threads : 1;
99 106 100       234 $self->memory = defined $memory ? $memory : 100;
100 106 100       209 $self->hours = defined $hours ? $hours : 1;
101 106 100       203 $self->tmpdir = defined $tmpdir ? $tmpdir : $SYSTEM_TEMPDIR;
102 106 100       224 $self->email_address = defined $email_address ? $email_address : undef;
103 106 100       237 $self->email_type = defined $email_when ? $email_when : "none";
104             # Set options
105 106 100       208 $self->opts = defined $opts_array ? $opts_array : [];
106            
107            
108            
109            
110              
111 106         253 return $self;
112            
113             }
114              
115              
116             sub queue : lvalue {
117             # Update queue
118 108     108 1 193 my ($self, $new_val) = @_;
119 108 50       180 $self->{queue} = $new_val if (defined $new_val);
120 108         278 return $self->{queue};
121             }
122              
123             sub threads : lvalue {
124             # Update threads
125 106     106 1 158 my ($self, $new_val) = @_;
126 106 50       172 $self->{threads} = $new_val if (defined $new_val);
127 106         199 return $self->{threads};
128             }
129              
130             sub memory : lvalue {
131             # Update memory
132 106     106 1 151 my ($self, $new_val) = @_;
133 106 50       162 $self->{memory} = _mem_parse_mb($new_val) if (defined $new_val);
134 106         161 return $self->{memory};
135             }
136              
137             sub email_address : lvalue {
138             # Update memory
139 106     106 1 157 my ($self, $new_val) = @_;
140 106 50       161 $self->{email_address} = $new_val if (defined $new_val);
141 106         170 return $self->{email_address};
142             }
143              
144             sub email_type : lvalue {
145             # Update memory
146 106     106 1 153 my ($self, $new_val) = @_;
147 106 50       177 $self->{email_type} = $new_val if (defined $new_val);
148 106         162 return $self->{email_type};
149             }
150              
151             sub hours : lvalue {
152             # Update memory
153 106     106 1 168 my ($self, $new_val) = @_;
154 106 50       168 $self->{hours} = _time_to_hour($new_val) if (defined $new_val);
155 106         155 return $self->{hours};
156             }
157              
158             sub tmpdir : lvalue {
159             # Update tmpdir
160 308     308 1 448 my ($self, $new_val) = @_;
161 308 50       515 $self->{tmpdir} = $new_val if (defined $new_val);
162 308         565 return $self->{tmpdir};
163             }
164              
165             sub opts : lvalue {
166             # Update opts
167 106     106 1 224 my ($self, $new_val) = @_;
168 106 50       200 if (not defined $self->{opts}) {
169 106         272 $self->{opts} = [];
170 106         223 return $self->{opts};
171             }
172             # check newval is an array
173 0 0       0 confess "ERROR NBI::Opts: opts must be an array, got $new_val\n" if (ref($new_val) ne "ARRAY");
174 0 0       0 $self->{opts} = $new_val if (defined $new_val);
175 0         0 return $self->{opts};
176             }
177             sub add_option {
178             # Add an option
179 1     1 1 403 my ($self, $new_val) = @_;
180 1         2 push @{$self->{opts}}, $new_val;
  1         3  
181 1         2 return $self->{opts};
182             }
183              
184             sub opts_count {
185             # Return the number of options
186 1     1 1 6 my $self = shift @_;
187 1 50       3 return defined $self->{opts} ? scalar @{$self->{opts}} : 0;
  1         6  
188             }
189              
190             sub view {
191             # Return a string representation of the object
192 203     203 1 513 my $self = shift @_;
193 203         251 my $str = " --- NBI::Opts object ---\n";
194 203         465 $str .= " queue:\t" . $self->{queue} . "\n";
195 203         316 $str .= " threads:\t" . $self->{threads} . "\n";
196 203         332 $str .= " memory MB:\t" . $self->{memory} . "\n";
197 203         847 $str .= " time (h):\t" . $self->{hours} . "\n";
198 203         351 $str .= " tmpdir:\t" . $self->{tmpdir} . "\n";
199 203         257 $str .= " ---------------------------\n";
200 203         230 for my $o (@{$self->{opts}}) {
  203         340  
201 203         373 $str .= "#SBATCH $o\n";
202             }
203 203         459 return $str;
204             }
205              
206             sub header {
207             # Return a header for the script based on the options
208 202     202 1 297 my $self = shift @_;
209 202         250 my $str = "#!/bin/bash\n";
210             # Queue
211 202         392 $str .= "#SBATCH -p " . $self->{queue} . "\n";
212             # Nodes: 1
213 202         273 $str .= "#SBATCH -N 1\n";
214             # Time
215 202         324 $str .= "#SBATCH -t " . $self->timestring() . "\n";
216             # Memory
217 202         426 $str .= "#SBATCH --mem=" . $self->{memory} . "\n";
218             # Threads
219 202         342 $str .= "#SBATCH -c " . $self->{threads} . "\n";
220             # Mail
221 202 50       382 if (defined $self->{email_address}) {
222 202         336 $str .= "#SBATCH --mail-user=" . $self->{email_address} . "\n";
223 202         339 $str .= "#SBATCH --mail-type=" . $self->{email_type} . "\n";
224             }
225             # Custom options
226 202         237 for my $o (@{$self->{opts}}) {
  202         346  
227 202 50       332 next if not defined $o;
228 202         347 $str .= "#SBATCH $o\n";
229             }
230 202         402 return $str;
231             }
232              
233             sub timestring {
234 202     202 1 263 my $self = shift @_;
235 202         266 my $hours = $self->{hours};
236 202         377 my $days = 0+ int($hours / 24);
237 202         287 $hours = $hours % 24;
238             # Format hours to be 2 digits
239 202         477 $hours = sprintf("%02d", $hours);
240 202         481 return "${days}-${hours}:00:00";
241             }
242              
243             sub _mem_parse_mb {
244 101     101   148 my $mem = shift @_;
245 101 50       318 if ($mem=~/^(\d+)$/) {
    0          
246             # bare number: interpret as MB
247 101         246 return $mem;
248             } elsif ($mem=~/^(\d+)\.?(MB?|GB?|TB?|KB?)$/i) {
249 0 0       0 if (substr(uc($2), 0, 1) eq "G") {
    0          
    0          
    0          
250 0         0 $mem = $1 * 1024;
251             } elsif (substr(uc($2), 0, 1) eq "T") {
252 0         0 $mem = $1 * 1024 * 1024;
253             } elsif (substr(uc($2), 0, 1) eq "M") {
254 0         0 $mem = $1;
255             } elsif (substr(uc($2), 0, 1) eq "K") {
256 0         0 continue;
257             } else {
258             # Consider MB
259 0         0 $mem = $1;
260             }
261             } else {
262 0         0 confess "ERROR NBI::Opts: Cannot parse memory value $mem\n";
263             }
264 0         0 return $mem;
265             }
266              
267             sub _time_to_hour {
268             # Get an integer (hours) or a string in the format \d+D \d+H \d+M
269 101     101   144 my $time = shift @_;
270 101         182 $time = uc($time);
271 101 50       280 if ($time =~/^(\d+)$/) {
272             # Got an integer
273 0         0 return $1;
274             } else {
275 101         171 my $hours = 0;
276 101         326 while ($time =~/(\d+)([DHM])/g) {
277 303         542 my $val = $1;
278 303         382 my $unit = $2;
279 303 100       580 if ($unit eq "D") {
    100          
    50          
    0          
280            
281 101         337 $hours += $val * 24;
282            
283             } elsif ($unit eq "M") {
284 101         146 $val /= 60;
285 101         295 $hours += $val;
286              
287             } elsif ($unit eq "H") {
288 101         281 $hours += $val;
289            
290             } elsif ($unit eq "S") {
291 0         0 continue;
292             } else {
293 0         0 confess "ERROR NBI::Opts: Cannot parse time value $time\n";
294             }
295            
296             }
297 101         294 return $hours;
298             }
299             }
300              
301              
302             1;
303              
304             __END__