File Coverage

blib/lib/Date/ISO8601.pm
Criterion Covered Total %
statement 141 141 100.0
branch 63 64 98.4
condition 38 42 90.4
subroutine 29 29 100.0
pod 13 13 100.0
total 284 289 98.2


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Date::ISO8601 - the three ISO 8601 numerical calendars
4              
5             =head1 SYNOPSIS
6              
7             use Date::ISO8601 qw(present_y);
8              
9             print present_y($y);
10              
11             use Date::ISO8601
12             qw(month_days cjdn_to_ymd ymd_to_cjdn present_ymd);
13              
14             $md = month_days(2000, 2);
15             ($y, $m, $d) = cjdn_to_ymd(2406029);
16             $cjdn = ymd_to_cjdn(1875, 5, 20);
17             print present_ymd(2406029);
18             print present_ymd(1875, 5, 20);
19              
20             use Date::ISO8601
21             qw(year_days cjdn_to_yd yd_to_cjdn present_yd);
22              
23             $yd = year_days(2000);
24             ($y, $d) = cjdn_to_yd(2406029);
25             $cjdn = yd_to_cjdn(1875, 140);
26             print present_yd(2406029);
27             print present_yd(1875, 140);
28              
29             use Date::ISO8601
30             qw(year_weeks cjdn_to_ywd ywd_to_cjdn present_ywd);
31              
32             $yw = year_weeks(2000);
33             ($y, $w, $d) = cjdn_to_ywd(2406029);
34             $cjdn = ywd_to_cjdn(1875, 20, 4);
35             print present_ywd(2406029);
36             print present_ywd(1875, 20, 4);
37              
38             =head1 DESCRIPTION
39              
40             The international standard ISO 8601 "Data elements and interchange formats
41             - Information interchange - Representation of dates and times" defines
42             three distinct calendars by which days can be labelled. It also defines
43             textual formats for the representation of dates in these calendars.
44             This module provides functions to convert dates between these three
45             calendars and Chronological Julian Day Numbers, which is a suitable
46             format to do arithmetic with. It also supplies functions that describe
47             the shape of these calendars, to assist in calendrical calculations.
48             It also supplies functions to represent dates textually in the ISO
49             8601 formats. ISO 8601 also covers time of day and time periods, but
50             this module does nothing relating to those parts of the standard; this
51             is only about labelling days.
52              
53             The first ISO 8601 calendar divides time up into years, months, and days.
54             It corresponds exactly to the Gregorian calendar, invented by Aloysius
55             Lilius and promulgated by Pope Gregory XIII in the late sixteenth century,
56             with AD (CE) year numbering. This calendar is applied to all time,
57             not just to dates after its invention nor just to years 1 and later.
58             Thus for ancient dates it is the proleptic Gregorian calendar with
59             astronomical year numbering.
60              
61             The second ISO 8601 calendar divides time up into the same years as
62             the first, but divides the year directly into days, with no months.
63             The standard calls this "ordinal dates". Ordinal dates are commonly
64             referred to as "Julian dates", a mistake apparently deriving from true
65             Julian Day Numbers, which divide time up solely into linearly counted
66             days.
67              
68             The third ISO 8601 calendar divides time up into years, weeks, and days.
69             The years approximate the years of the first two calendars, so they stay
70             in step in the long term, but the boundaries differ. This week-based
71             calendar is sometimes called "the ISO calendar", apparently in the belief
72             that ISO 8601 does not define any other. It is also referred to as
73             "business dates", because it is most used by certain businesses to whom
74             the week is the most important temporal cycle.
75              
76             The Chronological Julian Day Number is an integral number labelling each
77             day, where the day extends from midnight to midnight in whatever time zone
78             is of interest. It is a linear count of days, where each day's number
79             is one greater than the previous day's number. It is directly related to
80             the Julian Date system: in the time zone of the prime meridian, the CJDN
81             equals the JD at noon. By way of epoch, the day on which the Convention
82             of the Metre was signed, which ISO 8601 defines to be 1875-05-20 (and
83             1875-140 and 1875-W20-4), is CJDN 2406029.
84              
85             This module places no limit on the range of dates to which it may be
86             applied. All function arguments are permitted to be C or
87             C objects in order to achieve arbitrary range. Native Perl
88             integers are also permitted, as a convenience when the range of dates
89             being handled is known to be sufficiently small.
90              
91             =cut
92              
93             package Date::ISO8601;
94              
95 4     4   129747 { use 5.006; }
  4         15  
  4         161  
