# Oxford University calendar conversion. Simon Cozens (c) 1999
# Artistic License

# It may be long-winded, but at least it's right.

BEGIN { # Dates of term change infrequently, so we'll get the
		# table at compile time.
	use Text::Abbrev;
	eval " use LWP::Simple ()";
	eval " use 	Date::Calc qw(Decode_Date_EU) ";
	if ($@) {
			status("Oxford calculation fucked: $@");
	$oxnaive++;
	}
	use Date::Calc qw(Decode_Date_EU);

}
my @days = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);

sub _initcal {
	unless (exists $INC{"LWP/Simple.pm"} and 
		Oxford::Calendar::InitHTML(LWP::Simple::get("http://www.admin.ox.ac.uk/admin/dates.htm"))) {
		# OK, we have to do it ourselves.
		&status("Manually loading up Calendar");
		Oxford::Calendar::Init(
			"Michaelmas 1999" => "10/10/1999", 
			"Hilary 2000" => "16/01/2000",
			"Trinity 2000" => "30/04/2000"
			) # By which time, someone else will be maintaining the bot.
	} else { &status("Autoloading"); }

	$_initcal++;
}

# This is the public interface from infobot.
# There is no hidden package. There is no cabal.
1;
sub oxdate { 
	&_initcal unless defined $_initcal;
	my ($tofrom, $date);
	($tofrom, $date) = @_;
	return ($tofrom eq "to") ? _world_to_ox($date) : _ox_to_world($date);
}

sub _world_to_ox {
	my $date=shift;

	if ($oxnaive) {

		unless($date=~m|(\d+)/(\d+)/(\d+)|) {
			return "I'm really sorry; some bozo forgot to install Date::Calc, so I can only cope with DD/MM/(YY)YY type dates. That wasn't one. Try again.";
		}

		my ($year,$month,$day)=($3,$2,$1); # Assume UK.
	} else { 
		($year,$month,$day)= Decode_Date_EU($date);
		return "I need a date that's roughly in Day Month Year format"
			unless $year and $month and $day;
			# Be liberal in what you accept and conservative in what you
			# produce.
	}		

    $year+=1900 if $year<1900; 
	return Oxford::Calendar::ToOx($day,$month,$year);
}

sub _ox_to_world { 
	my ($year, $term, $week, $day) = Oxford::Calendar::Parse(shift());
	return "Couldn't parse that date. Try something less pathological"
		if $year eq "UNPARSABLE";
	return "$day, $week week, $term $year is ".
	Oxford::Calendar::FromOx($year, $term, $week, $day);
}

package Oxford::Calendar; # Argh.

sub Init { %db=(@_); 
	$nodc++ unless exists $INC{"Date/Calc.pm"};
	if($nodc) {
		my $i=0;
		$months{$_}=++$i for (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct
		Nov Dec));
	}
} 

sub InitHTML {
	$_[0]=~s/\r//g;
	my @foo=split /\n/, $_[0];
	Init();
	my $next=0;
	foreach (@foo) {
		last if /Dates of Extended Terms/; 
		# If they change the layout, of course...
		if (/TERM/) {($term, $year) = /\s*(\w+)\s+TERM (\d+)/; $next=1;}
		elsif ($next) { 
			$next=0; # <homer> Mmmm, counters. </homer>
			my ($date) = /<TD>([^<]+)<TD>/; 
			if ($nodc) {
				($day, $monthname)= /,\s+(\d+)\s+(\w\w\w)/;	
				$month=$months{$monthname};
			} else { 
			    $date=~s/,//g;
				$date.=$year;
				($year, $month, $day) = Date::Calc::Decode_Date_EU($date);
			}
			$term=ucfirst(lc($term));
			$db{$term." ".$year} =
			sprintf("%02u/%02u/%04u",$day,$month,$year) if $day and
			$month and $year;
			&main::status("parsed $term $year as $day $month $year");
		}
	}
	return 1;
}

