File Coverage

blib/lib/Oxford/Calendar.pm
Criterion Covered Total %
statement 226 251 90.0
branch 72 100 72.0
condition 18 23 78.2
subroutine 32 32 100.0
pod 6 7 85.7
total 354 413 85.7


line stmt bran cond sub pod time code
1             # Oxford University calendar conversion.
2             # Simon Cozens (c) 1999-2002
3             # Eugene van der Pijll (c) 2004
4             # University of Oxford (c) 2007-2015
5             # Dominic Hargreaves (c) 2016
6             # Artistic License
7             package Oxford::Calendar;
8             $Oxford::Calendar::VERSION = "2.11";
9 3     3   52616 use strict;
  3         4  
  3         66  
10 3     3   1888 use Text::Abbrev;
  3         82  
  3         168  
11 3     3   684 use Date::Calc qw(Add_Delta_Days Decode_Date_EU Delta_Days Mktime Easter_Sunday Date_to_Days Day_of_Week_to_Text Day_of_Week);
  3         12037  
  3         273  
12 3     3   1287 use YAML;
  3         15091  
  3         133  
13 3     3   1143 use Time::Seconds;
  3         3479  
  3         151  
14 3     3   1305 use Time::Piece;
  3         17383  
  3         29  
15              
16 3     3   186 use constant CALENDAR => '/etc/oxford-calendar.yaml';
  3         3  
  3         145  
17 3     3   10 use constant SEVEN_WEEKS => 7 * ONE_WEEK;
  3         4  
  3         106  
18 3     3   13 use constant DEFAULT_MODE => 'nearest';
  3         3  
  3         107  
19 3     3   19 use constant TERMS => qw(Michaelmas Hilary Trinity);
  3         3  
  3         137  
20 3     3   9 use constant DAYS => qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
  3         2  
  3         113  
21              
22             # Constants defined by University regulations
23 3     3   7 use constant MICHAELMAS_START => (10, 1);
  3         3  
  3         113  
24 3     3   8 use constant MICHAELMAS_END => (12, 17);
  3         8  
  3         103  
25 3     3   13 use constant HILARY_START => (1, 7);
  3         3  
  3         102  
26 3     3   9 use constant HILARY_END_IF_EARLIER => (3, 25);
  3         3  
  3         107  
27 3     3   8 use constant TRINITY_START_IF_LATER => (4, 20);
  3         2  
  3         103  
28 3     3   28 use constant TRINITY_END => (7, 6);
  3         3  
  3         5646  