96 4     4   26 use warnings;
  4         6  
  4         154  
97 4     4   21 use strict;
  4         8  
  4         177  
98              
99 4     4   22 use Carp qw(croak);
  4         14  
  4         396  
100              
101             our $VERSION = "0.004";
102              
103 4     4   3524 use parent "Exporter";
  4         1307  
  4         22  
104             our @EXPORT_OK = qw(
105             present_y
106             month_days cjdn_to_ymd ymd_to_cjdn present_ymd
107             year_days cjdn_to_yd yd_to_cjdn present_yd
108             year_weeks cjdn_to_ywd ywd_to_cjdn present_ywd
109             );
110              
111             # _numify(A): turn possibly-object number into native Perl integer
112              
113             sub _numify($) {
114 1311     1311   155191 my($a) = @_;
115 1311 100       4155 return ref($a) eq "" ? $a : $a->numify;
116             }
117              
118             # _fdiv(A, B): divide A by B, flooring remainder
119             #
120             # B must be a positive Perl integer. A may be a Perl integer, Math::BigInt,
121             # or Math::BigRat. The result has the same type as A.
122              
123             sub _fdiv($$) {
124 554     554   732 my($a, $b) = @_;
125 554 100       1195 if(ref($a) eq "Math::BigRat") {
126 82         266 return ($a / $b)->bfloor;
127             } else {
128 472 100       1067 if($a < 0) {
129 4     4   4357 use integer;
  4         38  
  4         21  
130 29         1169 return -(($b - 1 - $a) / $b);
131             } else {
132 4     4   201 use integer;
  4         8  
  4         14  
133 443         11192 return $a / $b;
134             }
135             }
136             }
137              
138             # _fmod(A, B): A modulo B, flooring remainder
139             #
140             # B must be a positive Perl integer. A may be a Perl integer, Math::BigInt,
141             # or Math::BigRat. The result has the same type as A.
142              
143             sub _fmod($$) {
144 1339     1339   45168 my($a, $b) = @_;
145 1339 100       2731 if(ref($a) eq "Math::BigRat") {
146 153         479 return $a - $b * ($a / $b)->bfloor;
147             } else {
148 1186         5366 return $a % $b;
149             }
150             }
151              
152             =head1 FUNCTIONS
153              
154             Numbers in this API may be native Perl integers, C objects,
155             or integer-valued C objects. All three types are acceptable
156             for all parameters, in any combination. In all conversion functions,
157             the most-significant part of the result (which is the only part with
158             unlimited range) is of the same type as the most-significant part of
159             the input. Less-significant parts of results (which have a small range)
160             are consistently native Perl integers.
161              
162             All functions C if given invalid parameters.
163              
164             =head2 Years
165              
166             =over
167              
168             =item present_y(YEAR)
169              
170             Puts the given year number into ISO 8601 textual presentation format.
171             For years [0, 9999] this is simply four digits. For years outside that
172             range it is a sign followed by at least four digits.
173              
174             This is the minimum-length presentation format. If it is desired to
175             use a form that is longer than necessary, such as to use at least five
176             digits for all year numbers (as the Long Now Foundation does), then the
177             right tool is C (see L).
178              
179             This format is unconditionally conformant to all versions of ISO 8601
180             for years [1583, 9999]. For years [0, 1582], preceding the historical
181             introduction of the Gregorian calendar, it is conformant only where
182             it is mutually agreed that such dates (represented in the proleptic
183             Gregorian calendar) are acceptable. For years outside the range [0,
184             9999], where the expanded format must be used, the result is only
185             conformant to ISO 8601:2004 (earlier versions lacked these formats),
186             and only where it is mutually agreed to use this format.
187              
188             =cut
189              
190             sub present_y($) {
191 63     63 1 183265 my($y) = @_;
192 63         312 my($sign, $digits) = ("$y" =~ /\A\+?(-?)0*([0-9]+?)\z/);
193 63 100       1272 $digits = ("0" x (4 - length($digits))).$digits
194             unless length($digits) >= 4;
195 63 100 100     6866 $sign = "+" if $sign eq "" && length($digits) > 4;
196 63         370 return $sign.$digits;
197             }
198              
199             =back
200              
201             =head2 Gregorian calendar
202              
203             Each year is divided into twelve months, numbered [1, 12]; month number
204             1 is January. Each month is divided into days, numbered sequentially
205             from 1. The month lengths are irregular. The year numbers have
206             unlimited range.
207              
208             =over
209              
210             =item month_days(YEAR, MONTH)
211              
212             The parameters identify a month, and the function returns the number of
213             days in that month as a native Perl integer.
214              
215             =cut
216              
217             sub _year_leap($) {
218 627     627   937 my($y) = @_;
219 627   66     1049 return _fmod($y, 4) == 0 &&
220             (_fmod($y, 100) != 0 || _fmod($y, 400) == 0);
221             }
222              
223             {
224             my @month_length = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
225             sub month_days($$) {
226 57     57 1 132001 my($y, $m) = @_;
227 57 50 33     275 croak "month number $m is out of the range [1, 12]"
228             unless $m >= 1 && $m <= 12;
229 57 100       110 if($m == 2) {
230 24 100       43 return _year_leap($y) ? 29 : 28;
231             } else {
232 33         105 return $month_length[$m - 1];
233             }
234             }
235             }
236              
237             {
238             my @nonleap_monthstarts =
239             (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365);
240             my @leap_monthstarts =
241             (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366);
242             sub _year_monthstarts($) {
243 72     72   91 my($y) = @_;
244 72 100       118 return _year_leap($y) ?
245             \@leap_monthstarts : \@nonleap_monthstarts;
246             }
247             }
248              
249             =item cjdn_to_ymd(CJDN)
250              
251             This function takes a Chronological Julian Day Number and returns a list
252             of a year, month, and day.
253              
254             =cut
255              
256             sub cjdn_to_yd($);
257              
258             sub cjdn_to_ymd($) {
259 35     35 1 27733 my($cjdn) = @_;
260 35         82 my($y, $d) = cjdn_to_yd($cjdn);
261 35         8374 my $monthstarts = _year_monthstarts($y);
262 35         12185 my $m = 1;
263 35         90 while($d > $monthstarts->[$m]) {
264 154         290 $m++;
265             }
266 35         157 return ($y, $m, $d - $monthstarts->[$m - 1]);
267             }
268              
269             =item ymd_to_cjdn(YEAR, MONTH, DAY)
270              
271             This performs the reverse of the translation that C does.
272             It takes year, month, and day numbers, and returns the corresponding CJDN.
273              
274             =cut
275              
276             sub yd_to_cjdn($$);
277              
278             sub ymd_to_cjdn($$$) {
279 39     39 1 22867 my($y, $m, $d) = @_;
280 39 100 100     558 croak "month number $m is out of the range [1, 12]"
281             unless $m >= 1 && $m <= 12;
282 37         73 $m = _numify($m);
283 37         70 my $monthstarts = _year_monthstarts($y);
284 37         11628 my $md = $monthstarts->[$m] - $monthstarts->[$m - 1];
285 37 100 100     716 croak "day number $d is out of the range [1, $md]"
286             unless $d >= 1 && $d <= $md;
287 33         50 $d = _numify($d);
288 33         90 return yd_to_cjdn($y, $monthstarts->[$m - 1] + $d);
289             }
290              
291             =item present_ymd(CJDN)
292              
293             =item present_ymd(YEAR, MONTH, DAY)
294              
295             Puts the given date into ISO 8601 Gregorian textual presentation format.
296             The `extended' format (with "-" separators) is used. The conformance
297             notes for C apply to this function also.
298              
299             If the date is given as a (YEAR, MONTH, DAY) triplet then these are not
300             checked for consistency. The MONTH and DAY values are only checked to
301             ensure that they fit into the fixed number of digits. This allows the
302             use of this function on data other than actual Gregorian dates.
303              
304             =cut
305              
306             sub present_ymd($;$$) {
307 11     11 1 1771 my($y, $m, $d);
308 11 100       22 if(@_ == 1) {
309 2         6 ($y, $m, $d) = cjdn_to_ymd($_[0]);
310             } else {
311 9         11 ($y, $m, $d) = @_;
312 9 100 100     354 croak "month number $m is out of the displayable range"
313             unless $m >= 0 && $m < 100;
314 7 100 100     230 croak "day number $d is out of the displayable range"
315             unless $d >= 0 && $d < 100;
316             }
317 7         15 return sprintf("%s-%02d-%02d", present_y($y),
318             _numify($m), _numify($d));
319             }
320              
321             =back
322              
323             =head2 Ordinal dates
324              
325             Each year is divided into days, numbered sequentially from 1. The year
326             lengths are irregular. The years correspond exactly to those of the
327             Gregorian calendar.
328              
329             =over
330              
331             =item year_days(YEAR)
332              
333             The parameter identifies a year, and the function returns the number of
334             days in that year as a native Perl integer.
335              
336             =cut
337              
338             sub year_days($) {
339 513     513 1 115087 my($y) = @_;
340 513 100       1139 return _year_leap($y) ? 366 : 365;
341             }
342              
343 4     4   4524 use constant GREGORIAN_ZERO_CJDN => 1721060; # 0000-001
  4         18  
  4         522  
344              
345             =item cjdn_to_yd(CJDN)
346              
347             This function takes a Chronological Julian Day Number and returns a
348             list of a year and ordinal day.
349              
350             =cut
351              
352             sub cjdn_to_yd($) {
353 129     129 1 32329 my($cjdn) = @_;
354 4     4   20 use integer;
  4         7  
  4         22  
355 129         412 my $d = $cjdn - GREGORIAN_ZERO_CJDN;
356 129         31392 my $qcents = _fdiv($d, 365*400 + 97);
357 129         33325 $d = _numify($d - $qcents * (365*400 + 97));
358 129         2008 my $y = $d / 366;
359 129         221 my $leaps = ($y + 3) / 4;
360 129 100       393 $leaps -= ($leaps - 1) / 25 unless $leaps == 0;
361 129         388 $d -= 365 * $y + $leaps;
362 129         253 my $yd = year_days($y);
363 129 100       394 if($d >= $yd) {
364 49         69 $d -= $yd;
365 49         117 $y++;
366             }
367 129         342 return ($qcents*400 + $y, 1 + $d);
368             }
369              
370             =item yd_to_cjdn(YEAR, DAY)
371              
372             This performs the reverse of the translation that C does.
373             It takes year and ordinal day numbers, and returns the corresponding CJDN.
374              
375             =cut
376              
377             sub yd_to_cjdn($$) {
378 360     360 1 33603 my($y, $d) = @_;
379 4     4   1438 use integer;
  4         6  
  4         13  
380 360         635 my $qcents = _fdiv($y, 400);
381 360         28727 $y = _numify($y - $qcents * 400);
382 360         2380 my $yd = year_days($y);
383 360 100 100     2464 croak "day number $d is out of the range [1, $yd]"
384             unless $d >= 1 && $d <= $yd;
385 357         804 $d = _numify($d);
386 357         640 my $leaps = ($y + 3) / 4;
387 357 100       794 $leaps -= ($leaps - 1) / 25 unless $leaps == 0;
388 357         1204 return (GREGORIAN_ZERO_CJDN + 365*$y + $leaps + ($d - 1)) +
389             $qcents * (365*400 + 97);
390             }
391              
392             =item present_yd(CJDN)
393              
394             =item present_yd(YEAR, DAY)
395              
396             Puts the given date into ISO 8601 ordinal textual presentation format.
397             The `extended' format (with "-" separators) is used. The conformance
398             notes for C apply to this function also.
399              
400             If the date is given as a (YEAR, DAY) pair then these are not checked
401             for consistency. The DAY value is only checked to ensure that it fits
402             into the fixed number of digits. This allows the use of this function
403             on data other than actual ordinal dates.
404              
405             =cut
406              
407             sub present_yd($;$) {
408 9     9 1 3061 my($y, $d);
409 9 100       29 if(@_ == 1) {
410 2         7 ($y, $d) = cjdn_to_yd($_[0]);
411             } else {
412 7         17 ($y, $d) = @_;
413 7 100 100     463 croak "day number $d is out of the displayable range"
414             unless $d >= 0 && $d < 1000;
415             }
416 7         19 return sprintf("%s-%03d", present_y($y), _numify($d));
417             }
418              
419             =back
420              
421             =head2 Week-based calendar
422              
423             Each year is divided into weeks, numbered sequentially from 1. Each week
424             is divided into seven days, numbered [1, 7]; day number 1 is Monday.
425             The year lengths are irregular. The year numbers have unlimited range.
426              
427             The years correspond to those of the Gregorian calendar. Each week is
428             associated with the Gregorian year that contains its Thursday and hence
429             contains the majority of its days.
430              
431             =over
432              
433             =item year_weeks(YEAR)
434              
435             The parameter identifies a year, and the function returns the number of
436             weeks in that year as a native Perl integer.
437              
438             =cut
439              
440             # _year_phase(YEAR): find day of week of first day of year
441             #
442             # The argument must be a native Perl integer. The return value is
443             # zero-based, in the range 0 = Monday to 6 = Sunday.
444              
445             sub _year_phase($) {
446 234     234   317 my($y) = @_;
447 234         481 return yd_to_cjdn($y, 1) % 7;
448             }
449              
450             sub year_weeks($) {
451 169     169 1 123293 my($y) = @_;
452 169         332 $y = _numify(_fmod($y, 400));
453 169         1669 my $phase = _year_phase($y);
454 169 100 66     816 return $phase == 3 || ($phase == 2 && _year_leap($y)) ? 53 : 52;
455             }
456              
457             =item cjdn_to_ywd(CJDN)
458              
459             This function takes a Chronological Julian Day Number and returns a list
460             of a year, week, and day.
461              
462             =cut
463              
464             sub cjdn_to_ywd($) {
465 65     65 1 86266 my($cjdn) = @_;
466 65         195 my($y, $d) = cjdn_to_yd($cjdn);
467 65         15549 my $py = _numify(_fmod($y, 400));
468 65         2694 my $phase = _year_phase($py);
469 65 100       175 my $start_wk1 = ($phase <= 3 ? 1 : 8) - $phase;
470 65         146 my $w = _fdiv($d - $start_wk1, 7);
471 65 100       188 if($w == -1) {
    100          
472 15         49 $y--;
473 15         836 $w = year_weeks($py - 1);
474             } elsif($w >= year_weeks($py)) {
475 3         11 $y++;
476 3         145 $w = 1;
477             } else {
478 47         67 $w++;
479             }
480 65         337 return ($y, $w, ($d - $start_wk1) % 7 + 1);
481             }
482              
483             =item ywd_to_cjdn(YEAR, WEEK, DAY)
484              
485             This performs the reverse of the translation that C does.
486             It takes year, week, and day numbers, and returns the corresponding CJDN.
487              
488             =cut
489              
490             sub ywd_to_cjdn($$$) {
491 68     68 1 74339 my($y, $w, $d) = @_;
492 68         163 my $yw = year_weeks($y);
493 68 100 100     860 croak "week number $w is out of the range [1, $yw]"
494             unless $w >= 1 && $w <= $yw;
495 65 100 100     543 croak "day number $d is out of the range [1, 7]"
496             unless $d >= 1 && $d <= 7;
497 63         113 my $start_cjdn = yd_to_cjdn($y, 1);
498 63         16593 my $phase = _fmod($start_cjdn, 7);
499 63 100       17541 return $start_cjdn +
500             (($phase <= 3 ? -8 : -1) - $phase +
501             _numify($w)*7 + _numify($d));
502             }
503              
504             =item present_ywd(CJDN)
505              
506             =item present_ywd(YEAR, WEEK, DAY)
507              
508             Puts the given date into ISO 8601 week-based textual presentation format.
509             The `extended' format (with "-" separators) is used. The conformance
510             notes for C apply to this function also.
511              
512             If the date is given as a (YEAR, WEEK, DAY) triplet then these are not
513             checked for consistency. The WEEK and DAY values are only checked to
514             ensure that they fit into the fixed number of digits. This allows the
515             use of this function on data other than actual week-based dates.
516              
517             =cut
518              
519             sub present_ywd($;$$) {
520 11     11 1 3184 my($y, $w, $d);
521 11 100       26 if(@_ == 1) {
522 2         7 ($y, $w, $d) = cjdn_to_ywd($_[0]);
523             } else {
524 9         16 ($y, $w, $d) = @_;
525 9 100 100     412 croak "week number $w is out of the displayable range"
526             unless $w >= 0 && $w < 100;
527 7 100 100     316 croak "day number $d is out of the displayable range"
528             unless $d >= 0 && $d < 10;
529             }
530 7         16 return sprintf("%s-W%02d-%d", present_y($y), _numify($w), _numify($d));
531             }
532              
533             =back
534              
535             =head1 SEE ALSO
536              
537             L,
538             L
539              
540             =head1 AUTHOR
541              
542             Andrew Main (Zefram)
543              
544             =head1 COPYRIGHT
545              
546             Copyright (C) 2006, 2007, 2009, 2011
547             Andrew Main (Zefram)
548              
549             =head1 LICENSE
550              
551             This module is free software; you can redistribute it and/or modify it
552             under the same terms as Perl itself.
553              
554             =cut
555              
556             1;