#!/usr/bin/perl
#Time-stamp: "2001-01-23 13:24:08 MST"
my $VERSION = 0.51;

=head1 NAME

crontab2english -- explain crontab commands in English

=head1 SYNOPSIS

  Usage:
    % crontab2english files...
  Or:
    % cat files... | crontab2english
    
  If you do just this:
    % crontab2english
  then it's the same as crontab -l | crontab2english

  Example output:
  % crontab2english | less
  Setting env var MAILTO to hulahoops@polygon.int
  
  Command: (line 2)
    Run: /bin/csh -c 'perl ~/thang.pl | mail -s hujambo root'
    At: 8:10am on    the 15th of    every month
  
  Command: (line 5)
    Run: df -k
    At: 5:40am    every day
  
  Command: (line 7)
    Run: ls -l /tmp
    At: 6:50am    every Monday

=head1 DESCRIPTION

It's easy to make mistakes in crontab files.  Running
C<crontab2english> on your crontab files and reading the
resulting English explanations will help you catch errors.

=head1 SEE ALSO

C<man 1 crontab>

C<man 5 crontab>

=head1 BUG REPORTS

If this program explains a crontab line wrong, or can't parse
it, then email me the line, and an explanation of how it you
think it should parse.

=head1 DISCLAIMER

C<crontab2english> 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.

=head1 COPYRIGHT

Copyright 2001 Sean M. Burke.

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

Sean M. Burke, E<lt>sburke@cpan.orgE<gt>

=head1 README

Translates crontab notation into English, for sanity checking: For
example, "10 8 15 * * foo bar" into: Run: foo bar with input
"baz\x0a" At: 8:10am on the 15th of every month

=head1 SCRIPT CATEGORIES

UNIX/System_administration

=cut

use strict;
use integer;
my @lines;
if(@ARGV) {
  @lines = <>;
} elsif(-t *STDIN) {
  @lines = `crontab -l`;
} else {
  @lines = <STDIN>;
}

#--------------------------------------------------------------------------
# Build tables.
my @dows   = qw(Sun Mon Tue Wed Thu Fri Sat);
my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my($dow, $month, %dow2num, %month2num, %num2dow, %num2month);

my %mil2ampm;
@mil2ampm{0 .. 23}
  = ('midnight', map($_ . 'am', 1 .. 11), 'noon', map($_ . 'pm', 1 .. 11));

@dow2num{map lc($_), @dows} = (0 .. 6);
push @dows, 'Sun';
@num2dow{0 .. 7} = @dows;

@month2num{map lc($_), @months} = (1 .. 12);
@num2month{1 .. 12} = @months;
unshift @months, '';

{
  my $x = join '|', @dows;
  $dow = qr/^($x)$/i;
  $x = join '|', @months;
  $month = qr/^($x)$/i;
}

my(%num2month_long, %num2dow_long);
@num2month_long{1 .. 12} = qw(
  January February March April May June July August September October
  November December
);
@num2dow_long{0 .. 7} = qw(
 Sunday Monday Tuesday Wednesday Thursday Friday Saturday Sunday
);

my $atom    = qr<\d+|(?:\d+-\d+(?:/\d+)?)>s; # /#/#/#/#
my $atoms   = qr<^(?:$atom)(?:,$atom)*$>s; #;#;#;#;

#--------------------------------------------------------------------------

my $line_number = 0;

