[SPOILER] Perl Quiz-of-the-Week #22

I think this might be one of the most badly-written programs I've ever
posted in public.

I think it works, but I wouldn't bet anything on it.  I didn't test
any of the odd cases.

However, I think it uses only Llama features.  Except perhaps the
'sprintf'.  Which I could have gotten rid of without any technical
problems, except I didn't have the stomach for it.




use strict 'vars';
use Getopt::Std;
use Time::Local;
our($opt_n);
getopts('n:') or usage();
$opt_n = 7 unless defined $opt_n;

my $dir = shift || $ENV{EVENT_DIR} || homedir() . "/.events";

sub homedir {
  $ENV{HOME} || (getpwuid($<))[7] 
    or die "$0: Couldn't determine home directory";
}

my ($td, $tm, $ty) = (localtime)[3,4,5];

my $today = day_number($ty, $tm, $td);


opendir D, $dir or die "$0: Couldn't read events dir '$dir': $!; aborting";
while (my $f = readdir D) {
  my $file = "$dir/$f";
  next unless -f $file;
  unless (open F, "<", $file) {
    warn "$0: Couldn't open $file: $!; skipping.\n";
    next;
  }

  my @events;
  my @dates;
  while (<F>) {
    chomp;
    next if /^\#/;
    s/\s+\#.*//;
    next unless /\S/;

    next unless my ($mon, $day, $year, $item) 
      = m{^(   |\d\d/)(\d\d)(/\d\d\d\d)?\s+(.*)};
    $mon  =~ s{/$}{};
    $year =~ s{^/}{};
    undef $mon if $mon eq "   ";

    my ($default_mon, $default_year) = defaults($year, $mon, $day);

    $mon = defined($mon) ? $mon-1: $default_mon;
    $year = !defined($year) ? $default_year :
                $year > 99  ? $year - 1900  : $year;


    my $time_to_go = day_number($year, $mon, $day) - $today;
#    warn "$_: $time_to_go\n";
    next if $time_to_go < 0; # Too late!
    next if $time_to_go > $opt_n;

    push @events, sprintf("%2d/%2d/%04d %s", $mon+1, $day, $year+1900, $item);
    push @dates, $time_to_go;
  }

  next unless @events;

  print "$f:\n";
  my @indices = sort {$dates[$a] <=> $dates[$b]} 0 .. $#events;
  for my $i (@indices) {
    print arrow($dates[$i]), $events[$i], "\n";
  }
  print "\n";
}

sub arrow {
  my $n = shift;
  my @arrow = ('   ===>',
               '   --> ',
               '  -->  ',
               ' -->   ',
               '-->    ',
               '->     ',
               '>      ',
               '       ');
  unless ($arrow[$n]) {
    $arrow[$n] = "($n)";
    $arrow[$n] .= " " x (7 - length($arrow[$n]));
  }
  return $arrow[$n];
}

sub defaults {
  my ($y, $m, $d) = @_;
  my $dm = defined ($m) ? $m : $tm + ($d < $td);
  my $dy = defined ($y) ? $y : $ty + ($dm < $tm || $dm == $tm && $d < $td);
  return $dm == 12 ? (0, $dy+1) : ($dm, $dy);
}

sub day_number {
  my ($y, $m, $d) = @_;
  int(timelocal(0, 0, 12, $d, $m, $y)/86400);
}

sub usage {
  print STDERR "Usage: $0 [-n duration] [event dir]\n";
  exit 1;
}