#!/usr/bin/perl
#: View scheduled at(1) jobs. Smarter version of "atq" and "at -c 123"
our $Version = "2.1"; # sburke@cpan.org
#======================================================================
# Last-Modified Time-stamp: "2011-03-02 18:57:27 AKST sburke@cpan.org"
use strict; use warnings;
use constant DEBUG => $ENV{ATCAT_DEBUG} || 0;
#======================================================================
# 
# atcat -- a smarter version of "atq" and "at -c 123"
#
#======================================================================
#
#
#TODO:  take atcat -v or atcat --help or atcat -h
#         do something useful
######
#
# "atcat" does three things, each of which is a solution to a problem
# that I've had with managing "at" jobs over the years.
# 
# 
#-> An improved "atq"
# 
# Normally, running "atq" makes a listing like this:
# 
#   727     Mon May 26 07:01:00 2008 a sean
#   646     Sun Jun  1 00:35:00 2008 e sean
#   647     Sun Jun  1 00:35:00 2008 e sean
# 
# They are apparently in no special order.  I never find this useful.
# So I've written this program, "atcat", to list the jobs in
# chronological order (starting with soonest-to-run).  So:
# 
#   % atcat
# 
#   2008-05-25 . 20:16:00 . Sun   #723   e sean
#   2008-05-26 . 07:01:00 . Mon   #727   a sean
#   2008-06-01 . 00:35:00 . Sun   #646   e sean
#
# 
#
#-> An improved "at -c 123"
# 
# Calling "at -c 123" blasts the entire contents of queued job #123,
# starting with its massive list of environment variables.  I just
# plain never want to see those variables.  So I made "atcat
# [somenumber]" to skip the environment variables and get right to the
# job's commands.  Example:
#   
#   % atcat 731
#
#   cd /home/sean || {
#            echo 'Execution directory inaccessible' >&2
#            exit 1
#   }
#   uptime; hostname
#   echo Space free for ~ 's drive:
#   df ~
#   echo
#   echo Space free for /tmp 's drive:
#   df /tmp
#    
#
#   
#-> Running "atcat 123" for every job number
#
# Often I know that some "at" job or other calls a particular command,
# but I can't remember which.  I've made it so that "atcat all" dumps
# the contents of every "at" job.  I.e., it uses "atcat" to get the
# order that the jobs are scheduled for, and then runs "atcat
# [jobnum]" on each one, and then sends it all to STDOUT.
# 
# Example: which job(s) call "df"?
# 
#   % atcat ALL | less
#
# and then use "/df" in "less" to find a job that uses "df".
# Or "atcat ALL > source_of_jobs.txt" and then open that in your
# text-editor of choice, and use its Find command.
#
#======================================================================
# Author: Sean M. Burke, sburke@cpan.org
#======================================================================

use constant LET_THROUGH_TIME_ENV_VARS => 0;
 # ^^ I occasionally put useful information (like when the job was
 # scheduled, or at least roughly) in variables whose names involve
 # "TIME", so I let them through.  Feel free to turn the 1 to a 0
 # here.

my %Mon2Num =
qw(
  Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06
  Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12
);
#^^
# Very oddly, as far as I can tell, atq doesn't seem to make these
# depend on locale settings!  so we'll just hardwire these
# into atcat to.

my $Handy_conjoiner = " . ";
$|++;
$ENV{LC_ALL} = "C"; # so that we get the dates in English
@ARGV ? list_those(@ARGV) : list_all();
exit;

#======================================================================
# The top-level functions

sub list_those {
  my @them = @_;
  return cat_all() if @them == 1
    and $them[0] =~ m/^(all|ALL|--?)$/;

  s/\A \# (\d+) \z/$1/sx #  tolerate "#1231" for "1231"
    foreach @them;

  my @baddies = grep !m/\A(\d+)\z/, @them;
  if(@baddies) {
    die join '', "Weird item",
     (@baddies == 1) ? q{} : "s",
     ": @baddies\n";
  }

  foreach my $it (@them) {
    atcat_one($it);
  }

  return;
}

# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

sub list_all {
  DEBUG and print "Listing all...\n";
  foreach my $x ( _lines_as_refs() ) {
    printf "%s  % 5s  %s\n", $$x[2], "#$$x[0]", $$x[3];
  }
  return;
}

#/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
#\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
#
# Workhorse functions for the above

sub atcat_one {
  my $num = $_[0];

  chomp( my @in = `at -c $num` );
  return unless @in;

  my @out;
  my $seen = 0;
  for(@in) {
    if($seen) {
      push @out, $_;
    } elsif( m/\Acd /s) {  # Like "cd /home/sean", i.e., end of
                           # vars.  This assumes that the first
                           # command that the first thing that an "at"
                           # job does, or at least the first
                           # interesting thing.
      push @out, $_;
      $seen = 1; 
    } elsif( LET_THROUGH_TIME_ENV_VARS and m/NOW|TIME/ ) {
      push @out, $_;
    }
  }
  #print "<@out>\n";

  print map "$_\n", @out ? @out : @in;
  return;
}

sub dump_list {
  my( @in ) = @_;
  my @out;
  my $counter = 0;
  foreach my $x (@in) {
    push @out, "$counter<" . (defined($x) ? $x : "`") . ">";
    ++$counter;
  }
  return join " ", @out;
}