{
  my(@bits,$k,$v);
  foreach (@lines) {
    chomp;
    ++$line_number;
    next if m/^[ \t]*#/s or m/^[ \t]*$/s;
    if( m/^([^=]+)=[ \t]*\"(.*)\"[ \t]*$/s ) {   # NAME = "VALUE"
      ($k,$v) = ($1,$2);
      #print "<$1><$2>\n";
      $k =~ s/[ \t]+$//;
      printf "Setting env var $k to \"$v\"\n";
    } elsif( m/^([^=]+)=[ \t]*\'(.*)\'[ \t]*$/s ) {   # NAME = 'VALUE'
      ($k,$v) = ($1,$2);
      $k =~ s/[ \t]+$//;
      printf "Setting env var $k to \'$v\'\n";
    } elsif( m/^([^=]+)=(.*)/s ) {     # NAME = VALUE
      ($k,$v) = ($1,$2);
      $k =~ s/[ \t]+$//;
      $v =~ s/^[ \t]+//;
      printf "Setting env var $k to $v\n\n";
    } elsif( (@bits = split m/[ \t]+/, $_, 6) and @bits == 6 ) {
      process_command($_, @bits);
    } else {
      print "Unparseable line: \"", esc($_), "\"\n";
    }
  }
  exit;
}

#--------------------------------------------------------------------------
sub process_command {
  # 0 m,   1 h,   2 day-of-month,  3 month,  4 dow
  my $line = shift;
  my(@bits) = expand_time_bits(@_);
  if(@bits == 1) { # signals error condition
    my $x = $bits[0];
    print
      "Unparseable ", @$x == 1 ? 'bit' : 'bits',
      " in running of command ${$x}[-1] at line number $line_number:\n",
      map("  $_\n", @$x), "\n" ;
    return;
  }
  
  my(@time_lines) = bits_to_english(@bits);
  $time_lines[0] = ucfirst($time_lines[0]);
  if(length(join '    ', @time_lines) <= 75) {
    @time_lines = (join '    ', @time_lines);
  }
  for(@time_lines) { $_ = ' ' . $_ }; # indent over
  $time_lines[0] = "At:" . $time_lines[0];
  
  my @command = split( "\n", percent_proc($bits[-1]), -1 );
  
  if(@command) {
    pop @command if @command == 2 and $command[1] eq '';
     # Eliminate mention of basically null input
  } else {
    push @command, '';
  }
  
  if(@command > 1) {
    my $x = join "\n", splice @command, 1;
    push @command, " with input \"" . esc($x) . "\"";
  }
  if($command[0] =~ m<^\*>s) {
    push @command, " (Do you really mean the command to start with \"*\"?)";
  } elsif($command[0] eq '') {
    push @command, " (Do you really mean to run a null command?)";
  }
  $command[0] = "Run: $command[0]";
  
  print
    #was: "Command: (line $line_number) $line\n",
    # but that's awful verbose
    "Command: (line $line_number)\n",
    map("  $_\n", @command, @time_lines ), "\n";
  
  return;
}

#--------------------------------------------------------------------------
sub expand_time_bits {
  my @bits = @_;
  my @unparseable;
  
  # 0 m,   1 h,   2 day-of-month,  3 month,  4 dow
  
  if($bits[3] =~ m/($month)/o) { $bits[3] = $month2num{lc $1} }
  if($bits[4] =~ m/($dow)/o  ) { $bits[4] =   $dow2num{lc $1} }
  
  for(my $i = 0; $i < 5 ; ++$i) {
    my @segments;
    if($bits[$i] eq '*') {
      push @segments, ['*'];
    } elsif($bits[$i] =~ m<^\*/(\d+)$>s) {
      push @segments, ['*', 0 + $1];
    } elsif($bits[$i] =~ $atoms) {
      foreach my $thang (split ',', $bits[$i]) {
        if($thang =~ m<^(?:(\d+)|(?:(\d+)-(\d+)(?:/(\d+))?))$>s) {
          if(defined $1) {
            push @segments, [0 + $1]; # "7"
          } elsif(defined $4) {
            push @segments, [0 + $2, 0 + $3, 0 + $4];  # "3-20/4"
          } else {
            push @segments, [0 + $2, 0 + $3]; # "3-20"
          }
        } else {
          warn "GWAH? thang \"$thang\"";
        }
      }
    } else {
      push @unparseable, sprintf "field %s: \"%s\"", $i + 1, esc($bits[$i]);
      next;
    }
    
    $bits[$i] = \@segments;
  }
  return \@unparseable if @unparseable;
  return @bits;
}

