package MFHD::Date;
use strict;
use integer;
use Carp;

use Data::Dumper;
use DateTime;

use base 'Exporter';

our @EXPORT_OK =qw(dispatch generator incr_date can_increment);

my %daynames = (
		'mo' => 1,
		'tu' => 2,
		'we' => 3,
		'th' => 4,
		'fr' => 5,
		'sa' => 6,
		'su' => 7,
	       );

my $daypat = '(mo|tu|we|th|fr|sa|su)';
my $weekpat = '(99|98|97|00|01|02|03|04|05)';
my $weeknopat;
my $monthpat = '(01|02|03|04|05|06|07|08|09|10|11|12)';
my $seasonpat = '(21|22|23|24)';

# Initialize $weeknopat to be '(01|02|03|...|51|52|53)'
$weeknopat = '(';
foreach my $weekno (1..52) {
    $weeknopat .= sprintf('%02d|', $weekno);
}
$weeknopat .= '53)';

sub match_day {
    my $pat = shift;
    my @date = @_;
    # Translate daynames into day of week for DateTime
    # also used to check if dayname is valid.

    if (exists $daynames{$pat}) {
	# dd
	# figure out day of week for date and compare
	my $dt = DateTime->new(year  => $date[0],
			       month => $date[1],
			       day   => $date[2]);
	return ($dt->day_of_week == $daynames{$pat});
    } elsif (length($pat) == 2) {
	# DD
	return $pat == $date[2];
    } elsif (length($pat) == 4) {
	# MMDD
	my ($mon, $day) = unpack("a2a2", $pat);

	return (($mon == $date[1]) && ($day == $date[2]));
    } else {
	carp "Invalid day pattern '$pat'";
	return 0;
    }
}

sub subsequent_day {
    my $pat = shift;
    my @cur = @_;
    my $dt = DateTime->new(year  => $cur[0],
			   month => $cur[1],
			   day   => $cur[2]);

#     printf("# subsequent_day: pat='%s' cur='%s'\n", $pat, join('/', @cur));

    if (exists $daynames{$pat}) {
	# dd: published on the given weekday
	my $dow = $dt->day_of_week;
	my $corr = ($daynames{$pat} - $dow + 7) % 7;

	if ($dow == $daynames{$pat}) {
	    # the next one is one week hence
	    $dt->add(days => 7);
	} else {
	    # the next one is later this week,
	    # or it is next week (ie, on or after next Monday)
	    # $corr will take care of it.
	    $dt->add(days => $corr);
	}
	@cur = ($dt->year, $dt->month, $dt->day);
    } elsif (length($pat) == 2) {
	# DD: published on the give day of every month
	if ($dt->day >= $pat) {
	    # current date is on or after $pat: next one is next month
	    $dt->set(day => $pat);
	    $dt->add(months => 1);
	    @cur = ($dt->year, $dt->month, $dt->day);
	} else {
	    # current date is before $pat: set day to pattern
	    $cur[2] = $pat;
	}
    } elsif (length($pat) == 4) {
	# MMDD: published on the given day of the given month
	my ($mon, $day) = unpack("a2a2", $pat);

	if (on_or_after($mon, $day, $cur[1], $cur[2])) {
	    # Current date is on or after pattern; next one is next year
	    $cur[0] += 1;
	}
	# Year is now right. Either it's next year (because of on_or_after)
	# or it's this year, because the current date is NOT on or after
	# the pattern. Just fix the month and day
	$cur[1] = $mon;
	$cur[2] = $day;
    } else {
	carp "Invalid day pattern '$pat'";
	return undef;
    }

    foreach my $i (0..$#cur) {
	$cur[$i] = '0' . (0+$cur[$i]) if $cur[$i] < 10;
    }

#     printf("subsequent_day: returning '%s'\n", join('/', @cur));

    return @cur;
}