sub ToOx {
	my ($day,$month,$year) = @_;
	my $delta=367; my ($tmp, $offset);
	my @a;
	foreach (keys %db) { 
		eval { @a=Date::Calc::Decode_Date_EU($db{$_}) } or next;
		next unless $a[2];
		if ($nodc) { return "I can't be arsed. Install the module." } else {
			if (abs($delta) > abs($tmp=Date::Calc::Delta_Days(
				@a,
				$year, $month, $day))) {
				$delta=$tmp;
				$nearest=$_; $offset=1;
			}
			if (abs($delta) > abs($tmp=Date::Calc::Delta_Days(
			    (Date::Calc::Add_Delta_Days(@a,7*7)),
				$year, $month, $day))) {
				$delta=$tmp;
				$nearest=$_; $offset=8;
            }
		}
	}
	return "Out of my range; sorry." if $delta == 367;
	my $w=$offset+int($delta/7); $w-=1 if $delta<0 and $delta%7;
	if($delta<0){$delta=$delta%7-7}else{$delta%=7};
	$day=$days[$delta];
	$wsuffix="th";
	abs($w)==1 && ($wsuffix="st");
	abs($w)==2 && ($wsuffix="nd");
	abs($w)==3 && ($wsuffix="rd");
	return "$day, $w$wsuffix week, $nearest.";
}

sub Parse {
	my $string = shift;
	my $term="";
	my ($day, $week, $year);
	$day=$week=$year="";

	$string=lc($string);
	$string=~s/week//g;
	my @terms = qw(Michaelmas Hilary Trinity);
	$string=~s/(\d+)(?:rd|st|nd|th)/$1/;
	%ab=Text::Abbrev::abbrev(@days,@terms);
	while ($string=~s/((?:\d|-)\d*)/ /) {
		if($1>50) { $year=$1; $year+=1900 if $year<1900; }
		else { $week=$1 }
		pos($string)-=length($1);
	}
	foreach(sort {length $b <=> length $a} keys %ab) {
		if ($string=~/$_/gi) {
			pos($string)-=length($_);
			$foo=lc($_); $string=~s/\G$foo[a-z]*/ /; $expand=$ab{$_};
			$term=$expand if (scalar(grep /$expand/, @terms) > 0) ;
			$day=$expand if (scalar (grep /$expand/, @days) > 0) ;
		}
	}
	unless ($day) {
		%ab=Text::Abbrev::abbrev(@days);
		foreach(sort {length $b <=> length $a} keys %ab) {
			if ($string=~/$_/ig) {
				pos($string)-=length($_);
				$foo=lc($_); $string=~s/\G$foo[a-z]*/ /; $day=$ab{$_};
			}
		}
	}
	unless ($term) {
		%ab=Text::Abbrev::abbrev(@terms);
		foreach(sort {length $b <=> length $a} keys %ab) {
			if ($string=~/$_/ig) {
				pos($string)-=length($_);
				$foo=lc($_); $string=~s/\G$foo[a-z]*/ /; $term=$ab{$_};
			}
		}
	}
	# Assume this term?
	unless($term) {
		$term=ToOx(reverse Date::Calc::Today());
		return "Can't work out what term" unless $term=~ /week/;
		$term=~s/.*eek,\s+(\w+).*/$1/;
	}
	$year=(Date::Calc::Today())[0] unless $year;
	return "UNPARSABLE" unless $week and $day;
	return($year,$term,$week,$day);
}

sub FromOx {
	my ($year, $term, $week, $day);
	($year, $term, $week, $day)=@_;
	$year=~s/\s//g;
	$term=~s/\s//g;
	return "Out of range " unless exists $db{"$term $year"};
	{ my $foo=0; %lu=(map {$_,$foo++} @days); }
	$delta=7*($week-1)+$lu{$day};
	@start=Date::Calc::Decode_Date_EU($db{"$term $year"});
	return "The internal database is bad for $term $year" unless
		$start[0];
	return
	join "/", reverse (Date::Calc::Add_Delta_Days(@start,$delta));

}

package main;