#--------------------------------------------------------------------------

sub bits_to_english {
  # This is the deep ugly scary guts of this program.
  my @bits = @_;
  my @time_lines;
  
  { # gratuitous block.
    
    # Render the minutes and hours ########################################
    if(@{$bits[0]}    == 1   and @{$bits[1]}    == 1 and 
       @{$bits[0][0]} == 1   and @{$bits[1][0]} == 1 and 
       $bits[0][0][0] ne '*' and $bits[1][0][0] ne '*'
       # It's a highly simplifiable time expression!
       #  This is a very common case.  Like "46 13" -> 1:46pm
       #  Formally: when minute and hour are each a single number.
    ) {
      my $h = $bits[1][0][0];
      my $suff = ($h >= 12) ? 'pm' : 'am';
      if($bits[0][0][0] == 0 and ($h == 12 or $h == 0)) {
        push @time_lines, ($h == 12) ? '12:00 noon' : '12:00 midnight';
      } elsif( $h > 12) {
        push @time_lines,
          sprintf '%s:%02d%s', $h - 12, $bits[0][0][0], $suff;
      } else {
        push @time_lines,
          sprintf '%s:%02d%s', $h -  0, $bits[0][0][0], $suff;
      }
      $time_lines[-1] .= ' on';
    } else {    # It's not a highly simplifiable time expression
      
      # First, minutes:
      if($bits[0][0][0] eq '*') {
        if(1 == @{$bits[0][0]} or $bits[0][0][1] == 1) {
          push @time_lines, 'every minute of';
        } else {
          push @time_lines, 'every ' . freq($bits[0][0][1]) . ' minute of';
        }
        
      } elsif( !grep @$_ > 1, @{$bits[0]} ) {
        # it's all like 7,10,15.  conjoinable
        push @time_lines, conj_and(map $_->[0], @{$bits[0]}) . (
          $bits[0][-1][0] == 1 ? ' minute past' : ' minutes past' );
      } else { # it's just gonna be long.
        my @hunks;
        foreach my $bit (@{$bits[0]}) {
          if(@$bit == 1) {   #"7"
            push @hunks, $bit->[0] == 1 ? '1 minute' : "$bit->[0] minutes";
          } elsif(@$bit == 2) { #"7-9"
            push @hunks, sprintf "from %d to %d %s", @$bit,
              $bit->[1] == 1 ? 'minute' : 'minutes';
          } elsif(@$bit == 3) { # "7-20/2"
            push @hunks, sprintf "every %d %s from %d to %d",
              $bit->[2],
              $bit->[2] == 1 ? 'minute' : 'minutes',
              $bit->[0], $bit->[1],
            ;
          }
        }
        push @time_lines, conj_and(@hunks) . ' past';
        
        # put in semicolons in the case of complex constituency
        #if($time_lines[-1] =~ m/every|from/) {
        #  $time_lines[-1] =~ tr/,/;/;
        #  s/ (and|or)\b/\; $1/g;
        #}
      }
      
      # Now hours
      if($bits[1][0][0] eq '*') {
        if(1 == @{$bits[1][0]} or $bits[1][0][1] == 1) {
          push @time_lines, 'every hour of';
        } else {
          push @time_lines, 'every ' . freq($bits[1][0][1]) . ' hour of';
        }
      } else {
        my @hunks;
        foreach my $bit (@{$bits[1]}) {
          if(@$bit == 1) {   # "7"
            push @hunks, $mil2ampm{$bit->[0]} || "HOUR_$bit->[0]??";
          } elsif(@$bit == 2) { # "7-9"
            push @hunks, sprintf "from %s to %s",
              $mil2ampm{$bit->[0]} || "HOUR_$bit->[0]??",
              $mil2ampm{$bit->[1]} || "HOUR_$bit->[1]??",
          } elsif(@$bit == 3) { # "7-20/2"
            push @hunks, sprintf "every %d %s from %s to %s",
              $bit->[2],
              $bit->[2] == 1 ? 'hour' : 'hours',
              $mil2ampm{$bit->[0]} || "HOUR_$bit->[0]??",
              $mil2ampm{$bit->[1]} || "HOUR_$bit->[1]??",
          }
        }
        push @time_lines, conj_and(@hunks) . ' of';
        
        # put in semicolons in the case of complex constituency
        #if($time_lines[-1] =~ m/every|from/) {
        #  $time_lines[-1] =~ tr/,/;/;
        #  s/ (and|or)\b/\; $1/g;
        #}
        
      }
      # End of hours and minutes
    }

    # Day-of-month ########################################################
    if($bits[2][0][0] eq '*') {
      $time_lines[-1] =~ s/ on$//s;
      if(1 == @{$bits[2][0]} or $bits[2][0][1] == 1) {
        push @time_lines, 'every day of';
      } else {
        push @time_lines, 'every ' . freq($bits[2][0][1]) . ' day of';
      }
    } else {
      my @hunks;
      foreach my $bit (@{$bits[2]}) {
        if(@$bit == 1) {   # "7"
          push @hunks, 'the ' . ordinate($bit->[0]);
        } elsif(@$bit == 2) { # "7-9"
          push @hunks, sprintf "from the %s to the %s",
            ordinate($bit->[0]), ordinate($bit->[1]),
        } elsif(@$bit == 3) { # "7-20/2"
          push @hunks, sprintf "every %d %s from the %s to the %s",
            $bit->[2],
            $bit->[2] == 1 ? 'day' : 'days',
            ordinate($bit->[0]), ordinate($bit->[1]),
        }
      }
      
      # collapse the "the"s, if all the elements have one
      if(@hunks > 1 and !grep !m/^the /s, @hunks) {
        for (@hunks) { s/^the //s; }
        $hunks[0] = 'the '. $hunks[0];
      }
      
      push @time_lines, conj_and(@hunks) . ' of';
      
      # put in semicolons in the case of complex constituency
      #if($time_lines[-1] =~ m/every|from/) {
      #  $time_lines[-1] =~ tr/,/;/;
      #  s/ (and|or)\b/\; $1/g;
      #}
    }

    # Month ###############################################################
    if($bits[3][0][0] eq '*') {
      if(1 == @{$bits[3][0]} or $bits[3][0][1] == 1) {
        push @time_lines, 'every month';
      } else {
        push @time_lines, 'every ' . freq($bits[3][0][1]) . ' month';
      }
    } else {
      my @hunks;
      foreach my $bit (@{$bits[3]}) {
        if(@$bit == 1) {   # "7"
          push @hunks, $num2month_long{$bit->[0]} || "MONTH_$bit->[0]??"
        } elsif(@$bit == 2) { # "7-9"
          push @hunks, sprintf "from %s to %s",
            $num2month_long{$bit->[0]} || "MONTH_$bit->[0]??",
            $num2month_long{$bit->[1]} || "MONTH_$bit->[1]??",
        } elsif(@$bit == 3) { # "7-20/2"
          push @hunks, sprintf "every %d %s from %s to %s",
            $bit->[2],
            $bit->[2] == 1 ? 'month' : 'months',
            $num2month_long{$bit->[0]} || "MONTH_$bit->[0]??",
            $num2month_long{$bit->[1]} || "MONTH_$bit->[1]??",
        }
      }
      push @time_lines, conj_and(@hunks);
      
      # put in semicolons in the case of complex constituency
      #if($time_lines[-1] =~ m/every|from/) {
      #  $time_lines[-1] =~ tr/,/;/;
      #  s/ (and|or)\b/\; $1/g;
      #}
    }
    
    
    # Weekday #############################################################
   #
  #
 #
#
# From man 5 crontab:
#   Note: The day of a command's execution can be specified by two fields
#   -- day of month, and day of week.  If both fields are restricted
#   (ie, aren't *), the command will be run when either field matches the
#   current time.  For example, "30 4 1,15 * 5" would cause a command to
#   be run at 4:30 am on the 1st and 15th of each month, plus every Friday.
#
# [But if both fields ARE *, then it just means "every day".
#  and if one but not both are *, then ignore the *'d one --
#  so   "1 2 3 4 *" means just 2:01, April 3rd
#  and  "1 2 * 4 5" means just 2:01, on every Friday in April
#  But  "1 2 3 4 5" means 2:01 of every 3rd or Friday in April. ]
#
 #
  #
   #
    # And that's a bit tricky.
    
    if($bits[4][0][0] eq '*' and (
      @{$bits[4][0]} == 1 or $bits[4][0][1] == 1
     )
    ) {
      # Most common case -- any weekday.  Do nothing really.
      #
      #   Hm, does "*/1" really mean "*" here, given the above note?
      #
      
      # Tidy things up while we're here:
      if($time_lines[-2] eq "every day of" and
         $time_lines[-1] eq 'every month'
      ) {
        $time_lines[-2] = "every day";
        pop @time_lines;
      }
      
    } else {
      # Ugh, there's some restriction on weekdays.
      
      # Translate the DOW-expression
      my $expression;
      my @hunks;
      foreach my $bit (@{$bits[4]}) {
        if(@$bit == 1) {
          push @hunks, $num2dow_long{$bit->[0]} || "DOW_$bit->[0]??";
        } elsif(@$bit == 2) {
          if($bit->[0] eq '*') { # it's like */3
            #push @hunks, sprintf "every %s day of the week", freq($bit->[1]);
            #  the above was ambiguous -- "every third day of the week"
            #  sounds synonymous with just "3"
            if($bit->[1] eq 2) {
              # common and unambiguous case.
              push @hunks, "every other day of the week";
            } else {
              # rare cases: N > 2
              push @hunks, "every $bit->[1] days of the week";
            }
          } else {
            # it's like "7-9"
            push @hunks, sprintf "%s through %s",
              $num2dow_long{$bit->[0]} || "DOW_$bit->[0]??",
              $num2dow_long{$bit->[1]} || "DOW_$bit->[1]??",
          }
        } elsif(@$bit == 3) { # "7-20/2"
          push @hunks, sprintf "every %s %s from %s through %s",
            ordinate_soft($bit->[2]), #$bit->[2],
            'day',               #$bit->[2] == 1 ? 'days' : 'days',
            $num2dow_long{$bit->[0]} || "DOW_$bit->[0]??",
            $num2dow_long{$bit->[1]} || "DOW_$bit->[1]??",
        }
      }
      $expression = conj_or(@hunks);
      
      # Now figure where to put it...
      #
      if($time_lines[-2] eq "every day of") {
        # Unrestricted day-of-month, hooray.
        #
        if($time_lines[-1] eq 'every month') {
          # change it to "every Tuesday", killing the "of every month".
          $time_lines[-2] = "every $expression";
          $time_lines[-2] =~ s/every every /every /g;
          pop @time_lines;
        } else {
          # change it to "every Tuesday of"
          $time_lines[-2] = "every $expression of";
          $time_lines[-2] =~ s/every every /every /g;
        }
      } else {
        # This is the messy case where there's a DOM and DOW
        #  restriction
        
        # Was, wrongly:
        #  $time_lines[-1] .= ',';
        #  push @time_lines, "if it's also " . $expression;
        
        $time_lines[-2] .= " -- or every $expression in --";
         # Yes, dashes look very strange, but then this is a very
         # rare case.
        $time_lines[-2] =~ s/every every /every /g;
      }
      # put in semicolons in the case of complex constituency
    }
    #######################################################################
  }
    # TODO: change "3pm" -> "the 3pm hour" or something?
  $time_lines[-1] =~ s/ of$//s;
  
  return @time_lines;
}

###########################################################################
# Just utility routines below here.

my %pretty_form;
BEGIN {
  %pretty_form = ( '"' => '\"',  '\\' => '\\\\', );
}

sub esc {
  my $x = $_[0];
  $x =~
   #s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])>
   s<([\x00-\x1F"\\])>
    <$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg;
  return $x;
}

#--------------------------------------------------------------------------

#      if($time_lines[-1] =~ m/every|from/) {
#        $time_lines[-1] =~ tr/,/;/;
#        s/ (and|or)\b/\; $1/g;
#      }

sub conj_and {
  if(grep m/every|from/, @_) {
    # put in semicolons in the case of complex constituency
    return join('; and ', @_) if @_ < 2;
    my $last = pop @_;
    return join('; ', @_) . '; and ' . $last;
  }
  
  return join(' and ', @_) if @_ < 3;
  my $last = pop @_;
  return join(', ', @_) . ', and ' . $last;
}

sub conj_or {
  if(grep m/every|from/, @_) {
    # put in semicolons in the case of complex constituency
    return join('; or ', @_) if @_ < 2;
    my $last = pop @_;
    return join('; ', @_) . '; or ' . $last;
  }
  
  return join(' or ', @_) if @_ < 3;
  my $last = pop @_;
  return join(', ', @_) . ', or ' . $last;
}

#--------------------------------------------------------------------------

my %ordinations;
BEGIN {
  # English-language overrides for common ordinals
  %ordinations = qw(
    1 first 2 second 3 third 4 fourth 5 fifth 6 sixth
    7 seventh 8 eighth 9 ninth 10 tenth
  );
  #  11 eleventh 12 twelfth
  #  13 thirteenth 14 fourteen 15 fifteenth 16 sixteenth
  #  17 seventeenth 18 eighteenth 19 nineteenth 20 twentieth
}

sub ordsuf  {
  return 'th' if not(defined($_[0])) or not( 0 + $_[0] );
   # 'th' for undef, 0, or anything non-number.
  my $n = abs($_[0]);  # Throw away the sign.
  return 'th' unless $n == int($n); # Best possible, I guess.
  $n %= 100;
  return 'th' if $n == 11 or $n == 12 or $n == 13;
  $n %= 10;
  return 'st' if $n == 1; 
  return 'nd' if $n == 2;
  return 'rd' if $n == 3;
  return 'th';
}

sub ordinate  {
  my $i = $_[0] || 0;
  $ordinations{$i} || ($i . ordsuf($i));
}

sub freq {
  # frequentive form.  Like ordinal, except that 2 -> 'other'
  #  (as in every other)
  my $i = $_[0] || 0;
  return 'other' if $i == 2;  # special case
  $ordinations{$i} || ($i . ordsuf($i));
}

sub ordinate_soft  {
  my $i = $_[0] || 0;
  $i . ordsuf($i);
}

#--------------------------------------------------------------------------

sub percent_proc {
  # Translated literally from the C, cron/do_command.c.
  my($esc,$need_newline);
  my $out = '';
  my $c;
  for(my $i = 0; $i < length($_[0]); $i++) {
    $c = substr($_[0],$i,1);
    if($esc) {
      $out .= "\\" unless $c eq '%';
    } else {
      $c = "\n" if $c eq '%';
    }
    unless($esc = ($c eq "\\")) {
      # For unescaped characters,
      $out .= $c;
      $need_newline = ($c ne "\n");
    }
  } 
  $out .= "\\" if $esc;
  $out .= "\n" if $need_newline;
  return $out;
  
  # I think this would do the same thing:
  #  $x =~ s/((?:\\\\)+)  |  (\\\%)  |  (\%)  /$3 ? "\n" : $2 ? '%'   : $1/xeg;
  # But I don't want to think about it, and I need it to work just
  #  as the original does.
}

#--------------------------------------------------------------------------

__END__
# Lines generating the output in the synopsis:

MAILTO=hulahoops@polygon.int
10 8 15 * * /bin/csh -c 'perl ~/thang.pl | mail -s hujambo root'


40 5 * * * df -k

50 6 * * 1 ls -l /tmp