# Calculate date of 3rd Friday of the month (for example)
# 1-5: count from beginning of month
# 99-97: count back from end of month
sub nth_week_of_month {
    my $dt = shift;
    my $week = shift;
    my $day = shift;
    my ($nth_day, $dow);

#     printf("# nth_week_of_month(dt, '%s', '%s')\n", $week, $day);

    if (0 < $week && $week <= 5) {
	$nth_day = $dt->clone->set(day => 1);
    } elsif ($week >= 97) {
	$nth_day = DateTime->last_day_of_month(year  => $dt->year,
					       month => $dt->month);
    } else {
	return undef;
    }

    $dow = $nth_day->day_of_week();

    # If a particular day was passed in (eg, we want 3rd friday)
    # then use that day for the calculations, otherwise, just use
    # the day of the week of the original date (the date $dt).
    if (defined($day)) {
	$day = $daynames{$day};
    } else {
	$day = $dt->day_of_week;
    }

    if ($week <= 5) {
	# count forwards
	$nth_day->add(days => ($day - $dow + 7) % 7,
		      weeks=> $week - 1);
    } else {
	# count backwards
	$nth_day->subtract(days => ($day - $dow + 7) % 7);

	# 99: last week of month, 98: second last, etc.
	for (my $i = 99 - $week; $i > 0; $i--) {
	    $nth_day->subtract(weeks => 1);
	}
    }

    # There is no nth "day" in the month!
    return undef if ($dt->month != $nth_day->month);

    return $nth_day;
}

#
# Internal utility function to match the various different patterns
# of month, week, and day
#
sub check_date {
    my $dt = shift;
    my $month = shift;
    my $weekno = shift;
    my $day = shift;

#     printf("check_date('%s', '%s', '%s')\n", $month, $weekno, $day || '');

    if (!defined $day) {
	# MMWW
	return (($dt->month == $month)
		&& (($dt->week_of_month == $weekno)
		    || ($weekno >= 97
			&& ($dt->week_of_month == nth_week_of_month($dt, $weekno, $day)->week_of_month))));
    }

    # simple cases first
    if ($daynames{$day} != $dt->day_of_week) {
	# if it's the wrong day of the week, rest doesn't matter
	return 0;
    }

    if (!defined $month) {
	# WWdd
	return (($weekno == 0)	# Every week
		|| ($dt->weekday_of_month == $weekno) # this week
		|| (($weekno >= 97) && ($dt->weekday_of_month == nth_week_of_month($dt, $weekno, $day)->weekday_of_month)));
    }

    # MMWWdd
    if ($month != $dt->month) {
	# If it's the wrong month, then we're done
	return 0;
    }

    # It's the right day of the week
    # It's the right month

    if (($weekno == 0) ||($weekno == $dt->weekday_of_month)) {
	# If this matches, then we're counting from the beginning
	# of the month and it matches and we're done.
	return 1;
    }

    # only case left is that the week number is counting from
    # the end of the month: eg, second last wednesday
    return (($weekno >= 97)
	    && (nth_week_of_month($dt, $weekno, $day)->weekday_of_month == $dt->weekday_of_month));
}

sub match_week {
    my $pat = shift;
    my @date = @_;
    my $dt = DateTime->new(year  => $date[0],
			   month => $date[1],
			   day   => $date[2]);

    if ($pat =~ m/^$weekpat$daypat$/) {
	# WWdd: 03we = Third Wednesday
	return check_date($dt, undef, $1, $2);
    } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) {
	# MMWWdd: 0599tu Last Tuesday in May XXX WRITE ME
	return check_date($dt, $1, $2, $3);
    } elsif ($pat =~ m/^$monthpat$weekpat$/) {
	# MMWW: 1204: Fourth week in December XXX WRITE ME
	return check_date($dt, $1, $2, undef);
    } else {
	carp "invalid week pattern '$pat'";
	return 0;
    }
}