29              
30             =head1 NAME
31              
32             Oxford::Calendar - University of Oxford calendar conversion routines
33              
34             =head1 SYNOPSIS
35              
36             use 5.10.0;
37             use Oxford::Calendar;
38             use Date::Calc;
39             say "Today is " . Oxford::Calendar::ToOx(reverse Date::Calc::Today);
40              
41             =head1 DESCRIPTION
42              
43             This module converts University of Oxford dates (Oxford academic dates)
44             to and from Real World dates, and provides information on Terms of the
45             University.
46              
47             The Terms of the University are defined by the
48             B, available online from
49              
50             L
51              
52             This document describes the start and end dates of Oxford Terms.
53              
54             In addition to this, the dates of Full Term, required to calculate the
55             week number of the term, are prescribed by Council, and published
56             periodically in the B.
57              
58             Full term comprises weeks 1-8 inclusive, but sometimes, dates outside of
59             full term are presented in the Oxford academic date format.
60             This module will optionally provide such dates.
61              
62             Data for these prescribed dates may be supplied in the file
63             F; if this file does not exist, built-in data
64             will be used. The built-in data is periodically updated from the
65             semi-authoritative source at
66              
67             L.
68              
69             or the authoritative source, the Gazette, available online from
70              
71             L.
72              
73             L
74             describes the academic year at Oxford.
75              
76             =head1 DATE FORMAT
77              
78             An Oxford academic date has the following format:
79              
80             =over
81              
82             , [st,nd,rd,th] week,
83              
84             =back
85              
86             where term name is one of
87              
88             =over
89              
90             =item *
91              
92             Michaelmas (autumn)
93              
94             =item *
95              
96             Hilary (spring)
97              
98             =item *
99              
100             Trinity (summer)
101              
102             =back
103              
104             Example:
105              
106             Friday, 8th Week, Michaelmas 2007
107              
108             =cut
109              
110             our %db;
111              
112             my $_initcal; # If this is true, we have our database of dates already.
113             my $_initrange;
114             my @_oxford_full_terms;
115              
116             sub _get_week_suffix {
117 14     14   11 my $week = shift;
118 14 50       33 die "_get_week_suffix: No week given" unless defined $week;
119 14         14 my $wsuffix = "th";
120 14 50       26 abs($week) == 1 && ( $wsuffix = "st" );
121 14 100       20 abs($week) == 2 && ( $wsuffix = "nd" );
122 14 100       21 abs($week) == 3 && ( $wsuffix = "rd" );
123            
124 14         16 return $wsuffix;
125             }
126              
127             sub _find_week {
128 2     2   4 my $tm = shift;
129 2         3 my $sweek = shift;
130 2         2 my $sweek_tm = shift;
131              
132 2         4 my $eow = $sweek_tm + ONE_WEEK;
133              
134 2         46 while ( $tm >= $eow ) {
135 6         58 $eow += ONE_WEEK;
136 6         116 $sweek++;
137             }
138 2         22 return $sweek;
139             }
140              
141             sub _init_db {
142 3     3   3 my $db;
143 3 50       78 if ( -r CALENDAR ) {
144 0         0 $db = YAML::LoadFile(CALENDAR);
145             }
146             else {
147 3         154 my $data = join '', ;
148 3         27 $db = YAML::Load($data);
149             }
150 3         134234 %db = %{ $db->{Calendar} };
  3         81  
151             }
152              
153             sub _init_range {
154 2     2   21 foreach my $termspec ( keys %db ) {
155 130 50       3399 next unless $db{$termspec};
156              
157 130 50       114 my $time = eval { Time::Piece->strptime($db{$termspec}->{start}, '%d/%m/%Y' ) }
  130         228  
158             or die
159             "Could not decode date ($db{$termspec}->{start}) for term $termspec: $@";
160              
161             push @_oxford_full_terms,
162 130         6076 [$time, ($time + SEVEN_WEEKS), split(/ /, $termspec), $db{$termspec}->{provisional}];
163             }
164              
165 2         55 $_initrange++;
166             }
167              
168             sub _fmt_oxdate_as_string {
169 14     14   16 my ( $dow, $week, $term, $year ) = @_;
170 14         28 my $wsuffix = _get_week_suffix($week);
171 14         105 return "$dow, $week$wsuffix week, $term $year";
172             }
173              
174             sub _increment_term {
175 1     1   2 my ( $year, $term ) = @_;
176 1 50       5 if ( $term eq 'Michaelmas' ) {
    50          
    0          
177 0         0 return $year + 1, 'Hilary';
178             } elsif ( $term eq 'Hilary' ) {
179 1         3 return $year, 'Trinity'
180             } elsif ( $term eq 'Trinity' ) {
181 0         0 return $year, 'Michaelmas';
182             } else {
183 0         0 die "_increment_term: Unknown term $term";
184             }
185             }
186              
187             sub _sunday_of_first {
188 17     17   17 my ( $year, $term ) = @_;
189 17 50       29 Init() unless defined $_initcal;
190 17         38 my $date = $db{"$term $year"};
191 17 100       26 return undef unless $date;
192 15         66 return ( $date->{provisional}, Decode_Date_EU($date->{start}) );
193             }
194              
195             sub _to_ox_nearest {
196 7     7   12 my @date = @_;
197 7         10 my $confirmed = pop @date;
198 7         5 my $week;
199             my @term;
200 7 100       17 _init_range() unless defined $_initrange;
201 7         20 my $dow = Day_of_Week_to_Text( Day_of_Week( @date ) );
202 7         33 my $tm = Time::Piece->strptime(join('/', @date[0..2]), '%Y/%m/%d');
203 7         125 my @terms = sort { $a->[0] <=> $b->[0] } @_oxford_full_terms;
  2207         15417  
204 7         98 my ( $prevterm, $nextterm );
205 7         9 my $curterm = shift @terms;
206              
207 7         17 while ($curterm) {
208 265 100       302 if ( $tm < $curterm->[0] ) {
209 7 50 33     68 if ( $prevterm && $tm >= ($prevterm->[1] + ONE_WEEK) ) {
210 7         288 $nextterm = $curterm;
211 7         8 last;
212             } else {
213 0         0 die "Date out of range";
214             }
215             }
216 258         2051 $prevterm = $curterm;
217 258         304 $curterm = shift @terms;
218             }
219 7 50       30 return undef unless $nextterm;
220              
221             # We are in the gap between terms .. which one is closest?
222 7         45 my $prevgap = $tm - ($prevterm->[1] + ONE_WEEK);
223 7         274 my $nextgap = $tm - $nextterm->[0];
224              
225 7 100       130 if ( abs($prevgap) < abs($nextgap) ) {
226             # if equal go for -th week
227 2         59 $week = _find_week( $tm, 8, $prevterm->[1] );
228 2         3 @term = @{$prevterm};
  2         4  
229             } else {
230 5         159 my $delta = $nextgap / (24 * 60 * 60);
231 5         19 $week = 1 + int( $delta / 7 );
232 5 100       10 $week -= 1 if $delta % 7;
233 5         5 @term = @{$nextterm};
  5         13  
234             }
235 7 100 100     35 return undef if $term[4] && $confirmed;
236 6 100       18 return ($dow, $week, $term[2], $term[3]) if ( wantarray );
237 5         9 return _fmt_oxdate_as_string( $dow, $week, $term[2], $term[3] );
238             }
239              
240              
241             sub Init {
242 3     3 0 11 _init_db;
243 3         66 Date::Calc::Language(Date::Calc::Decode_Language('English'));
244 3         8 $_initcal++;
245             }
246              
247             =head1 FUNCTIONS
248              
249             =over 3
250              
251             =item ToOx($day, $month, $year, [\%options])
252              
253             Given a day, month and year in standard human format (that is, month is
254             1-12, not 0-11, and year is four digits) will return a string of the
255             form
256              
257             Day, xth week, Term year
258              
259             or an array
260              
261             (Day, week of term, Term, year)
262            
263             depending on how it is called. The exact behaviour is modified by the 'mode'
264             option described below.
265              
266             If the requested date is not in full term or extended term (see below),
267             undef will be returned.
268              
269             If the requested date is not covered by the database, ToOx will die with
270             an "out of range" error message. Therefore it is recommended to eval ToOx
271             with appropriate error handling.
272              
273             %options can contain additional named parameter options:
274              
275             =over 5
276              
277             =item mode
278              
279             Several modes are available:
280              
281             =over 6
282              
283             =item full_term
284              
285             Term dates will only be returned if the date requested is part of a full
286             term (as defined by the web page above).
287              
288             =item ext_term
289              
290             Term dates will only be returned if the date requested is part of an extended
291             term, or statutory term.
292              
293             =item nearest
294              
295             Will return term dates based on the nearest term, even if the date requested
296             is not part of an extended term (i.e. will include fictional week numbers).
297              
298             This is currently the default behaviour, for backwards compatibility with
299             previous releases; this may be changed in future.
300              
301             =back
302              
303             =back
304              
305             =over 4
306              
307             =item confirmed
308              
309             If true, ignores dates marked as provisional in the database.
310              
311             =back
312              
313             =cut
314              
315             sub ToOx {
316 24     24 1 1933 my (@dmy, $options);
317 24         44 ($dmy[0], $dmy[1], $dmy[2], $options) = @_;
318 24   100     62 my $mode = $options->{mode} || DEFAULT_MODE;
319 24         46 my ($week, @term);
320 24         36 my @date = reverse @dmy;
321 24 100       47 Init unless defined $_initcal;
322 24         110 my $dow = Day_of_Week_to_Text( Day_of_Week( @date ) );
323              
324 24         41 @term = ThisTerm( @date );
325 24 100       71 if ( $#term ) {
326             # We're in term
327 14         25 my @term_start = _sunday_of_first( @term );
328 14         17 my $provisional = shift @term_start;
329 14 100       45 die "Date out of range" unless ( $#term_start == 2 );
330 12         18 my $days_from_start = Delta_Days( @term_start, @date );
331 12 100       19 my $week_offset = $days_from_start < 0 ? 1 : 7;
332 12         25 my $week = int( ( $days_from_start + $week_offset ) / 7);
333 12 100 66     33 return undef if $options->{confirmed} && $provisional;
334 11 100 100     65 return undef if ( ( $week < 1 || $week > 8 ) && $mode eq 'full_term' );
      100        
335 10 100       24 return ( $dow, $week, $term[1], $term[0] ) if ( wantarray );
336 9         18 return _fmt_oxdate_as_string( $dow, $week, $term[1], $term[0] );
337             } else {
338 10 100       21 return undef if $mode eq 'full_term';
339 9 100       20 return undef if $mode eq 'ext_term';
340 7         18 return _to_ox_nearest( @date, $options->{confirmed} );
341             }
342             }
343              
344             =item ThisTerm($year, $month, $day)
345              
346             Given a year, month, term in standard human format (that is, month is
347             1-12, not 0-11, and year is four digits) will returns the current term
348             or undef if in vacation or unknown. The term is given as an array in the
349             form (year, term).
350              
351             =cut
352              
353             sub ThisTerm {
354 32     32 1 30 my ( $year, $month, $day ) = @_;
355 32         43 my $term_dates = StatutoryTermDates( $year );
356 32         25 foreach my $term ( keys %{$term_dates} ) {
  32         80  
357 82         52 my $start = Date_to_Days( @{$term_dates->{$term}->{start}} );
  82         115  
358 82         52 my $end = Date_to_Days( @{$term_dates->{$term}->{end}} );
  82         91  
359 82         78 my $date = Date_to_Days( $year, $month, $day );
360 82 100 100     258 if ( ( $date >= $start ) && ( $date <= $end )) {
361 16         40 return ( $year, $term );
362             }
363             }
364 16         58 return undef;
365             }
366              
367             =item NextTerm($year, $month, $day)
368              
369             Given a day, month and year in standard human format (that is, month is
370             1-12, not 0-11, and year is four digits) will return the next term (whether
371             or not the date given is in term time).
372             The term is given as an array in the form (year, term).
373              
374             =cut
375              
376             sub NextTerm {
377 2     2 1 515 my @date = @_;
378 2         3 my @next_term;
379 2         4 my @this_term = ThisTerm( @date );
380 2 100       8 if ( @this_term == 2 ) {
381 1         4 @next_term = _increment_term( @this_term );
382             } else {
383 1         2 my @test_date = @date;
384 1         5 while ( @next_term != 2 ) {
385 6         11 @test_date = Add_Delta_Days( @test_date, 1 );
386 6         9 @next_term = ThisTerm( @test_date );
387             }
388             }
389 2         6 return @next_term;
390             }
391              
392             =item StatutoryTermDates($year)
393              
394             Returns a hash reference keyed on terms for a given year, the value of
395             each being a hash reference containing start and end dates for that term.
396             The dates are stored as array references containing numeric
397             year, month, day values.
398              
399             Note: these are the statutory term dates, not full term dates.
400              
401             =cut
402              
403             sub StatutoryTermDates {
404 32     32 1 29 my $year = shift;
405 32 50       57 die "StatutoryTermDates: no year given" unless $year;
406            
407             # Calculate end of Hilary
408 32         106 my @palm_sunday =
409             Date::Calc::Add_Delta_Days( Date::Calc::Easter_Sunday( $year ), -7 );
410 32         49 my @saturday_before_palm_sunday =
411             Date::Calc::Add_Delta_Days( @palm_sunday, -6 );
412              
413 32         68 my $hilary_delta = Date::Calc::Delta_Days(
414             $year, HILARY_END_IF_EARLIER,
415             @saturday_before_palm_sunday
416             );
417              
418 32         24 my @hilary_end;
419 32 100       46 if ( $hilary_delta == 1 ) {
420 5         9 @hilary_end = ( $year, HILARY_END_IF_EARLIER );
421             } else {
422 27         30 @hilary_end = @saturday_before_palm_sunday;
423             }
424            
425             # Calculate start of Trinity
426 32         65 my @wednesday_after_easter_sunday =
427             Date::Calc::Add_Delta_Days( Date::Calc::Easter_Sunday( $year ), 3 );
428              
429 32         46 my $trinity_delta = Date::Calc::Delta_Days(
430             @wednesday_after_easter_sunday,
431             $year, TRINITY_START_IF_LATER
432             );
433              
434 32         24 my @trinity_start;
435 32 50       36 if ( $trinity_delta == 1 ) {
436 0         0 @trinity_start = ( $year, TRINITY_START_IF_LATER );
437             } else {
438 32         34 @trinity_start = @wednesday_after_easter_sunday;
439             }
440              
441 32         170 my $term_dates = {
442             Michaelmas => {
443             start => [$year, MICHAELMAS_START],
444             end => [$year, MICHAELMAS_END]
445             },
446             Hilary => {
447             start => [$year, HILARY_START],
448             end => [@hilary_end]
449             },
450             Trinity => {
451             start => [@trinity_start],
452             end => [$year, TRINITY_END]
453             }
454             };
455 32         55 return $term_dates;
456             }
457              
458             =item Parse($string)
459              
460             Takes a free-form description of an Oxford calendar date, and attempts
461             to divine the expected meaning. If the name of a term is not found, the
462             current term will be assumed. If the description is unparsable, undef
463             is returned. Otherwise, an array will be returned of the form
464             C<($year,$term,$week,$day)>.
465              
466             This function is experimental.
467              
468             =cut
469              
470             sub Parse {
471 3     3 1 5 my $string = shift;
472 3         4 my $term = "";
473 3         2 my ( $day, $week, $year );
474 3         5 $day = $week = $year = "";
475              
476 3         5 $string = lc($string);
477 3         9 $string =~ s/week//g;
478 3         14 $string =~ s/(\d+)(?:rd|st|nd|th)/$1/;
479 3         13 my %ab = Text::Abbrev::abbrev( DAYS, TERMS );
480 3         663 my $expand;
481 3         18 while ( $string =~ s/((?:\d|-)\d*)/ / ) {
482 6 50       15 if ( $1 > 50 ) { $year = $1; $year += 1900 if $year < 1900; }
  3 100       4  
  3         15  
483 3         17 else { $week = $1 }
484             }
485 3         23 foreach ( sort { length $b <=> length $a } keys %ab ) {
  954         568  
486 198 100       1016 if ( $string =~ s/\b$_\w+//i ) {
487              
488             #pos($string)-=length($_);
489             #my $foo=lc($_); $string=~s/\G$foo[a-z]*/ /i;
490 6         6 $expand = $ab{$_};
491 6 100       63 $term = $expand if ( scalar( grep /$expand/, TERMS ) > 0 );
492 6 100       54 $day = $expand if ( scalar( grep /$expand/, DAYS ) > 0 );
493             }
494             }
495 3 50       12 unless ($day) {
496 0         0 %ab = Text::Abbrev::abbrev(DAYS);
497 0         0 foreach ( sort { length $b <=> length $a } keys %ab ) {
  0         0  
498 0 0       0 if ( $string =~ /$_/ig ) {
499 0         0 pos($string) -= length($_);
500 0         0 my $foo = lc($_);
501 0         0 $string =~ s/\G$foo[a-z]*/ /;
502 0         0 $day = $ab{$_};
503             }
504             }
505             }
506 3 50       7 unless ($term) {
507 0         0 %ab = Text::Abbrev::abbrev(TERMS);
508 0         0 foreach ( sort { length $b <=> length $a } keys %ab ) {
  0         0  
509 0 0       0 if ( $string =~ /$_/ig ) {
510 0         0 pos($string) -= length($_);
511 0         0 my $foo = lc($_);
512 0         0 $string =~ s/\G$foo[a-z]*/ /;
513 0         0 $term = $ab{$_};
514             }
515             }
516             }
517              
518             # Assume this term?
519 3 50       5 unless ($term) {
520 0         0 $term = ToOx( reverse Date::Calc::Today() );
521 0 0       0 return "Can't work out what term" unless $term =~ /week/;
522 0         0 $term =~ s/.*eek,\s+(\w+).*/$1/;
523             }
524 3 50       4 $year = ( Date::Calc::Today() )[0] unless $year;
525 3 50 33     14 return undef unless defined $week and defined $day;
526 3         26 return ( $year, $term, $week, $day );
527             }
528              
529             =item FromOx($year, $term, $week, $day)
530              
531             Converts an Oxford date into a Gregorian date, returning a string of the
532             form C
or undef.
533              
534             The arguments are of the same format as returned by ToOx in array context;
535             that is, a four-digit year, the name of the term, the week number, and
536             the name of the day of week (e.g. 'Sunday').
537              
538             If the requested date is not covered by the database, FromOx will die with
539             an "out of range" error message. Therefore it is recommended to eval ToOx
540             with appropriate error handling.
541              
542             =cut
543              
544             sub FromOx {
545 4     4 1 209 my %lu;
546 4 50       8 Init unless defined $_initcal;
547 4         3 my ( $year, $term, $week, $day );
548 4         7 ( $year, $term, $week, $day ) = @_;
549 4         7 $year =~ s/\s//g;
550 4         5 $term =~ s/\s//g;
551 4 100       21 die "No data for $term $year" unless exists $db{"$term $year"};
552             {
553 3         3 my $foo = 0;
  3         3  
554 3         4 %lu = ( map { $_, $foo++ } DAYS );
  21         27  
555             }
556 3         8 my $delta = 7 * ( $week - 1 ) + $lu{$day};
557 3         6 my @start = _sunday_of_first( $year, $term );
558 3         4 shift @start;
559 3 50       4 die "The internal database is bad for $term $year"
560             unless $start[0];
561 3         20 return join "/", reverse( Date::Calc::Add_Delta_Days( @start, $delta ) );
562             }
563              
564             1;
565              
566             =back
567              
568             =head1 BUGS
569              
570             Bugs may be browsed and submitted at
571              
572             L
573              
574             A copy of the maintainer's git repository may be found at
575              
576             L
577              
578             =head1 AUTHOR
579              
580             Simon Cozens is the original author of this module.
581              
582             Eugene van der Pijll, C took over maintenance from
583             Simon for a time.
584              
585             Dominic Hargreaves maintains this module (between 2008 and 2015 for
586             IT Services, University of Oxford).
587              
588             =cut
589              
590             __DATA__