File Coverage

blib/lib/NBI/Job.pm

Criterion	Covered	Total	%
statement	156	219	71.2
branch	59	96	61.4
condition	9	12	75.0
subroutine	22	27	81.4
pod	16	16	100.0
total	262	370	70.8

package NBI::Job;
#ABSTRACT: A class for representing a job for NBI::Slurm
#
# NBI::Job - Represents a single SLURM job to be submitted.
#
# DESCRIPTION:
#   Encapsulates a named job consisting of one or more shell commands
#   together with its resource options (NBI::Opts).  Key responsibilities:
#     - new()          : accepts -name, -command/-commands, and -opts
#     - script()       : assembles the bash/sbatch script content
#     - run()          : writes the script to disk and submits it via sbatch,
#                        returning the numeric SLURM job ID
#     - view()         : returns a human-readable summary string
#     - outputfile / errorfile : lvalue accessors for stdout/stderr paths
#                        (support %j interpolation after submission)
#     - append_command / prepend_command : add commands to the job list
#     - Array-job support: if the attached NBI::Opts has a -files list,
#       the script uses a SLURM job array and replaces the -placeholder
#       token with ${selected_file}.
#
# RELATIONSHIPS:
#   - Depends on NBI::Opts (stored in $self->{opts}) for all #SBATCH header
#     lines, the tmpdir, and array-job configuration.
#   - $NBI::Job::VERSION is set from $NBI::Slurm::VERSION (loaded by caller).
#   - Used directly by end-users and by the runjob bin script.
#

use 5.012;
use warnings;
use Carp qw(confess);
use Data::Dumper;
use File::Spec::Functions;
$Data::Dumper::Sortkeys = 1;
use File::Basename;

$NBI::Job::VERSION  = $NBI::Slurm::VERSION;
my $DEFAULT_QUEUE   = "nbi-short";
require Exporter;
our @ISA = qw(Exporter);


sub new {
    my $class = shift @_;
    my ($job_name, $commands_array, $command, $opts);

    # Descriptive instantiation with parameters -param => value
    if (substr($_[0], 0, 1) eq '-') {
        my %data = @_;
        # Try parsing
        for my $i (keys %data) {
            if ($i =~ /^-name/) {
                $job_name = $data{$i};
            } elsif ($i =~ /^-command$/) {
                $command = $data{$i};
            } elsif ($i =~ /^-opts$/) {
                # Check that $data{$i} is an instance of NBI::Opts
                if ($data{$i}->isa('NBI::Opts')) {
                    # $data{$i} is an instance of NBI::Opts
                    $opts = $data{$i};
                } else {
                    # $data{$i} is not an instance of NBI::Opts
                    confess "ERROR NBI::Job: -opts must be an instance of NBI::Opts\n";
                }

            } elsif ($i =~ /^-commands$/) {
                # Check that $data{$i} is an array
                if (ref($data{$i}) eq 'ARRAY') {
                    $commands_array = $data{$i};
                } else {
                    confess "ERROR NBI::Job: -commands must be an array\n";
                }
            } else {
                confess "ERROR NBI::Seq: Unknown parameter $i\n";
            }
        }
    }

    my $self = bless {}, $class;


    $self->{name} = defined $job_name ? $job_name : 'job-' . int(rand(1000000));
    $self->{jobid} = 0;

    # Commands: if both commands_array and command are defined, append command to commands_array
    if (defined $commands_array) {
        $self->{commands} = $commands_array;
        if (defined $command) {
            push @{$self->{commands}}, $command;
        }
    } elsif (defined $command) {
        $self->{commands} = [$command];
    }

    # Opts must be an instance of NBI::Opts, check first
    if (defined $opts) {
        # check that $opts is an instance of NBI::Opts
        if ($opts->isa('NBI::Opts')) {
            # $opts is an instance of NBI::Opts
            $self->{opts} = $opts;
        } else {
            # $opts is not an instance of NBI::Opts
            confess "ERROR NBI::Job: -opts must be an instance of NBI::Opts\n";
        }

    } else {
        $self->{opts} = NBI::Opts->new($DEFAULT_QUEUE);
    }

    $self->{script_path} = undef;

    # Check here if there is opts->placeholder in the commands.
    # If there is then replace /placeholder/ with ${selected_file}

    if ($self->opts->is_array()) {
        for my $cmd (@{$self->{commands}}) {
            _replace_array_placeholders($self, \$cmd);
        }
    }
    return $self;

}


sub script_path : lvalue {
    # Update script_path
    my ($self, $new_val) = @_;
    $self->{script_path} = $new_val if (defined $new_val);
    return $self->{script_path};
}

sub name : lvalue {
    # Update name
    my ($self, $new_val) = @_;
    $self->{name} = $new_val if (defined $new_val);
    return $self->{name};
}