#
# Use $pat to calcuate the date of the issue following $cur
#
sub subsequent_week {
    my $pat = shift;
    my @cur = @_;
    my $candidate;
    my $dt;

#     printf("# subsequent_week('%s', '%s', '%s', '%s')\n", $pat, @cur);

    $dt = DateTime->new(year => $cur[0],
			month=> $cur[1],
			day  => $cur[2]);

    if ($pat =~ m/^$weekpat$daypat$/o) {
	# WWdd: published on given weekday of given week of every month
	my ($week, $day) = ($1, $2);

# 	printf("# subsequent_week: matched /WWdd/: week='%s', day='%s'\n",
# 	       $week, $day);

	if ($week eq '00') {
	    # Every week
	    $candidate = $dt->clone;

	    if ($dt->day_of_week == $daynames{$day}) {
		# Current is right day, next one is a week hence
		$candidate->add(days => 7);
	    } else {
		$candidate->add(days => ($daynames{$day} - $dt->day_of_week + 7) % 7);
	    }
	} else {
	    # 3rd Friday of the month (eg)
	    $candidate = nth_week_of_month($dt, $week, $day);
	}

	if ($candidate <= $dt) {
	    # If the n'th week of the month happens on before the
	    # current issue, then the next issue is published next
	    # month, otherwise, it's published this month.
	    # This will never happen for the "00: every week" pattern
# 	    printf("# subsequent_week: candidate (%s) occurs on or before current date (%s)\n",
# 		   join('/', $candidate->year, $candidate->month, $candidate->day),
# 		   join('/', $dt->year, $dt->month, $dt->day));
	    $candidate->set(day => 1);
	    $candidate->add(months => 1);
	    $candidate = nth_week_of_month($candidate, $week, $day);
	}
    } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) {
	# MMWWdd: published on given weekday of given week of given month
	my ($month, $week, $day) = ($1, $2, $3);

# 	printf("# subsequent_week: matched /MMWWdd/: month='%s', week='%s', day='%s'\n",
# 	       $month, $week, $day);

	$candidate = DateTime->new(year => $dt->year,
				   month=> $month,
				   day  => 1);
	$candidate = nth_week_of_month($candidate, $week, $day);
	if ($candidate <= $dt) {
	    # We've missed it for this year, next one that matches
	    # will be next year
	    $candidate->add(years => 1)->set(day => 1);
	    $candidate = nth_week_of_month($candidate, $week, $day);
	}
    } elsif ($pat =~ m/^$monthpat$weekpat$/) {
	# MMWW: published during given week of given month
	my ($month, $week) = ($1, $2);

	$candidate = nth_week_of_month(DateTime->new(year => $dt->year,
						     month=> $month,
						     day  => 1),
				       $week,
				       'th');
	if ($candidate <= $dt) {
	    # Already past the pattern date this year, move to next year
	    $candidate->add(years => 1)->set(day => 1);
	    $candidate = nth_week_of_month($candidate, $week, 'th');
	}
    } else {
	carp "invalid week pattern '$pat'";
	return undef;
    }

    $cur[0] = $candidate->year;
    $cur[1] = $candidate->month;
    $cur[2] = $candidate->day;

    foreach my $i (0..$#cur) {
	$cur[$i] = '0' . (0+$cur[$i]) if $cur[$i] < 10;
    }

    return @cur;
}

sub match_month {
    my $pat = shift;
    my @date = @_;

    return ($pat eq $date[1]);
}

sub subsequent_month {
    my $pat = shift;
    my @cur = @_;

    if ($cur[1] >= $pat) {
	# Current date is on or after the patter date, so the next
	# occurence is next year
	$cur[0] += 1;
    }

    # The year is right, just set the month to the pattern date.
    $cur[1] = $pat;

    return @cur;
}

sub match_season {
    my $pat = shift;
    my @date = @_;

    return ($pat eq $date[1]);
}

