# 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;