sub jobid : lvalue {
    # Update jobid
    my ($self, $new_val) = @_;
    if (defined $new_val and $new_val !~ /^-?(\d+)$/) {
        confess "ERROR NBI::Job: jobid must be an integer ". $new_val ."\n";
    }
    $self->{jobid} = $new_val if (defined $new_val);
    return $self->{jobid};
}

sub outputfile : lvalue {
    # Update name
    my ($self, $parameter) = @_;

    my $interpolate = 0;
    if (defined $parameter) {
        if ($parameter eq '-interpolate') {
            $interpolate = 1;
        } else {
            $self->{output_file} = $parameter;
        }
    }

    # Create a default output_file if not defined
    if (not defined $self->{output_file}) {
        $self->{output_file} = catfile( $self->opts->tmpdir , $self->name . ".%j.out");
    }

    if ($interpolate) {
        my $jobid = $self->jobid;
        my $output_file = $self->{output_file};
        $output_file =~ s/%j/$jobid/g;
        return $output_file;
    } else {
        return $self->{output_file};
    }

}

sub errorfile : lvalue {
   # Update name
    my ($self, $parameter) = @_;

    my $interpolate = 0;
    if (defined $parameter) {
        if ($parameter eq '-interpolate') {
            $interpolate = 1;
        } else {
            $self->{error_file} = $parameter;
        }
    }

    # Create a default error_file if not defined
    if (not defined $self->{error_file}) {
        $self->{error_file} = catfile( $self->opts->tmpdir , $self->name . ".%j.err");
    }

    if ($interpolate) {
        my $jobid = $self->jobid;
        my $error_file = $self->{error_file};
        $error_file =~ s/%j/$jobid/g;
        return $error_file;
    } else {
        return $self->{error_file};
    }

}
sub append_command {
    my ($self, $new_command) = @_;
    if ($self->opts->is_array()) {
        _replace_array_placeholders($self, \$new_command);
    }
    push @{$self->{commands}}, $new_command;
}

sub prepend_command {
    my ($self, $new_command) = @_;
    if ($self->opts->is_array()) {
        _replace_array_placeholders($self, \$new_command);
    }
    unshift @{$self->{commands}}, $new_command;
}

sub commands {
    my ($self) = @_;
    return $self->{commands};
}

sub commands_count {
    my ($self) = @_;
    return 0 + scalar @{$self->{commands}};
}

sub set_opts {
    my ($self, $opts) = @_;
    # Check that $opts is an instance of NBI::Opts
    if ($opts->isa('NBI::Opts')) {
        # $opts is an instance of NBI::Opts
        $self->{opts} = $opts;
    } else {
        # $opts is not an instance of NBI::Opts
        confess "ERROR NBI::Job: -opts must be an instance of NBI::Opts\n";
    }
}

sub get_opts {
    my ($self) = @_;
    return $self->{opts};
}

sub opts {
    my ($self) = @_;
    return $self->{opts};
}

## Run job
sub script {
    my ($self) = @_;
    my $template = [
        '#SBATCH -J NBI_SLURM_JOBNAME',
        '#SBATCH -o NBI_SLURM_OUT',
        '#SBATCH -e NBI_SLURM_ERR',
        ''
    ];
    my $header = $self->opts->header();

    # Replace the template
    my $script = join("\n", @{$template});

    # Replace the values
    my $name = $self->name;
    my $file_out = $self->outputfile;
    my $file_err = $self->errorfile;
    $script =~ s/NBI_SLURM_JOBNAME/$name/g;
    $script =~ s/NBI_SLURM_OUT/$file_out/g;
    $script =~ s/NBI_SLURM_ERR/$file_err/g;

    my @commands = @{$self->{commands}};

    if ($self->opts->is_array()) {
        my @prepend = _array_prelude($self);
        unshift @commands, @prepend;
    }
    if ($self->opts->is_array()) {
        my $has_array_variable = 0;
        for my $cmd (@commands) {
            if ($self->opts->is_files_array() && $cmd =~ /\$\{selected_file\}/) {
                $has_array_variable = 1;
                last;
            }
            if ($self->opts->is_params_array() && $cmd =~ /\$\{param_\d+\}/) {
                $has_array_variable = 1;
                last;
            }
        }
        if ($has_array_variable == 0) {
            if ($self->opts->is_files_array()) {
                confess "ERROR NBI::Job: No command contains the placeholder:" . $self->opts->placeholder . "\n";
            }
            confess "ERROR NBI::Job: No command contains params-array placeholders like ##1##\n";
        }
    }

    $script .= join("\n", @commands);
    return $header . $script . "\n";
}

sub _replace_array_placeholders {
    my ($self, $command_ref) = @_;
    if ($self->opts->is_files_array()) {
        my $placeholder = $self->opts->placeholder;
        $$command_ref =~ s/\Q$placeholder\E/\${selected_file}/g;
    }
    if ($self->opts->is_params_array()) {
        $$command_ref =~ s/##(\d+)##/\${param_$1}/g;
    }
}