sub cat_all {
  my @them = _lines_as_refs();

  foreach my $x (@them) {
    my $proc_num = @$x[0];
    my $x = "\n~~~~ @$x[2]   #$proc_num @$x[3] ";
    $x .= "~" x (79 - length($x));
    print $x, "\n";
    atcat_one($proc_num);
  }

  return;
}

#======================================================================
#
# And now util functions for the above

sub at_date_to_iso {
  my( $y,$m,$d,$t ) = @_;

  $m = $Mon2Num{$m} || $Mon2Num{ucfirst lc $m} || die "Unknown month \"$m\"";
  my $at_date_iso = iso_time($y, $m, $d) . $Handy_conjoiner . $t;
  DEBUG > 4 and print "\tat_date_to_iso gets ", dump_list(@_),
    " -> $at_date_iso\n";
  return $at_date_iso;
}

sub iso_time {
  my($y,$m,$d) = @_;
  DEBUG > 2 and print "\tIso_time gets: ", dump_list(@_), "\n";
  {
    no warnings;
    die "iso_time has bad args:" . dump_list(@_)
     unless $y and $m and $d and @_ == 3;
  }
  my $out = sprintf "%04d-%02d-%02d", $y,$m,$d;
  DEBUG > 2 and print "\t\t-> $out\n";
  return $out;
}

sub at_date_to_iso_already_iso {
  # only minor tweaking here
  my( $ymd,$t ) = @_;
  my $at_date_iso = $ymd . $Handy_conjoiner . $t . ":00";
  DEBUG > 4 and print "\tat_date_to_iso_already_iso gets ", dump_list(@_),
    " -> $at_date_iso\n";
  return $at_date_iso;
}

# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

sub _lines_as_refs {
  # Gets lines from atq, then munges them into a uniform and sortable
  # format, and then returns a sorted list (soonest-to-run first) of
  # listrefs whose structure is explained below.

  chomp( my @jobs = `/usr/bin/atq` );

  DEBUG and print "// Jobs\n", map( "  <$_>\n", @jobs), "//Endjobslist\n\n";

  my @sorties;
  foreach my $j (@jobs) {
    my @m;
    unless( (@m) = $j =~
      m/
       \A \s*

       #    642       Mon              May  5 07:01:00 2008 a sean
       (?: (\d+) \s+ ([a-zA-Z]+) \s+  ([a-zA-Z]+)    #1job,2dow,3mnth
				  \s+     (\d+)       #4dom
                                  \s+        ([\:0-9]+)  #5timestring(hhmmss)
				  \s+            ([0-9]{4}) (.+) #6year,7rest
       ) |

       #  149174     2008-05-27       23:48    a sburke
       (?: (\d+) \s+ ([-0-9]+)        #8job,9ymd
                                \s+   ([\:0-9]+)   #10timestring(hhmm)
			        \s+           (.+) #11rest
       )
       \z
      /x
    ) {
      print "?? $j\n\n";
      next;
    }# else it's good, and @m is populated;

    unshift @m, "~~"; #(dummy element so that $1 => $m[1])
    DEBUG > 2 and print "m: ", dump_list(@m), "\n";
    my($date, $jobnum, $rest);

    if( defined($m[1]) ) {
      DEBUG and print "J is in v3.1.9 format: $j\: ", dump_list(@m), "\n";
      $date =
        at_date_to_iso( @m[6,3,4,5] ), # . $Handy_conjoiner . $m[2]
      ;
      $jobnum = 0 + $m[1];
      $rest = $m[7];
    } else {
      DEBUG and print "J is in v3.1.8 format: $j\: ", dump_list(@m), "\n";
      $date = at_date_to_iso_already_iso( @m[9,10] );
      $jobnum = 0 + $m[8];
      $rest = $m[11];
    }

    push @sorties, [
      $jobnum, # 0:
      $j,      # 1: whole line
      $date,   # 2: time in a sortable format
      $rest,   # 3: rest of line after time (queue, username,...etc?)
    ];

    DEBUG and print "==> ", dump_list( @{$sorties[-1]} ), " from \"$j\"\n\n";

  }
  return sort {
       $a->[2] cmp $b->[2] # sort by time
    or $a->[3] cmp $b->[3] # else by rest of line
    or $a->[0] <=> $b->[0] # else by jobnum
   } @sorties;
}

#======================================================================

__END__


Note that output is different in different versions!


%  at -V ; ( atq | head -5 )
at version 3.1.8 <-------------------------------------------
Bug reports to: ig25@rz.uni-karlsruhe.de (Thomas Koenig)
149174  2008-05-27 23:48 a sburke
157708  2008-05-24 22:40 e sburke
157709  2008-05-24 22:40 e sburke
157710  2008-05-24 22:40 e sburke

% at -V ; ( atq | head -5 )
at version 3.1.9  <-------------------------------------
Bug reports to: rmurray@debian.org (Ryan Murray)
172     Thu Jul 24 16:23:00 2008 a sburke
173     Thu Jul 31 20:07:00 2008 e sburke
174     Sat Jun 14 01:52:00 2008 e sburke
176     Thu Jun 26 03:18:00 2008 a sburke
177     Wed Jul 16 03:19:00 2008 a sburke