8
multi method is-leap-year($y = $!year) {
9
$y %% 4 and not $y %% 100 or $y %% 400
12
multi method days-in-month($year = $!year, $month = $!month) {
13
$month == 2 ?? self.is-leap-year($year) ?? 29 !! 28
14
!! $month == 4|6|9|11 ?? 30
18
method daycount-from-ymd($y is copy, $m is copy, $d) {
19
# taken from <http://www.merlyn.demon.co.uk/daycount.htm>
26
-678973 + $d + (153 * $m - 2) div 5
28
- $y div 100 + $y div 400;
31
method ymd-from-daycount($daycount) {
32
# taken from <http://www.merlyn.demon.co.uk/daycount.htm>
33
my $day = $daycount.Int + 678881;
34
my $t = (4 * ($day + 36525)) div 146097 - 1;
36
$day -= 36524 * $t + ($t +> 2);
37
$t = (4 * ($day + 366)) div 1461 - 1;
39
$day -= 365 * $t + ($t +> 2);
40
my $month = (5 * $day + 2) div 153;
41
$day -= (2 + $month * 153) div 5 - 1;
46
($year, $month + 3, $day)
49
multi method get-daycount {
50
self.daycount-from-ymd($.year, $.month, $.day)
53
method day-of-month() { $.day }
55
method day-of-week($daycount = self.get-daycount) {
56
($daycount + 2) % 7 + 1
59
multi method week() { # algorithm from Claus Tøndering
60
my $a = $.year - ($.month <= 2).floor;
61
my $b = $a div 4 - $a div 100 + $a div 400;
62
my $c = ($a - 1) div 4 - ($a - 1) div 100 + ($a - 1) div 400;
64
my $e = $.month <= 2 ?? 0 !! $s + 1;
65
my $f = $.day + do $.month <= 2
66
?? 31*($.month - 1) - 1
67
!! (153*($.month - 3) + 2) div 5 + 58 + $s;
69
my $g = ($a + $b) % 7;
70
my $d = ($f + $g - $e) % 7;
73
$n < 0 ?? ($.year - 1, 53 - ($g - $s) div 5)
74
!! $n > 364 + $s ?? ($.year + 1, 1)
75
!! ($.year, $n div 7 + 1);
78
multi method week-year() {
82
multi method week-number() {
86
multi method weekday-of-month {
90
multi method day-of-year() {
91
[+] $.day, map { self.days-in-month($.year, $^m) }, 1 ..^ $.month
94
method check-value($val is rw, $name, $range, :$allow-nonint) {
95
$val = $allow-nonint ?? +$val !! $val.Int;
97
or die "$name must be in {$range.perl}\n";
101
# Asserts the validity of and numifies $!year, $!month, and $!day.
103
self.check-value($!month, 'month', 1 .. 12);
104
self.check-value($!day, "day of $!year/$!month",
105
1 .. self.days-in-month);
108
method truncate-parts($unit, %parts is copy = ()) {
109
# Helper for DateTime.truncated-to and Date.truncated-to.
111
my $dc = self.get-daycount;
112
my $new-dc = $dc - self.day-of-week($dc) + 1;
113
%parts<year month day> =
114
self.ymd-from-daycount($new-dc);
115
} else { # $unit eq 'month'|'year'
117
$unit eq 'year' and %parts<month> = 1;
124
sub default-formatter(::DateTime $dt, Bool :$subseconds) {
125
# ISO 8601 timestamp (well, not strictly ISO 8601 if $subseconds
129
or warn "Default DateTime formatter: offset $o not divisible by 60.\n";
130
sprintf '%04d-%02d-%02dT%02d:%02d:%s%s',
131
$dt.year, $dt.month, $dt.day, $dt.hour, $dt.minute,
133
?? $dt.second.fmt('%09.6f')
134
!! $dt.whole-second.fmt('%02d'),
136
?? sprintf '%s%02d%02d',
137
$o < 0 ?? '-' !! '+',
138
($o.abs / 60 / 60).floor,
139
($o.abs / 60 % 60).floor
143
class DateTime-local-timezone does Callable {
144
method Str { '<local time zone>' }
145
method perl { '$*TZ' }
147
method postcircumfix:<( )>($args) { self.offset(|$args) }
149
method offset($dt, $to-utc) {
150
# We construct local and UTC DateTimes, calculate POSIX times
151
# (pretending the local DateTime is actually in UTC), and
152
# return the difference. Surprisingly, this actually works!
156
# Create an array for encodelocaltime.
157
a = new 'FixedIntegerArray'
159
$P0 = dt.'whole-second'()
161
$P0 = getattribute dt, '$!minute'
163
$P0 = getattribute dt, '$!hour'
165
$P0 = getattribute dt, '$!day'
167
$P0 = getattribute dt, '$!month'
169
$P0 = getattribute dt, '$!year'
172
# Indefinite Daylight-Saving state. This leaves it up
173
# to whatever C library we're using to decide how to
174
# interpret an ambiguous time.
175
# Use encodelocaltime to get a POSIX time, and
176
# subtract this from $dt's POSIX time.
177
$I0 = encodelocaltime a
179
$P0 = $P0.'posix'(true)
186
my ($year, $month, $day, $hour, $minute, $second);
187
# Use decodelocaltime to build a local DateTime.
192
a = decodelocaltime $I0
193
$P0 = find_lex '$second'
195
'&infix:<=>'($P0, $I0)
196
$P0 = find_lex '$minute'
198
'&infix:<=>'($P0, $I0)
199
$P0 = find_lex '$hour'
201
'&infix:<=>'($P0, $I0)
202
$P0 = find_lex '$day'
204
'&infix:<=>'($P0, $I0)
205
$P0 = find_lex '$month'
207
'&infix:<=>'($P0, $I0)
208
$P0 = find_lex '$year'
210
'&infix:<=>'($P0, $I0)
213
.new(:$year, :$month, :$day, :$hour, :$minute, :$second)\
219
class DateTime does Dateish {
221
has Int $.minute = 0;
223
has $.timezone = 0; # UTC
224
has &.formatter; # = &default-formatter; # Doesn't work (not in scope?).
225
has Int $!saved-offset;
226
# Not an optimization but a necessity to ensure that
227
# $dt.utc.local.utc is equivalent to $dt.utc. Otherwise,
228
# DST-induced ambiguity could ruin our day.
230
multi method new(Int :$year!, :&formatter=&default-formatter, *%_) {
231
my $dt = self.bless(*, :$year, :&formatter, |%_);
238
# Asserts the validity of and numifies $!hour, $!minute, and $!second.
239
self.check-value($!hour, 'hour', 0 ..^ 24);
240
self.check-value($!minute, 'minute', 0 ..^ 60);
241
self.check-value($!second, 'second', 0 ..^ 62, :allow-nonint);
243
# Ensure this is an actual leap second.
245
or die 'No second 61 has yet been defined';
247
$dt.hour == 23 && $dt.minute == 59
248
or die 'A leap second can occur only at hour 23 and minute 59 UTC';
249
my $date = sprintf '%04d-%02d-%02d',
250
$dt.year, $dt.month, $dt.day;
251
$date eq any(tai-utc::leap-second-dates)
252
or die "There is no leap second on UTC $date";
256
multi method new(::Date :$date!, *%_) {
257
self.new(year => $date.year, month => $date.month,
258
day => $date.day, |%_)
261
multi method new(Instant $i, :$timezone=0, :&formatter=&default-formatter) {
262
my ($p, $leap-second) = $i.to-posix;
263
my $dt = self.new: floor($p - $leap-second), :&formatter;
264
$dt.clone(second => $dt.second + $p % 1 + $leap-second
265
).in-timezone($timezone);
268
multi method new(Int $time is copy, :$timezone=0, :&formatter=&default-formatter) {
269
# Interpret $time as a POSIX time.
270
my $second = $time % 60; $time = $time div 60;
271
my $minute = $time % 60; $time = $time div 60;
272
my $hour = $time % 24; $time = $time div 24;
273
# Day month and leap year arithmetic, based on Gregorian day #.
274
# 2000-01-01 noon UTC == 2451558.0 Julian == 2451545.0 Gregorian
275
$time += 2440588; # because 2000-01-01 == Unix epoch day 10957
276
my $a = $time + 32044; # date algorithm from Claus Tøndering
277
my $b = (4 * $a + 3) div 146097; # 146097 = days in 400 years
278
my $c = $a - (146097 * $b) div 4;
279
my $d = (4 * $c + 3) div 1461; # 1461 = days in 4 years
280
my $e = $c - ($d * 1461) div 4;
281
my $m = (5 * $e + 2) div 153; # 153 = days in Mar-Jul Aug-Dec
282
my $day = $e - (153 * $m + 2) div 5 + 1;
283
my $month = $m + 3 - 12 * ($m div 10);
284
my $year = $b * 100 + $d - 4800 + $m div 10;
285
self.bless(*, :$year, :$month, :$day,
286
:$hour, :$minute, :$second,
287
:&formatter).in-timezone($timezone);
290
multi method new(Str $format, :$timezone is copy = 0, :&formatter=&default-formatter) {
291
$format ~~ /^ (\d**4) '-' (\d\d) '-' (\d\d) T (\d\d) ':' (\d\d) ':' (\d\d) (Z || (<[\-\+]>) (\d\d)(\d\d))? $/
292
or die 'Invalid DateTime string; please an ISO 8601 timestamp';
293
my $year = (+$0).Int;
294
my $month = (+$1).Int;
296
my $hour = (+$3).Int;
297
my $minute = (+$4).Int;
301
and die "DateTime.new(Str): :timezone argument not allowed with a timestamp offset";
305
$timezone = (($6[0][1]*60 + $6[0][2]) * 60).Int;
306
# RAKUDO: .Int is needed to avoid to avoid the nasty '-0'.
307
$6[0][0] eq '-' and $timezone = -$timezone;
310
self.new(:$year, :$month, :$day, :$hour, :$minute,
311
:$second, :$timezone, :&formatter);
314
multi method now(:$timezone=$*TZ, :&formatter=&default-formatter) {
315
self.new(now, :$timezone, :&formatter)
318
multi method clone(*%_) {
319
self.new(:$!year, :$!month, :$!day,
320
:$!hour, :$!minute, :$!second,
321
timezone => $!timezone,
322
formatter => &!formatter,
326
multi method clone-without-validating(*%_) { # A premature optimization.
327
self.bless(*, :$!year, :$!month, :$!day,
328
:$!hour, :$!minute, :$!second,
329
timezone => $!timezone,
330
formatter => &!formatter,
334
multi method Instant() {
335
Instant.from-posix: self.posix + $.second % 1, $.second >= 60;
338
multi method posix($ignore-timezone?) {
339
$ignore-timezone or self.offset == 0
340
or return self.utc.posix;
341
# algorithm from Claus Tøndering
342
my $a = (14 - $.month.Int) div 12;
343
my $y = $.year.Int + 4800 - $a;
344
my $m = $.month.Int + 12 * $a - 3;
345
my $jd = $.day + (153 * $m + 2) div 5 + 365 * $y
346
+ $y div 4 - $y div 100 + $y div 400 - 32045;
347
($jd - 2440588) * 24 * 60 * 60
348
+ 60*(60*$.hour + $.minute) + self.whole-second;
353
$!timezone ~~ Callable
354
?? $!timezone(self, True)
358
multi method truncated-to(*%args) {
360
or die 'DateTime.truncated-to: exactly one named argument needed';
361
my $unit = %args.keys[0];
362
$unit eq any(<second minute hour day week month year>)
363
or die "DateTime.truncated-to: Unknown truncation unit '$unit'";
366
%parts<second> = self.whole-second;
374
# Fall through to Dateish.
375
%parts = self.truncate-parts($unit, %parts);
377
self.clone-without-validating(|%parts);
380
multi method whole-second() {
384
method in-timezone($timezone) {
385
$timezone eqv $!timezone and return self;
386
my $old-offset = self.offset;
387
my $new-offset = $timezone ~~ Callable
388
?? $timezone(self.utc, False)
391
# Is the logic for handling leap seconds right?
392
# I don't know, but it passes the tests!
393
my $a = ($!second >= 60 ?? 59 !! $!second)
394
+ $new-offset - $old-offset;
395
%parts<second> = $!second >= 60 ?? $!second !! $a % 60;
396
my $b = $!minute + floor $a / 60;
397
%parts<minute> = $b % 60;
398
my $c = $!hour + floor $b / 60;
399
%parts<hour> = $c % 24;
400
# Let Dateish handle any further rollover.
401
floor $c / 24 and %parts<year month day> =
402
self.ymd-from-daycount\
403
(self.get-daycount + floor $c / 24);
404
self.clone-without-validating:
405
:$timezone, saved-offset => $new-offset, |%parts;
412
self.in-timezone($*TZ)
423
multi method perl() {
424
sprintf 'DateTime.new(%s)', join ', ', map { "{.key} => {.value}" }, do
425
:$.year, :$.month, :$.day, :$.hour, :$.minute,
426
second => $.second.perl,
427
(timezone => $.timezone.perl
428
unless $.timezone === 0),
430
if $!saved-offset and $.timezone ~~ Callable),
431
(formatter => $.formatter.perl
432
unless &.formatter eqv &default-formatter)
437
class Date does Dateish {
440
method !set-daycount($dc) { $!daycount = $dc }
442
multi method get-daycount { $!daycount }
444
multi method new(:$year!, :$month, :$day) {
445
my $d = self.bless(*, :$year, :$month, :$day);
447
$d!set-daycount(self.daycount-from-ymd($year,$month,$day));
451
multi method new($year, $month, $day) {
452
self.new(:$year, :$month, :$day);
455
multi method new(Str $date) {
456
$date ~~ /^ \d\d\d\d '-' \d\d '-' \d\d $/
457
or die 'Invalid Date string; please use the format "yyyy-mm-dd"';
458
self.new(|$date.split('-').map(*.Int));
461
multi method new(::DateTime $dt) {
463
:year($dt.year), :month($dt.month), :day($dt.day),
464
:daycount(self.daycount-from-ymd($dt.year,$dt.month,$dt.day))
468
multi method new-from-daycount($daycount) {
469
my ($year, $month, $day) = self.ymd-from-daycount($daycount);
470
self.bless(*, :$daycount, :$year, :$month, :$day);
473
multi method today() {
474
self.new(::DateTime.now);
477
multi method truncated-to(*%args) {
479
or die "Date.truncated-to: exactly one named argument needed.";
480
my $unit = %args.keys[0];
481
$unit eq any(<week month year>)
482
or die "DateTime.truncated-to: Unknown truncation unit '$unit'";
483
self.clone(|self.truncate-parts($unit));
486
multi method clone(*%_) {
487
self.new(:$!year, :$!month, :$!day, |%_)
490
multi method succ() {
491
Date.new-from-daycount($!daycount + 1);
493
multi method pred() {
494
Date.new-from-daycount($!daycount - 1);
498
sprintf '%04d-%02d-%02d', $.year, $.month, $.day;
501
multi method perl() {
502
"Date.new($.year.perl(), $.month.perl(), $.day.perl())";
507
multi infix:<+>(Date $d, Int $x) is export {
508
Date.new-from-daycount($d.daycount + $x)
510
multi infix:<+>(Int $x, Date $d) is export {
511
Date.new-from-daycount($d.daycount + $x)
513
multi infix:<->(Date $d, Int $x) is export {
514
Date.new-from-daycount($d.daycount - $x)
516
multi infix:<->(Date $a, Date $b) is export {
517
$a.daycount - $b.daycount;
519
multi infix:<cmp>(Date $a, Date $b) is export {
520
$a.daycount cmp $b.daycount
522
multi infix:«<=>»(Date $a, Date $b) is export {
523
$a.daycount <=> $b.daycount
525
multi infix:<==>(Date $a, Date $b) is export {
526
$a.daycount == $b.daycount
528
multi infix:<!=>(Date $a, Date $b) is export {
529
$a.daycount != $b.daycount
531
multi infix:«<=»(Date $a, Date $b) is export {
532
$a.daycount <= $b.daycount
534
multi infix:«<»(Date $a, Date $b) is export {
535
$a.daycount < $b.daycount
537
multi infix:«>=»(Date $a, Date $b) is export {
538
$a.daycount >= $b.daycount
540
multi infix:«>»(Date $a, Date $b) is export {
541
$a.daycount > $b.daycount
547
Perl 6 spec <S32-Temporal|http://perlcabal.org/syn/S32/Temporal.html>.
548
The Perl 5 DateTime Project home page L<http://datetime.perl.org>.
549
Perl 5 perldoc L<doc:DateTime> and L<doc:Time::Local>.
551
The best yet seen explanation of calendars, by Claus Tøndering
552
L<Calendar FAQ|http://www.tondering.dk/claus/calendar.html>.
553
Similar algorithms at L<http://www.hermetic.ch/cal_stud/jdn.htm>
554
and L<http://www.merlyn.demon.co.uk/daycount.htm>.
556
<ISO 8601|http://en.wikipedia.org/wiki/ISO_8601>
557
<Time zones|http://en.wikipedia.org/wiki/List_of_time_zones>
559
As per the recommendation, the strftime() method has bee moved into a
560
loadable module called DateTime::strftime.
added
removed
src/core/Temporal.pm
