File Coverage

blib/lib/Date/ISO8601.pm
Criterion Covered Total %
statement 140 140 100.0
branch 63 64 98.4
condition 39 42 92.8
subroutine 29 29 100.0
pod 13 13 100.0
total 284 288 98.6


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