
package Date::Annoying;

use Exporter;

@ISA=qw(Exporter);

@EXPORT_OK=qw(add_interesting_day);

($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = 
	localtime(time);

%interesting_days =
 ('Oct 31' => 'Halloween',
  'Nov 5'  => 'Guy Fawkes\' Day',
  'Jan 1'  => 'New Year\'s Day',
  'Apr 1'  => 'All Fools\'s Day',
  'Oct 6'  => 'MadHatterDay',
  'Mar 15' => 'the Ides of March',
  'Jun 16' => 'Bloomsday',
  'Aug 7'  => 'the anniversary of talk.bizarre',
  'Mar 21' => 'the Vernal Equinox',
  'Sep 21' => 'the Autumnal Equinox',
  'Apr 30' => 'Walpurgisnacht',
  'May 1'  => 'Walpurgis',
 );

@months = qw(January February March April May June July August
	     September October November December);

my $leapyear = 
    ($year % 4 == 0 && ($year % 100 != 0)) 
    || ($year % 400 == 0);
my $leapday = $leapyear ? 1 : 0;

%length = 
    ('January' => 31, 'February' => 28 + $leapday, 'March' => 31,
     'April' => 30, 'May' => 31, 'June' => 30,
     'July' => 31, 'August' => 31, 'September' => 30,
     'October' => 31, 'November' => 30, 'December' => 31,
     );

# Length_to_start is the number of days in the year before the
# start of a particular month.  $length_to_start{January} is 0;
# length_to_start{February} is 31; $length_to_start{March} is
# 60 in leap years, 59 otherwise.
$ll = 0;
foreach $m (@months) {
  $length_to_start{$m} = $ll;
  $ll += $length{$m};
}

if ($leapday) {
  Annoying->add_interesting_day('Feb 29', 'Leap Day');
}

$version = '0.1';
sub version {
  return $version;
}

=head1 Constructor
  Date::Annoying->new(%special_days);

C<%special_days> should be an array with an even number of elements.
If I<n> is an even number, array element I<n> should contain a date
in the form C<Month Day> or C<Day Month>, and array element I<n+1> should contain the name of that date.  For example:

    $annoy = Date::Annoying->new('Oct 31', 'Halloween',
				 '2 April', 'Casanova\'s Birthday',
				 'July 4', 'U.S. Independence Day',
				 '5 May', 'Cinco de Mayo');


C<new> returns an Annoying Date object which will compute dates in
annoying format, based on the days of interest in the initializer.
For examply, if it were July 7, then, after constructing C<$annoy> as
above, the call
    $annoy->date();

would return the string "Three days after U.S. Independence Day".

The array C<%Date::Annoying::interesting_days> is pre-loaded with a
number of dates of interest, for your convenience; however, calling
C<new> with no arguments generates an empty Annoying Date object.

You can add dates of interest to an Annoying Date object with the
L<add_interesting_day> method.  

=cut

sub new {
  my($package, %special_days) = @_;
  my $self = { 'special_days' => { %special_days }, 
	     };
  while (($k, $v) = each %special_days) {
    &add_interesting_day($self, $k, $v);
  }

  bless $self, $package;
}

=head1 add_interesting_day
  $annoying->add_interesting_day($day, $name);

This function informs an annoying date object of locally-observed
special days that it can use in constructing unparseable dates.
C<$day> is the name of a day of the year, in the form C<Feb 2> or C<31
October>.  C<$name> is the name of that day, such as C<Groundhog Day>
or C<Halloween>.  Returns an integer 1-366 to indicate the (Julian)
day added, or undef in the case of a parse or other error.

=cut

sub add_interesting_day {
  my ($self, $day, $name) = @_;
#  print "add_interesting_day: (@_)\n";
  return undef unless defined($name);
  $day = &julianize($day);
  return undef unless defined($day);
  # $day is now the Julian date.
  $self->{'of_note'}{$day} = $name;
  return $day;
}

=head1 date
  $annoying->date();

Return the current date in Annoying format.
=cut

sub date {
  my $self = $_[0];
  return $self->date_julian($yday);
}

=head1 date_time
  $annoying->date_time($time);

Return the specified date in Annoying format.
C<$time> is an integer in the usual Unix seconds-since-epoch format,
as returned from C<time>, for example.
=cut

sub date_time {	   
  my $self = $_[0];
  return $self->date_julian((localtime($_[1]))[7]);
}

=head1 date_julian
  $annoying->date_julian($yday);

Return the Annoying form for the specified day of the year.
C<$yday> is an integer between 1 and 365.  (366 in leap years.)  
=cut

sub date_julian {
  my ($self, $jd) = @_;
  my $smallest_diff = 400;	# Larger than 366
  my $nearest_notable_day; 
  my $invert;
  my $shopping = $self->{'shopping'};

  for $id (keys %{$self->{'of_note'}}) {
    my $diff1 = abs($id - $jd);
    my $diff2 = abs(365 + $leapday + $id - $jd);
    my ($diff, $invert_this);
    if ($diff2 < $diff1) {
      $invert_this = -1;
      $diff = $diff2;
    } else {
      $invert_this = 1;
      $diff = $diff1;
    }
    if ($diff < $smallest_diff) { # Nearest special day so far
      $smallest_diff = $diff;
      $nearest_notable_day = $id;
      $invert = $invert_this;
    }
  }
  
  my $dayname = $self->{'of_note'}{$nearest_notable_day};

  if ($nearest_notable_day == $jd) {
    return "\u$dayname";
  } elsif (($nearest_notable_day - $jd)*$invert > 0) {
    if ($smallest_diff == 1) {
      if ($shopping) {
	return "Today\'s your last chance to buy gifts before $dayname!";
      } else {
	return "The day before $dayname";
      }
    } else {
      if ($shopping) {
	return "Only $smallest_diff shopping days left before $dayname";
      } else {
	return "$smallest_diff days before $dayname";
      }
    }
  } else {
    if ($smallest_diff == 1) {
      return "The day after $dayname";
    } else {
      return "$smallest_diff days after $dayname";
    }
  }
}

=head1 shopping
  $annoying->shopping($boolean);

Put an Annoying Date objcet into `shopping' mode (or remove it from
that mode if the C<$boolean> argmuent is 0.)  An Annoying Date in
`shopping' mode produces Annoying Dates in a slightly different
format.  Returns the old value of the `shopping' property.

=cut

sub shopping {
  my ($self, $shopping) = @_;
  my ($os) = $self->{'shopping'};
  $self->{'shopping'} = $shopping;
  return $os;
}

# Take a string like `29 Feb' and turn it into a julian day number.
# Bug: Month names can be abbreviated, but not all-lowercase.
sub julianize {
  my $yday = $_[0];
  my ($month, $mday);
  my $w;

 WORD:
  foreach $w (split(' ', $yday)) {
    next if $w eq '';
    if ($w !~ /\D/) {
      $mday = $w;
      next WORD;
    }
    foreach $m (@months) {
      my $mm = substr($m, 0, length($w));
      if ($mm eq $w) {
	$month = $m;
	next WORD;
      }
    }
    return undef;		# Weird word
  }
  
  return undef unless defined($month) && defined($mday);
  return undef if ($mday < 1 || $mday > $length{$month});

  return $mday + $length_to_start{$month};
}

1;