sub _array_prelude {
    my ($self) = @_;
    my @index_prelude = ('nbi_array_index=$SLURM_ARRAY_TASK_ID');
    if ($self->opts->{array_offset} && $self->opts->{array_offset} > 0) {
        @index_prelude = ("nbi_array_index=\$((SLURM_ARRAY_TASK_ID + " . $self->opts->{array_offset} . "))");
    }
    if ($self->opts->is_files_array()) {
        my $self_files = $self->opts->files;
        my @escaped_files = @{$self_files};
        for my $file (@escaped_files) {
            $file =~ s/ /\\ /g;
        }
        my $files_list = join(" ", @escaped_files);
        return (
            "# Job array list",
            @index_prelude,
            "self_files=($files_list)",
            "selected_file=\${self_files[\$nbi_array_index]}",
        );
    }
    if ($self->opts->is_params_array()) {
        my $params_file = _shell_single_quote($self->opts->params_array);
        my $perl_loader = q{use strict;use warnings;my ($file,$task_id)=@ARGV;open my $fh,"<",$file or die "Cannot open $file: $!\n";my $row_idx=0;while (my $line=<$fh>) { chomp $line; $line =~ s/\r$//; next if $line =~ /^\s*$/; next if $line =~ /^\s*#/; if ($row_idx == $task_id) { my @fields = split /\t/, $line, -1; for my $field (@fields) { print $field, "\0"; } exit 0; } $row_idx++; } die "No params row for task_id=$task_id in $file\n";};
        return (
            "# Job array params",
            @index_prelude,
            "params_file=$params_file",
            "mapfile -d '' -t params < <(perl -e '$perl_loader' \"\$params_file\" \"\$nbi_array_index\")",
            "for i in \"\${!params[@]}\"; do",
            "    printf -v \"param_\$((i + 1))\" '%s' \"\${params[\$i]}\"",
            "done",
        );
    }
    return ();
}

sub _shell_single_quote {
    my ($value) = @_;
    $value =~ s/'/'\"'\"'/g;
    return "'$value'";
}

sub run {
    my $self = shift @_;
        # Check it has some commands


    # Check it has a queue
    if (not defined $self->opts->queue) {
        confess "ERROR NBI::Job: No queue defined for job " . $self->name . "\n";
    }
    # Check it has some opts
    if (not defined $self->opts) {
        confess "ERROR NBI::Job: No opts defined for job " . $self->name . "\n";
    }
    # Check it has some commands
    if ($self->commands_count == 0) {
        confess "ERROR NBI::Job: No commands defined for job " . $self->name . "\n";
    }

    # Create the script
    my $script = $self->script();

    # Create the script file
    my $script_file = catfile($self->opts->tmpdir, $self->name . ".sh");

    # change suffix from .sh to .INT.sh if the file exists already
    if (-e $script_file) {
        my $i = 1;
        while (-e $script_file) {
            my $string_int = sprintf("%05d", $i);
            $script_file = catfile($self->opts->tmpdir, $self->name . "." . $string_int . ".sh");
            $i++;
        }
    }

    $self->{"script_path"} = $script_file;
    open(my $fh, ">", $script_file) or confess "ERROR NBI::Job: Cannot open file $script_file for writing\n";
    print $fh $script;
    close($fh);

    # Run the script

    if (_has_command('sbatch') == 0) {
        $self->jobid = -1;
        return 0;
    }
    my $job_output = `sbatch "$script_file"`;

    # Check the output
    if ($job_output =~ /Submitted batch job (\d+)/) {
        # Job submitted
        my $job_id = $1;
        # Update the job id
        $self->jobid = $job_id;
        return $job_id;
    } else {
        # Job not submitted
        confess "ERROR NBI::Job: Job " . $self->name . " not submitted\n";
    }
    return $self->jobid;
}


sub view {
    # Return a string representation of the object
    my $self = shift @_;
    my $str = " --- NBI::Job object ---\n";
    $str .= " name:       " . $self->name . "\n";
    $str .= " commands:   \n\t" . join("\n\t", @{$self->commands}) . "\n";
    $str .= " jobid:      " . $self->jobid . "\n";
    $str .= " script:     " . $self->script_path . "\n";
    $str .= " output file:" . $self->outputfile('-interpolate') . "\n";
    $str .= " error file: " . $self->errorfile('-interpolate') . "\n";
    $str .= " ---------------------------\n";

    return $str;
}

sub _has_command {
    my $command = shift;
    my $is_available = 0;

    if ($^O eq 'MSWin32') {
        # Windows system
        $is_available = system("where $command >nul 2>nul") == 0;
    } else {
        # Unix-like system
        $is_available = system("command -v $command >/dev/null 2>&1") == 0;
    }

    return $is_available;
}

sub _to_string {
    # Convert string to a sanitized string with alphanumeric chars and dashes
    my ($self, $string) = @_;
    return $string =~ s/[^a-zA-Z0-9\-]//gr;
}
1;

__END__