sub subsequent_season {
    my $pat = shift;
    my @cur = @_;

#     printf("# subsequent_season: pat='%s', cur='%s'\n", $pat, join('/',@cur));

    if (($pat < 21) || ($pat > 24)) {
	carp "Unexpected season '$pat'";
	return undef;
    }

    if ($cur[1] >= $pat) {
	# current season is on or past pattern season in this year,
	# advance to next year
	$cur[0] += 1;
    }
    # Either we've advanced to the next year or the current season
    # is before the pattern season in the current year. Either way,
    # all that remains is to set the season properly
    $cur[1] = $pat;

    return @cur;
}

sub match_year {
    my $pat = shift;
    my @date = @_;

    # XXX WRITE ME
    return 0;
}

sub subsequent_year {
    my $pat = shift;
    my $cur = shift;

    # XXX WRITE ME
    return undef;
}

sub match_issue {
    my $pat = shift;
    my @date = @_;

    # We handle enumeration patterns separately. This just
    # ensures that when we're processing chronological patterns
    # we don't match an enumeration pattern.
    return 0;
}

sub subsequent_issue {
    my $pat = shift;
    my $cur = shift;

    # Issue generation is handled separately
    return undef;
}

my %dispatch = (
		d => \&match_day,
		e => \&match_issue, # not really a "chron" code
		w => \&match_week,
		m => \&match_month,
		s => \&match_season,
		y => \&match_year,
);

my %generators = (
		  d => \&subsequent_day,
		  e => \&subsequent_issue, # not really a "chron" code
		  w => \&subsequent_week,
		  m => \&subsequent_month,
		  s => \&subsequent_season,
		  y => \&subsequent_year,
);

sub dispatch {
    my $chroncode = shift;

    return $dispatch{$chroncode};
}

sub generator {
    my $chroncode = shift;

    return $generators{$chroncode};
}

my %increments = (
		  a => {years => 1}, # annual
		  b => {months => 2}, # bimonthly
		  c => {days => 3}, # semiweekly
		  d => {days => 1}, # daily
		  e => {weeks => 2}, # biweekly
		  f => {months => 6}, # semiannual
		  g => {years => 2},  # biennial
		  h => {years => 3},  # triennial
		  i => {days => 2}, # three times / week
		  j => {days => 10}, # three times /month
		  # k => continuous
		  m => {months => 1}, # monthly
		  q => {months => 3}, # quarterly
		  s => {days => 15},  # semimonthly
		  t => {months => 4}, # three times / year
		  w => {weeks => 1},  # weekly
		  # x => completely irregular
);

sub can_increment {
    my $freq = shift;

    return exists $increments{$freq};
}

sub incr_date {
    my $freq = shift;
    my $incr = $increments{$freq};
    my @new = @_;

    if (scalar(@new) == 1) {
	# only a year is specified. Next date is easy
	$new[0] += $incr->{years} || 1;
    } elsif (scalar(@new) == 2) {
	# Year and month or season
	if ($new[1] > 20) {
	    # season
	    $new[1] += ($incr->{months}/3) || 1;
	    if ($new[1] > 24) {
		# carry
		$new[0] += 1;
		$new[1] -= 4;	# 25 - 4 == 21 == Spring after Winter
	    }
	} else {
	    # month
	    $new[1] += $incr->{months} || 1;
	    if ($new[1] > 12) {
		# carry
		$new[0] += 1;
		$new[1] -= 12;
	    }
	}
    } elsif (scalar(@new) == 3) {
	# Year, Month, Day: now it gets complicated.

	if ($new[2] =~ /^[0-9]+$/) {
	    # A single number for the day of month, relatively simple
	    my $dt = DateTime->new(year => $new[0],
				   month=> $new[1],
				   day  => $new[2]);
	    $dt->add(%{$incr});
	    $new[0] = $dt->year;
	    $new[1] = $dt->month;
	    $new[2] = $dt->day;
	}
    } else {
	warn("Don't know how to cope with @new");
    }

    foreach my $i (0..$#new) {
	$new[$i] = '0' . (0+$new[$i]) if $new[$i] < 10;
    }

    return @new;
}

1;