Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 581 lines (516 sloc) 19.423 kb
cc75bfd Jonathan Worthington Twiddle whitespace around stub syntax; there's actually a bug lingering ...
jnthn authored
1 my class DateTime { ... }
2 my class Date { ... }
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
3
4 my role Dateish {
5 method is-leap-year($y = $.year) {
6 $y %% 4 and not $y %% 100 or $y %% 400
7 }
8
9 method days-in-month($year = $.year, $month = $.month) {
10 $month == 2 ?? self.is-leap-year($year) ?? 29 !! 28
11 !! $month == 4|6|9|11 ?? 30
12 !! 31
13 }
14
15 method daycount-from-ymd($y is copy, $m is copy, $d) {
16 # taken from <http://www.merlyn.demon.co.uk/daycount.htm>
17 $y .= Int;
18 $m .= Int;
19 if $m < 3 {
20 $m += 12;
21 --$y;
22 }
23 -678973 + $d + (153 * $m - 2) div 5
24 + 365 * $y + $y div 4
25 - $y div 100 + $y div 400;
26 }
27
28 method ymd-from-daycount($daycount) {
29 # taken from <http://www.merlyn.demon.co.uk/daycount.htm>
5dbca1f Jonathan Worthington Use native types in ymd-from-daycount, shaving ~7% off masak++'s example...
jnthn authored
30 my int $day = $daycount.Int + 678881;
31 my int $t = (4 * ($day + 36525)) div 146097 - 1;
32 my int $year = 100 * $t;
33 $day = $day - (36524 * $t + ($t +> 2));
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
34 $t = (4 * ($day + 366)) div 1461 - 1;
5dbca1f Jonathan Worthington Use native types in ymd-from-daycount, shaving ~7% off masak++'s example...
jnthn authored
35 $year = $year + $t;
36 $day = $day - (365 * $t + ($t +> 2));
37 my int $month = (5 * $day + 2) div 153;
38 $day = $day - ((2 + $month * 153) div 5 - 1);
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
39 if ($month > 9) {
5dbca1f Jonathan Worthington Use native types in ymd-from-daycount, shaving ~7% off masak++'s example...
jnthn authored
40 $month = $month - 12;
41 $year = $year + 1;
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
42 }
43 ($year, $month + 3, $day)
44 }
45
46 method get-daycount {
47 self.daycount-from-ymd($.year, $.month, $.day)
48 }
49
50 method day-of-month() { $.day }
51
52 method day-of-week($daycount = self.get-daycount) {
53 ($daycount + 2) % 7 + 1
54 }
55
56 method week() { # algorithm from Claus Tøndering
a48a985 Tadeusz Sośnierz More Temporal fixes
tadzik authored
57 my $a = $.year - ($.month <= 2).floor.Int;
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
58 my $b = $a div 4 - $a div 100 + $a div 400;
59 my $c = ($a - 1) div 4 - ($a - 1) div 100 + ($a - 1) div 400;
60 my $s = $b - $c;
61 my $e = $.month <= 2 ?? 0 !! $s + 1;
62 my $f = $.day + do $.month <= 2
63 ?? 31*($.month - 1) - 1
64 !! (153*($.month - 3) + 2) div 5 + 58 + $s;
65
66 my $g = ($a + $b) % 7;
67 my $d = ($f + $g - $e) % 7;
68 my $n = $f + 3 - $d;
69
70 $n < 0 ?? ($.year - 1, 53 - ($g - $s) div 5)
71 !! $n > 364 + $s ?? ($.year + 1, 1)
72 !! ($.year, $n div 7 + 1);
73 }
74
75 method week-year() {
76 self.week.[0]
77 }
78
79 method week-number() {
80 self.week.[1]
81 }
82
83 method weekday-of-month {
84 ($.day - 1) div 7 + 1
85 }
86
b952372 Tadeusz Sośnierz Uncomment Date.day-of-year. We now pass S32-temporal/calendar.t; track f...
tadzik authored
87 method day-of-year() {
88 [+] $.day, map { self.days-in-month($.year, $^m) }, 1 ..^ $.month
89 }
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
90
6fde31d Moritz Lenz two tiny Date fixes
moritz authored
91 method check-value($val is copy, $name, $range, :$allow-nonint) {
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
92 $val = $allow-nonint ?? +$val !! $val.Int;
12b860d Jonathan Worthington A doubled 'or' caught by work in the optimizer branch.
jnthn authored
93 $val ~~ $range
5c9c02d Moritz Lenz stylistic changes to throwing exceptions
moritz authored
94 or X::OutOfRange.new(
4b4f5ef Moritz Lenz throw X::OutOfRange exception from Date and DateTime constructors
moritz authored
95 what => $name,
96 got => $val,
c295b53 Moritz Lenz include actual Range object in X::OutOfRange error from Date.new
moritz authored
97 range => $range,
5c9c02d Moritz Lenz stylistic changes to throwing exceptions
moritz authored
98 ).throw;
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
99 }
100
101 method check-date {
102 self.check-value($.month, 'month', 1 .. 12);
103 self.check-value($.day, "day of $.year/$.month",
104 1 .. self.days-in-month);
105 }
106
3515e47 Moritz Lenz fix Dateish.truncate-parts signature; simplify eqv
moritz authored
107 method truncate-parts($unit, %parts? is copy) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
108 # Helper for DateTime.truncated-to and Date.truncated-to.
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
109 if $unit eq 'week' {
110 my $dc = self.get-daycount;
111 my $new-dc = $dc - self.day-of-week($dc) + 1;
112 %parts<year month day> =
113 self.ymd-from-daycount($new-dc);
114 } else { # $unit eq 'month'|'year'
115 %parts<day> = 1;
116 $unit eq 'year' and %parts<month> = 1;
117 }
118 %parts;
119 }
120
121 }
122
123 sub default-formatter(DateTime $dt, Bool :$subseconds) {
124 # ISO 8601 timestamp (well, not strictly ISO 8601 if $subseconds
125 # is true)
126 my $o = $dt.offset;
127 $o %% 60
128 or warn "Default DateTime formatter: offset $o not divisible by 60.\n";
129 sprintf '%04d-%02d-%02dT%02d:%02d:%s%s',
130 $dt.year, $dt.month, $dt.day, $dt.hour, $dt.minute,
131 $subseconds
132 ?? $dt.second.fmt('%09.6f')
133 !! $dt.whole-second.fmt('%02d'),
134 do $o
135 ?? sprintf '%s%02d%02d',
136 $o < 0 ?? '-' !! '+',
137 ($o.abs / 60 / 60).floor,
138 ($o.abs / 60 % 60).floor
139 !! 'Z';
140 }
141
142 my class DateTime-local-timezone does Callable {
f982930 Moritz Lenz add missing invocant markers
moritz authored
143 multi method Str(DateTime-local-timezone:D:) { '<local time zone>' }
144 multi method perl(DateTime-local-timezone:D:) { '$*TZ' }
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
145
146 method postcircumfix:<( )>($args) { self.offset(|$args) }
147
148 method offset(DateTime:D $dt, $to-utc) {
149 # We construct local and UTC DateTimes, calculate POSIX times
150 # (pretending the local DateTime is actually in UTC), and
151 # return the difference. Surprisingly, this actually works!
152 if $to-utc {
153 my Mu $fia := pir::new__PS('FixedIntegerArray');
ab30d74 Moritz Lenz [Temporal] initialize length of FixedIntegerArray
moritz authored
154 pir::set__vPI($fia, 9);
a48a985 Tadeusz Sośnierz More Temporal fixes
tadzik authored
155 nqp::bindpos($fia, 0, nqp::unbox_i($dt.whole-second));
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
156 nqp::bindpos($fia, 1, nqp::unbox_i($dt.minute));
157 nqp::bindpos($fia, 2, nqp::unbox_i($dt.hour));
158 nqp::bindpos($fia, 3, nqp::unbox_i($dt.day));
159 nqp::bindpos($fia, 4, nqp::unbox_i($dt.month));
160 nqp::bindpos($fia, 5, nqp::unbox_i($dt.year));
161 nqp::bindpos($fia, 8, -1);
162 nqp::p6box_i(pir::encodelocaltime__IP($fia)) - $dt.posix(True);
163 } else {
164 my $p = $dt.posix;
165 my ($year, $month, $day, $hour, $minute, $second);
eb855f3 Tadeusz Sośnierz Fix DateTime.now
tadzik authored
166 my Mu $fia := pir::decodelocaltime__PI(nqp::unbox_i($p.Int));
167 $second = nqp::p6box_i(nqp::atpos($fia, 0));
168 $minute = nqp::p6box_i(nqp::atpos($fia, 1));
169 $hour = nqp::p6box_i(nqp::atpos($fia, 2));
170 $day = nqp::p6box_i(nqp::atpos($fia, 3));
171 $month = nqp::p6box_i(nqp::atpos($fia, 4));
172 $year = nqp::p6box_i(nqp::atpos($fia, 5));
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
173 DateTime\
174 .new(:$year, :$month, :$day, :$hour, :$minute, :$second)\
175 .posix - $p;
176 }
177 }
178 }
179
180 my class DateTime does Dateish {
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
181 has Int $.year;
182 has Int $.month = 1;
183 has Int $.day = 1;
184
185 has Int $.hour = 0;
186 has Int $.minute = 0;
187 has $.second = 0.0;
188 has $.timezone = 0; # UTC
189 has &.formatter = &default-formatter;
190 has Int $!saved-offset;
191 # Not an optimization but a necessity to ensure that
192 # $dt.utc.local.utc is equivalent to $dt.utc. Otherwise,
193 # DST-induced ambiguity could ruin our day.
194
195 multi method new(Int :$year!, :&formatter=&default-formatter, *%_) {
196 my $dt = self.bless(*, :$year, :&formatter, |%_);
197 $dt.check-date;
198 $dt.check-time;
199 $dt;
200 }
201
202 method check-time {
203 # Asserts the validity of and numifies $!hour, $!minute, and $!second.
204 self.check-value($!hour, 'hour', 0 ..^ 24);
205 self.check-value($!minute, 'minute', 0 ..^ 60);
206 self.check-value($!second, 'second', 0 ..^ 62, :allow-nonint);
207 if $!second >= 60 {
208 # Ensure this is an actual leap second.
209 self.second < 61
729d90a Moritz Lenz typed exceptions for Temporal leap second checking
moritz authored
210 or X::OutOfRange.new(
211 what => 'second',
212 range => (0..^60),
213 got => self.second,
214 comment => 'No second 61 has yet been defined',
215 ).throw;
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
216 my $dt = self.utc;
217 $dt.hour == 23 && $dt.minute == 59
729d90a Moritz Lenz typed exceptions for Temporal leap second checking
moritz authored
218 or X::OutOfRange.new(
219 what => 'second',
220 range => (0..^60),
221 got => self.second,
222 comment => 'a leap second can occur only at hour 23 and minute 59 UTC',
223 ).throw;
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
224 my $date = sprintf '%04d-%02d-%02d',
225 $dt.year, $dt.month, $dt.day;
226 $date eq any(tai-utc::leap-second-dates)
729d90a Moritz Lenz typed exceptions for Temporal leap second checking
moritz authored
227 or X::OutOfRange.new(
228 what => 'second',
229 range => (0..^60),
230 got => self.second,
231 comment => "There is no leap second on UTC $date",
232 ).throw;
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
233 }
234 }
235
236 multi method new(Date :$date!, *%_) {
237 self.new(year => $date.year, month => $date.month,
238 day => $date.day, |%_)
239 }
240
241 multi method new(Instant $i, :$timezone=0, :&formatter=&default-formatter) {
242 my ($p, $leap-second) = $i.to-posix;
375fa0a Tadeusz Sośnierz Small Temporal tune, fixes Date.new(Instant)
tadzik authored
243 my $dt = self.new: floor($p - $leap-second).Int, :&formatter;
eb855f3 Tadeusz Sośnierz Fix DateTime.now
tadzik authored
244 $dt.clone(second => ($dt.second + $p % 1 + $leap-second)
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
245 ).in-timezone($timezone);
246 }
247
248 multi method new(Int $time is copy, :$timezone=0, :&formatter=&default-formatter) {
249 # Interpret $time as a POSIX time.
250 my $second = $time % 60; $time = $time div 60;
251 my $minute = $time % 60; $time = $time div 60;
252 my $hour = $time % 24; $time = $time div 24;
253 # Day month and leap year arithmetic, based on Gregorian day #.
254 # 2000-01-01 noon UTC == 2451558.0 Julian == 2451545.0 Gregorian
255 $time += 2440588; # because 2000-01-01 == Unix epoch day 10957
256 my $a = $time + 32044; # date algorithm from Claus Tøndering
257 my $b = (4 * $a + 3) div 146097; # 146097 = days in 400 years
258 my $c = $a - (146097 * $b) div 4;
259 my $d = (4 * $c + 3) div 1461; # 1461 = days in 4 years
260 my $e = $c - ($d * 1461) div 4;
261 my $m = (5 * $e + 2) div 153; # 153 = days in Mar-Jul Aug-Dec
262 my $day = $e - (153 * $m + 2) div 5 + 1;
263 my $month = $m + 3 - 12 * ($m div 10);
264 my $year = $b * 100 + $d - 4800 + $m div 10;
265 self.bless(*, :$year, :$month, :$day,
266 :$hour, :$minute, :$second,
267 :&formatter).in-timezone($timezone);
268 }
269
270 multi method new(Str $format, :$timezone is copy = 0, :&formatter=&default-formatter) {
271 $format ~~ /^ (\d**4) '-' (\d\d) '-' (\d\d) T (\d\d) ':' (\d\d) ':' (\d\d) (Z || (<[\-\+]>) (\d\d)(\d\d))? $/
d0b6640 Moritz Lenz X::Temporal::InvalidFormat
moritz authored
272 or X::Temporal::InvalidFormat.new(
273 invalid-str => $format,
274 target => 'DateTime',
275 format => 'an ISO 8601 timestamp (yyyy-mm-ddThh::mm::ssZ or yyyy-mm-ddThh::mm::ss+0100)',
276 ).throw;
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
277 my $year = (+$0).Int;
278 my $month = (+$1).Int;
279 my $day = (+$2).Int;
280 my $hour = (+$3).Int;
281 my $minute = (+$4).Int;
282 my $second = +$5;
283 if $6 {
284 $timezone
285 and die "DateTime.new(Str): :timezone argument not allowed with a timestamp offset";
286 if $6 eq 'Z' {
287 $timezone = 0;
288 } else {
289 $timezone = (($6[0][1]*60 + $6[0][2]) * 60).Int;
290 # RAKUDO: .Int is needed to avoid to avoid the nasty '-0'.
291 $6[0][0] eq '-' and $timezone = -$timezone;
292 }
293 }
294 self.new(:$year, :$month, :$day, :$hour, :$minute,
295 :$second, :$timezone, :&formatter);
296 }
297
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
298 method now(:$timezone=$*TZ, :&formatter=&default-formatter) {
299 self.new(now, :$timezone, :&formatter)
300 }
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
301
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
302 method clone(*%_) {
eb855f3 Tadeusz Sośnierz Fix DateTime.now
tadzik authored
303 my %args = { :$!year, :$!month, :$!day, :$!hour, :$!minute,
304 :$!second, :$!timezone, :&!formatter, %_ };
305 self.new(|%args);
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
306 }
307
308 method clone-without-validating(*%_) { # A premature optimization.
eb855f3 Tadeusz Sośnierz Fix DateTime.now
tadzik authored
309 my %args = { :$!year, :$!month, :$!day, :$!hour, :$!minute,
310 :$!second, :$!timezone, :&!formatter, %_ };
311 self.bless(*, |%args);
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
312 }
313
314 method Instant() {
315 Instant.from-posix: self.posix + $.second % 1, $.second >= 60;
316 }
317
318 method posix($ignore-timezone?) {
319 $ignore-timezone or self.offset == 0
320 or return self.utc.posix;
321 # algorithm from Claus Tøndering
322 my $a = (14 - $.month.Int) div 12;
323 my $y = $.year.Int + 4800 - $a;
324 my $m = $.month.Int + 12 * $a - 3;
325 my $jd = $.day + (153 * $m + 2) div 5 + 365 * $y
326 + $y div 4 - $y div 100 + $y div 400 - 32045;
327 ($jd - 2440588) * 24 * 60 * 60
328 + 60*(60*$.hour + $.minute) + self.whole-second;
329 }
330
331 method offset {
332 $!saved-offset or
333 $!timezone ~~ Callable
334 ?? $!timezone(self, True)
335 !! $!timezone
336 }
337
338 method truncated-to(*%args) {
339 %args.keys == 1
d8f1a1b Moritz Lenz Temporal gets more typed exceptions
moritz authored
340 or X::Temporal::Truncation.new(
341 error => 'exactly one named argument needed',
342 ).throw;
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
343 my $unit = %args.keys[0];
344 $unit eq any(<second minute hour day week month year>)
d8f1a1b Moritz Lenz Temporal gets more typed exceptions
moritz authored
345 or X::Temporal::Truncation.new(
346 error => "Unknwon truncation unit '$unit'",
347 ).throw;
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
348 my %parts;
349 given $unit {
350 %parts<second> = self.whole-second;
351 when 'second' {}
352 %parts<second> = 0;
353 when 'minute' {}
354 %parts<minute> = 0;
355 when 'hour' {}
356 %parts<hour> = 0;
357 when 'day' {}
358 # Fall through to Dateish.
359 %parts = self.truncate-parts($unit, %parts);
360 }
361 self.clone-without-validating(|%parts);
362 }
363
364 method whole-second() {
a48a985 Tadeusz Sośnierz More Temporal fixes
tadzik authored
365 floor($.second).Int
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
366 }
367
368 method in-timezone($timezone) {
369 $timezone eqv $!timezone and return self;
370 my $old-offset = self.offset;
371 my $new-offset = $timezone ~~ Callable
372 ?? $timezone(self.utc, False)
373 !! $timezone;
374 my %parts;
375 # Is the logic for handling leap seconds right?
376 # I don't know, but it passes the tests!
377 my $a = ($!second >= 60 ?? 59 !! $!second)
378 + $new-offset - $old-offset;
eb855f3 Tadeusz Sośnierz Fix DateTime.now
tadzik authored
379 %parts<second> = $!second >= 60 ?? $!second !! ($a % 60).Int;
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
380 my $b = $!minute + floor $a / 60;
eb855f3 Tadeusz Sośnierz Fix DateTime.now
tadzik authored
381 %parts<minute> = ($b % 60).Int;
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
382 my $c = $!hour + floor $b / 60;
eb855f3 Tadeusz Sośnierz Fix DateTime.now
tadzik authored
383 %parts<hour> = ($c % 24).Int;
bb7c108 Jonathan Worthington Uncoment most of class DateTime.
jnthn authored
384 # Let Dateish handle any further rollover.
385 floor $c / 24 and %parts<year month day> =
386 self.ymd-from-daycount\
387 (self.get-daycount + floor $c / 24);
388 self.clone-without-validating:
389 :$timezone, saved-offset => $new-offset, |%parts;
390 }
391
392 method utc() {
393 self.in-timezone(0)
394 }
395 method local() {
396 self.in-timezone($*TZ)
397 }
398
399 method Date() {
400 Date.new(self)
401 }
402
403 method Str() {
404 &!formatter(self)
405 }
406
407 multi method perl(DateTime:D:) {
408 sprintf 'DateTime.new(%s)', join ', ', map { "{.key} => {.value}" }, do
409 :$.year, :$.month, :$.day, :$.hour, :$.minute,
410 second => $.second.perl,
411 (timezone => $.timezone.perl
412 unless $.timezone === 0),
413 (:$!saved-offset
414 if $!saved-offset and $.timezone ~~ Callable),
415 (formatter => $.formatter.perl
416 unless &.formatter eqv &default-formatter)
417 }
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
418 }
419
420 my class Date does Dateish {
421 has Int $.year;
422 has Int $.month = 1;
423 has Int $.day = 1;
424
425 has Int $.daycount;
426
427 method !set-daycount($dc) { $!daycount = $dc }
428
429 method get-daycount { $!daycount }
430
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
431 multi method new(:$year!, :$month, :$day) {
432 my $d = self.bless(*, :$year, :$month, :$day);
433 $d.check-date;
434 $d!set-daycount(self.daycount-from-ymd($year,$month,$day));
435 $d;
436 }
437
438 multi method new($year, $month, $day) {
439 self.new(:$year, :$month, :$day);
440 }
441
375fa0a Tadeusz Sośnierz Small Temporal tune, fixes Date.new(Instant)
tadzik authored
442 multi method new(Str $date) {
443 $date ~~ /^ \d\d\d\d '-' \d\d '-' \d\d $/
d0b6640 Moritz Lenz X::Temporal::InvalidFormat
moritz authored
444 or X::Temporal::InvalidFormat.new(
445 invalid-str => $date,
446 format => 'yyyy-mm-dd',
447 ).throw;
375fa0a Tadeusz Sośnierz Small Temporal tune, fixes Date.new(Instant)
tadzik authored
448 self.new(|$date.split('-').map({.Int}));
449 }
450
b8fdbea Moritz Lenz Date.new should not die with LTA error
moritz authored
451 multi method new() {
452 my $n = self.today;
453 if $n.month == 12 && $n.day >= 24 {
454 Date.new($n.year + 1, 12, 24);
455 } else {
456 Date.new($n.year, 12, 24);
457 }
458 }
459
375fa0a Tadeusz Sośnierz Small Temporal tune, fixes Date.new(Instant)
tadzik authored
460 multi method new(DateTime $dt) {
461 self.bless(*,
462 :year($dt.year), :month($dt.month), :day($dt.day),
463 :daycount(self.daycount-from-ymd($dt.year,$dt.month,$dt.day))
464 );
465 }
466
6f8846b Moritz Lenz custom Date.WHICH
moritz authored
467 multi method WHICH(Date:D:) {
468 nqp::box_s(
469 nqp::concat_s(
470 nqp::concat_s(nqp::unbox_s(self.^name), '|'),
471 nqp::unbox_i($!daycount)
472 ),
473 ObjAt
474 );
475 }
476
375fa0a Tadeusz Sośnierz Small Temporal tune, fixes Date.new(Instant)
tadzik authored
477 method new-from-daycount($daycount) {
478 my ($year, $month, $day) = self.ymd-from-daycount($daycount);
479 self.bless(*, :$daycount, :$year, :$month, :$day);
480 }
481
482 method today() {
483 self.new(DateTime.now);
484 }
485
486 method truncated-to(*%args) {
487 %args.keys == 1
d8f1a1b Moritz Lenz Temporal gets more typed exceptions
moritz authored
488 or X::Temporal::Truncation.new(
489 class => 'Date',
490 error => "exactly one named argument needed",
491 ).throw;
375fa0a Tadeusz Sośnierz Small Temporal tune, fixes Date.new(Instant)
tadzik authored
492 my $unit = %args.keys[0];
493 $unit eq any(<week month year>)
d8f1a1b Moritz Lenz Temporal gets more typed exceptions
moritz authored
494 or X::Temporal::Truncation.new(
495 class => 'Date',
496 error => "unknown truncation unit '$unit'",
497 ).throw;
375fa0a Tadeusz Sośnierz Small Temporal tune, fixes Date.new(Instant)
tadzik authored
498 self.clone(|self.truncate-parts($unit));
499 }
500
501 method clone(*%_) {
048cfd5 Tadeusz Sośnierz Fix Date.clone. We now pass S32-temporal/Date.t
tadzik authored
502 my %args = { :$!year, :$!month, :$!day, %_ };
503 self.new(|%args);
375fa0a Tadeusz Sośnierz Small Temporal tune, fixes Date.new(Instant)
tadzik authored
504 }
505
506 method succ() {
507 Date.new-from-daycount($!daycount + 1);
508 }
509 method pred() {
510 Date.new-from-daycount($!daycount - 1);
511 }
512
fa821c1 Moritz Lenz Date.gist should be the same as Date.Str
moritz authored
513 multi method gist(Date:D:) {
514 sprintf '%04d-%02d-%02d', $.year, $.month, $.day;
515 }
516
375fa0a Tadeusz Sośnierz Small Temporal tune, fixes Date.new(Instant)
tadzik authored
517 multi method Str(Date:D:) {
518 sprintf '%04d-%02d-%02d', $.year, $.month, $.day;
519 }
520
521 multi method perl(Date:D:) {
522 "Date.new($.year.perl(), $.month.perl(), $.day.perl())";
523 }
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
524 }
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
525
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
526 multi infix:<+>(Date:D $d, Int:D $x) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
527 Date.new-from-daycount($d.daycount + $x)
528 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
529 multi infix:<+>(Int:D $x, Date:D $d) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
530 Date.new-from-daycount($d.daycount + $x)
531 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
532 multi infix:<->(Date:D $d, Int:D $x) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
533 Date.new-from-daycount($d.daycount - $x)
534 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
535 multi infix:<->(Date:D $a, Date:D $b) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
536 $a.daycount - $b.daycount;
537 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
538 multi infix:<cmp>(Date:D $a, Date:D $b) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
539 $a.daycount cmp $b.daycount
540 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
541 multi infix:«<=>»(Date:D $a, Date:D $b) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
542 $a.daycount <=> $b.daycount
543 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
544 multi infix:<==>(Date:D $a, Date:D $b) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
545 $a.daycount == $b.daycount
546 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
547 multi infix:«<=»(Date:D $a, Date:D $b) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
548 $a.daycount <= $b.daycount
549 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
550 multi infix:«<»(Date:D $a, Date:D $b) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
551 $a.daycount < $b.daycount
552 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
553 multi infix:«>=»(Date:D $a, Date:D $b) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
554 $a.daycount >= $b.daycount
555 }
bbe78ec Jonathan Worthington Remove a bunch of 'is export's that shouldn't have been there. Not sure ...
jnthn authored
556 multi infix:«>»(Date:D $a, Date:D $b) {
118be55 Jonathan Worthington Uncomment rest of temporal stuff. Removed 'multi' in a couple of places ...
jnthn authored
557 $a.daycount > $b.daycount
558 }
559
eb855f3 Tadeusz Sośnierz Fix DateTime.now
tadzik authored
560 $PROCESS::TZ = DateTime-local-timezone.new;
561
9ca7ef7 Moritz Lenz partially put back Temporal
moritz authored
562 # =begin pod
563 #
564 # =head1 SEE ALSO
565 # Perl 6 spec <S32-Temporal|http://perlcabal.org/syn/S32/Temporal.html>.
566 # The Perl 5 DateTime Project home page L<http://datetime.perl.org>.
567 # Perl 5 perldoc L<doc:DateTime> and L<doc:Time::Local>.
568 #
569 # The best yet seen explanation of calendars, by Claus Tøndering
570 # L<Calendar FAQ|http://www.tondering.dk/claus/calendar.html>.
571 # Similar algorithms at L<http://www.hermetic.ch/cal_stud/jdn.htm>
572 # and L<http://www.merlyn.demon.co.uk/daycount.htm>.
573 #
574 # <ISO 8601|http://en.wikipedia.org/wiki/ISO_8601>
575 # <Time zones|http://en.wikipedia.org/wiki/List_of_time_zones>
576 #
577 # As per the recommendation, the strftime() method has bee moved into a
578 # loadable module called DateTime::strftime.
579 #
580 # =end pod
Something went wrong with that request. Please try again.