| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | #ABSTRACT: NBI::Queue, to filter jobs in the queue | 
| 2 | 1 |  |  | 1 |  | 946 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 30 |  | 
| 3 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 34 |  | 
| 4 |  |  |  |  |  |  | package NBI::Queue; | 
| 5 | 1 |  |  | 1 |  | 5 | use Carp qw(croak confess); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 45 |  | 
| 6 | 1 |  |  | 1 |  | 5 | use NBI::Slurm; | 
|  | 1 |  |  |  |  | 11 |  | 
|  | 1 |  |  |  |  | 90 |  | 
| 7 | 1 |  |  | 1 |  | 6 | use NBI::QueuedJob; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 44 |  | 
| 8 | 1 |  |  | 1 |  | 6 | use Data::Dumper qw(Dumper); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 74 |  | 
| 9 |  |  |  |  |  |  | $NBI::Queue::VERSION = $NBI::Slurm::VERSION; | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | # Export QueuedJob | 
| 14 | 1 |  |  | 1 |  | 7 | use base qw(Exporter); | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 1249 |  | 
| 15 |  |  |  |  |  |  | our @EXPORT = qw(NBI::QueuedJob new); | 
| 16 |  |  |  |  |  |  | sub new { | 
| 17 | 0 |  |  | 0 | 1 |  | my $class = shift; | 
| 18 | 0 |  |  |  |  |  | my $self = bless {}, $class; | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | # -username | 
| 22 |  |  |  |  |  |  | # -jobid | 
| 23 | 0 |  |  |  |  |  | my $username; | 
| 24 |  |  |  |  |  |  | my $jobid; | 
| 25 | 0 |  |  |  |  |  | my $queue; | 
| 26 | 0 |  |  |  |  |  | my $state_short; | 
| 27 | 0 |  |  |  |  |  | my $partitions_csv; | 
| 28 | 0 |  |  |  |  |  | my $jobname; | 
| 29 | 0 | 0 | 0 |  |  |  | if (defined $_[0] and substr($_[0], 0, 1) eq '-') { | 
| 30 | 0 |  |  |  |  |  | my %data = @_; | 
| 31 | 0 |  |  |  |  |  | for my $i (keys %data) { | 
| 32 | 0 | 0 |  |  |  |  | if ($i =~ /^-user/)  { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 33 | 0 | 0 |  |  |  |  | next unless defined $data{$i}; | 
| 34 | 0 |  |  |  |  |  | $username = $data{$i}; | 
| 35 |  |  |  |  |  |  | } elsif ($i =~ /^-jobid/)  { | 
| 36 | 0 | 0 |  |  |  |  | next unless defined $data{$i}; | 
| 37 | 0 | 0 |  |  |  |  | if ($data{$i} =~ /^\d+$/) { | 
| 38 | 0 |  |  |  |  |  | $jobid = $data{$i}; | 
| 39 |  |  |  |  |  |  | } else { | 
| 40 | 0 |  |  |  |  |  | confess "ERROR NBI::Queue: -jobid expects an integer\n"; | 
| 41 |  |  |  |  |  |  | } | 
| 42 |  |  |  |  |  |  | } elsif ($i =~ /^-queue/) { | 
| 43 | 0 | 0 |  |  |  |  | next unless defined $data{$i}; | 
| 44 | 0 |  |  |  |  |  | $queue = $data{$i}; | 
| 45 |  |  |  |  |  |  | } elsif ($i =~ /^-state/) { | 
| 46 | 0 | 0 |  |  |  |  | next unless defined $data{$i}; | 
| 47 | 0 |  |  |  |  |  | my @valid_states =  qw(PD R CG CF CA CD F TO NF SE ST RV S SO PR NF RV S SO PR); | 
| 48 | 0 | 0 |  |  |  |  | if (grep {$_ eq uc($data{$i})} @valid_states) { | 
|  | 0 |  |  |  |  |  |  | 
| 49 | 0 |  |  |  |  |  | $state_short = uc($data{$i}); | 
| 50 |  |  |  |  |  |  | } else { | 
| 51 | 0 |  |  |  |  |  | confess "ERROR NBI::Queue: -state expects one of the following values: @valid_states\n"; | 
| 52 |  |  |  |  |  |  | } | 
| 53 |  |  |  |  |  |  | } elsif ($i =~ /^-name/) { | 
| 54 | 0 | 0 |  |  |  |  | $jobname = $data{$i} if defined $data{$i}; | 
| 55 |  |  |  |  |  |  | } else { | 
| 56 | 0 |  |  |  |  |  | confess "ERROR NBI::Queue: Unknown option/parameter $i\n"; | 
| 57 |  |  |  |  |  |  | } | 
| 58 |  |  |  |  |  |  | } | 
| 59 |  |  |  |  |  |  | } | 
| 60 | 0 |  |  |  |  |  | my $jobs = _squeue($username, $jobid, $state_short, $partitions_csv, $jobname); | 
| 61 | 0 |  | 0 |  |  |  | $self->{username} = $username // undef; | 
| 62 | 0 |  | 0 |  |  |  | $self->{jobid} = $jobid // undef; | 
| 63 | 0 |  | 0 |  |  |  | $self->{queue} = $queue // undef; | 
| 64 | 0 |  | 0 |  |  |  | $self->{state_short} = $state_short // undef; | 
| 65 | 0 |  |  |  |  |  | $self->{jobs} = $jobs; | 
| 66 | 0 |  | 0 |  |  |  | $self->{jobname} = $jobname // undef; | 
| 67 | 0 |  |  |  |  |  | return $self; | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | sub remove { | 
| 71 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 72 | 0 |  |  |  |  |  | my $jobid = shift; | 
| 73 | 0 |  |  |  |  |  | my @jobs = grep {$_->jobid != $jobid} @{$self->{jobs}}; | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 74 | 0 |  |  |  |  |  | $self->{jobs} = \@jobs; | 
| 75 |  |  |  |  |  |  | } | 
| 76 |  |  |  |  |  |  | sub _squeue { | 
| 77 | 0 |  |  | 0 |  |  | my ($username, $jobid, $state_short, $partitions_csv, $jobname) = @_; | 
| 78 | 0 |  |  |  |  |  | my $field_sep = ':/:'; | 
| 79 | 0 |  |  |  |  |  | my @field_names = qw(jobid user jobname cpus memory queue status start_time end_time total_time time_left command workdir account reason); | 
| 80 | 0 |  |  |  |  |  | my $format = join $field_sep, @field_names; | 
| 81 | 0 |  |  |  |  |  | $format = _make_format_string($format); | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | # Prepare command | 
| 84 | 0 |  |  |  |  |  | my $cmd = "squeue --format '$format' --noheader "; | 
| 85 | 0 | 0 |  |  |  |  | $cmd .= " -u $username " if defined $username; | 
| 86 | 0 | 0 |  |  |  |  | $cmd .= " -j $jobid " if defined $jobid; | 
| 87 | 0 | 0 |  |  |  |  | $cmd .= " -t $state_short " if defined $state_short; | 
| 88 | 0 | 0 |  |  |  |  | $cmd .= " -p $partitions_csv " if defined $partitions_csv; | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | # Prepend '-' to @field_names | 
| 91 | 0 |  |  |  |  |  | @field_names = map { "-$_" } @field_names; | 
|  | 0 |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  |  | 
| 93 | 0 |  |  |  |  |  | my @output = `$cmd 2>/dev/null`; | 
| 94 | 0 | 0 |  |  |  |  | if ($? != 0) { | 
| 95 | 0 |  |  |  |  |  | Carp::croak "ERROR NBI::Queue: squeue failed. Are you in a SLURM cluster?\n"; | 
| 96 |  |  |  |  |  |  | } | 
| 97 | 0 |  |  |  |  |  | my @header; | 
| 98 | 0 |  |  |  |  |  | my $c = 0; | 
| 99 | 0 |  |  |  |  |  | my @jobs; | 
| 100 | 0 |  |  |  |  |  | for my $line (@output) { | 
| 101 | 0 |  |  |  |  |  | $c++; | 
| 102 | 0 |  |  |  |  |  | chomp $line; | 
| 103 |  |  |  |  |  |  |  | 
| 104 | 0 |  |  |  |  |  | my @fields = split /$field_sep/, $line; | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | # Make a hash of @fields_names and @fields | 
| 107 | 0 |  |  |  |  |  | my %job; | 
| 108 | 0 |  |  |  |  |  | @job{@field_names} = @fields; | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | ## FILTER FURTHER | 
| 111 | 0 | 0 |  |  |  |  | if (defined $jobname) { | 
| 112 | 0 | 0 |  |  |  |  | next unless $job{-"jobname"} =~ /$jobname/; | 
| 113 |  |  |  |  |  |  | } | 
| 114 |  |  |  |  |  |  |  | 
| 115 | 0 |  |  |  |  |  | my $submitted_job = NBI::QueuedJob->new(%job); | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  |  | 
| 119 | 0 |  |  |  |  |  | push @jobs, $submitted_job; | 
| 120 |  |  |  |  |  |  | } | 
| 121 | 0 |  |  |  |  |  | return \@jobs; | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | sub len { | 
| 125 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 126 | 0 |  |  |  |  |  | return scalar @{$self->{jobs}}; | 
|  | 0 |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | } | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | sub ids { | 
| 130 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 131 | 0 |  |  |  |  |  | my @ids = map {$_->jobid} @{$self->{jobs}}; | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | # If scalar | 
| 133 | 0 | 0 |  |  |  |  | if (wantarray) { | 
| 134 | 0 |  |  |  |  |  | return @ids; | 
| 135 |  |  |  |  |  |  | } else { | 
| 136 | 0 |  |  |  |  |  | return \@ids; | 
| 137 |  |  |  |  |  |  | } | 
| 138 |  |  |  |  |  |  | } | 
| 139 |  |  |  |  |  |  | sub _make_format_string { | 
| 140 | 0 |  |  | 0 |  |  | my $string = shift; | 
| 141 |  |  |  |  |  |  |  | 
| 142 | 0 |  |  |  |  |  | for my $key (keys %NBI::Slurm::FORMAT_STRINGS) { | 
| 143 | 0 |  |  |  |  |  | my $val = $NBI::Slurm::FORMAT_STRINGS{$key}; | 
| 144 | 0 |  |  |  |  |  | $string =~ s/$key/$val/; | 
| 145 |  |  |  |  |  |  | } | 
| 146 |  |  |  |  |  |  |  | 
| 147 | 0 |  |  |  |  |  | return $string; | 
| 148 |  |  |  |  |  |  | } | 
| 149 |  |  |  |  |  |  | 1; | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | __END__ |