# 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; # Mmmm, counters.
my ($date) = /
([^<]+) | /;
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;
|