#!/usr/bin/env perl

# dobatches - run batches from a shared directory.
# Copyright 2007, 2008, 2024 Vincent Lefevre <vincent@vinc17.net>.

# I wrote this program as a very simple and limited replacement of
# qsub. I provide no documentation except its source. But here's a
# simple example:
#   $ dobatches 'batch-.*' arg1 arg2 arg3
# As you can see, the first dobatches argument is a regular expression,
# not a file pattern (i.e., write '.*' instead of '*'). It needs to be
# properly quoted to avoid metacharacter expansion by the shell.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License along
# with this program; if not, see <https://www.gnu.org/licenses/>.

# Changes
# *******
# 2007-06-15: First version.
# 2008-07-08: Sleep only if no new batches have been found and run after
#             last scanning. More output (when scanning, time).
# 2008-07-15: Getopt::Long support, with options --dir, --jobrequest,
#             --quiet, --remove, --sleeptime, --unlink.
# 2024:       Corrected a typo in a comment. Updated copyright notice.

use strict;
use POSIX;
use Getopt::Long;

my ($proc,$vers) = '$Id: dobatches 171412 2024-09-01 12:16:16Z vinc17/qaa $'
  =~ /^.Id: (\S+) (\d+ \d{4}-\d\d-\d\d \d\d:\d\d:\d\d)Z / or die;

my $Usage = "Usage: $proc [ <options> ] <cmd_regexp> [ <cmd_arg> ... ]\n";

my $Help = $Usage.<<EOF;
  -?, -h, --help        display this help and exit
  -d, --dir=DIRECTORY   directory that will contain symlinks to job files
  -j, --jobrequest=MIN  request job if run time is less than MIN minutes
  -q, --quiet           output minimum information
  -r, --remove          remove job files once finished (with no errors)
  -s, --sleeptime=SEC   sleep for SEC seconds if no waiting jobs
  -u, --unlink          remove symlink if job terminated with an error
  -v, --version         output version information and exit
Read the Getopt::Long man page to see how the options are processed.
Concurrent dobatches processes are allowed.
EOF

my $d = $ENV{'DOBATCHES_DIR'} || 'dobatches-dir';
my $r = $ENV{'DOBATCHES_REMOVE'};
my $s = $ENV{'DOBATCHES_SLEEPTIME'} || 60;
my $u = $ENV{'DOBATCHES_UNLINK'};
my ($jr,$q);

GetOptions(
  'help|h|?' => sub { print $Help; exit; },
  'dir|d=s' => \$d,
  'jobrequest|j=i' => sub { $jr = time + 60 * $_[1] },
  'quiet|q' => \$q,
  'remove|r' => \$r,
  'sleeptime|s=i' => \$s,
  'unlink|u' => \$u,
  'version|v' => sub { print "$proc $vers\n"; exit; },
          ) or die $Usage;

@ARGV or die $Usage;
my $crx = shift;

mkdir $d;
-d $d or die "$proc: couldn't create directory $d\n";

sub mtime ($)
  { (stat $_[0])[9] }

sub out ($@)
  {
    return if shift(@_) < $q;
    # Use local time, even though this may be ambiguous at DST changes.
    # To get UTC time, execute dobatches with environment variable TZ
    # set to "UTC".
    print STDERR POSIX::strftime("[%Y-%m-%d %T]", localtime),
      " $proc: ", @_, "\n";
  }

sub jobrequest
  {
    defined $jr && time < $jr or return;
    # Add a unique file with filename prefix ".jr-".
    require File::Temp;
    my (undef, $tf) = File::Temp::tempfile('.jr-XXXX', DIR => $d);
    out 0, "job requested ($tf)";
  }

&jobrequest;
while (1)
  {
    my @batches;

    out 0, "scanning...";
    opendir DIR, '.' or die "$!\n$proc: can't open current directory\n";
    while ($_ = readdir DIR)
      { /\A$crx\z/ && -x $_ and push @batches, $_ }
    closedir DIR;

    my $exec;
    foreach my $j (sort { mtime($a) <=> mtime($b) } @batches)
      {
        # symlink is atomic, allowing concurrent dobatches processes.
        symlink $j, "$d/$j" or next;
        $exec = 1;
        &jobrequest;
        out 1, "executing $j";
        system "./$j", @ARGV;
        if (WIFSIGNALED($?))
          { out 1, "job $j killed by signal ", WTERMSIG($?) }
        elsif ($? && WIFEXITED($?))
          { out 1, "job $j terminated with exit value ", WEXITSTATUS($?) }
        elsif ($r)
          { unlink $j }
        unlink "$d/$j" if $? ? $u : $r;
        if (defined $jr && time >= $jr)
          {
            out 1, "no more requested job, quitting";
            exit;
          }
      }

    next if $exec;
    out 0, "sleeping for $s seconds";
    sleep $s;
  }