package Apache::LowCal::CalCron;

# Apache::LowCal::CalCron - Recurring event routines for Apache::LowCal
# Copyright (C) 2000 Dave Sherohman (dave@sherohman.org)
#
# 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, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

BEGIN {
  use Exporter;
  @ISA = qw(Exporter);
  @EXPORT = qw(&fill_month &clear_events);
  @EXPORT_OK = qw(&schedule);
}

use strict;

use vars qw($verbose $fake);
$verbose = 0;
$fake = 0;

# fill_month(eventdir, yyyymm[, yyyymm...])
#
# Fills in all recurring events for the given list of months in the specified
# event directory
sub fill_month {
  my $event_dir = shift;
  $event_dir = $1 if $event_dir =~/([-\w.\/]+)/;      # Untaint path
  chdir $event_dir;

  opendir(EVENTS, '.') || die "Can't open directory: $!";
  my @events = readdir EVENTS;
  closedir EVENTS;

  foreach (@events) {
    schedule($_, @_) if /^evt-/;
  }
}

# scehdule(eventrec, yyyymm[, yyyymm...])
#
# Schedules all occurrences of the designated event for the listed months
sub schedule {
  my $event_rec = shift;
  $event_rec = $1 if $event_rec =~ /([^`' "]+)/;      # Untaint filename

  my ($curr_month, $curr_year) = (localtime)[4..5];
  $curr_month += 1;
  $curr_year += 1900;
  print "Currently $curr_month, $curr_year\n" if $verbose > 1;

  print "Examining $event_rec:\n" if $verbose > 0;
  if (open(EVTFILE, $event_rec)) {
    while (<EVTFILE>) {
      if (/<meta .*repeat=\"([-0-9,*\/ ]+)\"/i) {                           #"
        my @parts = split ' ', $1;
        my $repeat_spec = $_;
        print "  $repeat_spec" if $verbose > 0;
        foreach my $month (@_) {
          # Handle relative month specs
          if ($month =~ /^\+([0-9]+)/) {
            my $tgt_month = $curr_month + $1;
            my $tgt_year = $curr_year;

            while ($tgt_month > 12) {
              $tgt_month -= 12;
              $tgt_year++;
            }

            $month = sprintf "%04d%02d", $tgt_year, $tgt_month;

            print "Calculated month as $month\n" if $verbose > 1;
          }

          # Test year and month
          $month =~ /^([0-9][0-9][0-9][0-9])([0-1][0-9])$/
              || die "Bad date: $month";
          next unless matches($1, $parts[0]) && matches($2, $parts[1]);

          # Find out what days are in the month and what day of the week the
          # 1st falls on
          my $cal = `cal $2 $1`;    # There has to be a better way...
          my @weeks = split "\n", $cal;
          # Strip off two header lines from cal's output
          shift @weeks; shift @weeks;  

          foreach my $week (@weeks) {
            my @days = split ' ', $week;
            # Pad @days with leading blanks if it's the first week
            if ($days[0] == 1) {
              foreach (0 .. (6 - $days[-1])) { unshift(@days, '') }
            }

            # Now see which days match...
            foreach my $dow (0..$#days) {
              if (($days[$dow]) && matches($days[$dow], $parts[2])
                                && matches($dow, $parts[3])) {
                my $datestr = sprintf "%06d%02d", $month, $days[$dow];
                $datestr = $1 if $datestr =~ /([0-9]*)/;

                my $evtfile = $event_rec;
                $evtfile =~ s/^evt/$datestr/;
                if (-e $evtfile) {
                  print "    $evtfile already exists - skipping\n"
                    if $verbose > 0;
                } else {
                  print "    Creating $evtfile\n" if $verbose > 0;
                  `/bin/ln -s $event_rec $evtfile` unless $fake;
                }
              }
            }
          }
        }
      }
    }
    close EVTFILE;
  } else {
    print(STDERR "$event_rec: $!");
  }
}

# matches(number, pattern)
#
# Tests whether a number matches a cron-style pattern
sub matches {
  my $number   = shift;
  my @patterns = split ',', shift;

  $number = $1  if $number =~ /^0*(.*)$/;
  $number = '0' if $number eq '';

  foreach my $pattern (@patterns) {
    my $possible = 0;

    $pattern = $1  if $pattern =~ /^0*(.*)$/;
    $pattern = '0' if $pattern eq '';

    print "      Testing whether $number matches $pattern\n" if $verbose > 1;

    return 1 if (($pattern eq "*") || ($pattern eq $number));

    if ($pattern =~ /([0-9]+)-([0-9]+)/) {
      next unless (($number >= $1) && ($number <= $2));
      $possible = 1;
    }

    if ($pattern =~ m/\/([0-9]+)/) {
      next unless ($number % $1 == 0);
      $possible = 1;
    }

    return 1 if $possible == 1;
  }

  print "      Match failed!\n" if $verbose > 1;

  return 0;
}

# clear_events(eventdir, date)
#
# Deletes all event records in eventdir prior to (but not on) the specified
# date
sub clear_events {
  my $event_dir = shift;
  my $clear_to = shift;

  $event_dir = $1 if $event_dir =~/([-\w.\/]+)/;      # Untaint path
  chdir $event_dir;

  opendir(EVENTS, '.') || die "Can't open directory: $!";
  my @events = sort readdir EVENTS;
  closedir EVENTS;

  foreach my $event (@events) {
    if (($event =~ /^\d{8}/) && ($event lt $clear_to)) {
      print "Deleting event $event\n" if $verbose > 0;
      $event =~ /([^`' "]+)/;      # Untaint filename
      unlink $1 unless $fake;
    }

    return if ($event ge $clear_to);
  }
}

1;

