Created
July 20, 2010 12:59
-
-
Save masak/482925 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| [I've had awful trouble getting this through rakudobug@perl.org's spam filter, and I was | |
| hoping you could review it (and apply it, once it's good enough), so I've sent it | |
| directly to you. Tell me if you want to discuss it on #perl6.] | |
| This patch implements the bulk of the remainder of Temporal.pod, allowing Rakudo to | |
| pass all of the tests in DateTime.t, Date.t, and calendar.t. The only unimplemented | |
| features left in Temporal.pod are those related to Instants. | |
| I removed from DateTime a number of formatting methods that aren't in S32. I put the | |
| ones that strftime needs in strftime.pm. | |
| The class Calendrical, from which DateTime and Date inherit their date-handling logic, | |
| ought to be a role; however, many things break in mysterious ways if it's made to be a | |
| role. Similarly, Calendrical should exist only in the lexical scope of DateTime and Date, | |
| rather than being world-visible, but I get strange errors (when compiling it via make; | |
| not while 'use'ing it as a module) if I so much as put a pair of curlies around | |
| Calendrical, DateTime, and Date. For what it's worth, the three classes remain in a | |
| single file, which I've named Temporal.pm. | |
| The one regression that I know this patch introduces is that DateTime.now no longer uses | |
| fractional seconds. I don't know how to fix this so long as 'time' returns an Int (per | |
| pugs r31660) and we don't have 'now'. A related, preexisting bug is that the default | |
| time zone for DateTime.now ought to be the system's local time zone, not UTC. | |
| From 4ca0438d7056b6f937a1dfdaf9c054732bdf1f1e Mon Sep 17 00:00:00 2001 | |
| From: Kodi Arfer <hippo@Thoth.(none)> | |
| Date: Thu, 15 Jul 2010 10:32:25 -0500 | |
| Subject: [PATCH] Implemented lots more of Temporal.pod. Combined Date and DateTime into Temporal.pm. Changed 'time' to return an Int. Moved some formating code from DateTime to strftime.pm. | |
| --- | |
| CREDITS | 4 + | |
| build/Makefile.in | 3 +- | |
| lib/DateTime/strftime.pm | 31 +++- | |
| src/core/Date.pm | 161 ----------------- | |
| src/core/DateTime.pm | 248 -------------------------- | |
| src/core/Temporal.pm | 432 ++++++++++++++++++++++++++++++++++++++++++++++ | |
| src/core/system.pm | 5 +- | |
| 7 files changed, 463 insertions(+), 421 deletions(-) | |
| delete mode 100644 src/core/Date.pm | |
| delete mode 100644 src/core/DateTime.pm | |
| create mode 100644 src/core/Temporal.pm | |
| diff --git a/CREDITS b/CREDITS | |
| index b35c7d1..9cd139b 100644 | |
| --- a/CREDITS | |
| +++ b/CREDITS | |
| @@ -223,6 +223,10 @@ N: Klaas-Jan Stol | |
| U: kjs | |
| E: parrotcode@gmail.com | |
| +N: Kodi Arfer | |
| +U: Kodi | |
| +W: http://arfer.net | |
| + | |
| N: Kyle Hasselbacher | |
| E: kyleha@gmail.com | |
| U: KyleHa | |
| diff --git a/build/Makefile.in b/build/Makefile.in | |
| index 4b632de..62a4b13 100644 | |
| --- a/build/Makefile.in | |
| +++ b/build/Makefile.in | |
| @@ -224,8 +224,7 @@ CORE_SOURCES = \ | |
| src/core/Substitution.pm \ | |
| src/core/system.pm \ | |
| src/cheats/process.pm \ | |
| - src/core/Date.pm \ | |
| - src/core/DateTime.pm \ | |
| + src/core/Temporal.pm \ | |
| src/core/Match.pm \ | |
| src/core/Attribute.pm \ | |
| src/core/CallFrame.pm \ | |
| diff --git a/lib/DateTime/strftime.pm b/lib/DateTime/strftime.pm | |
| index 677641a..f979650 100644 | |
| --- a/lib/DateTime/strftime.pm | |
| +++ b/lib/DateTime/strftime.pm | |
| @@ -1,6 +1,7 @@ | |
| use v6; | |
| # A strftime() subroutine. | |
| module DateTime::strftime { | |
| + | |
| multi sub strftime( Str $format is copy, DateTime $dt ) is export(:DEFAULT) { | |
| my %substitutions = | |
| # Standard substitutions for yyyy mm dd hh mm ss output. | |
| @@ -9,12 +10,12 @@ module DateTime::strftime { | |
| 'd' => { $dt.day.fmt( '%02d') }, | |
| 'H' => { $dt.hour.fmt( '%02d') }, | |
| 'M' => { $dt.minute.fmt('%02d') }, | |
| - 'S' => { $dt.second.fmt('%02d') }, | |
| + 'S' => { $dt.whole-second.fmt('%02d') }, | |
| # Special substitutions (Posix-only subset of DateTime or libc) | |
| - 'a' => { $dt.day-name.substr(0,3) }, | |
| - 'A' => { $dt.day-name }, | |
| - 'b' => { $dt.month-name.substr(0,3) }, | |
| - 'B' => { $dt.month-name }, | |
| + 'a' => { day-name($dt.day-of-week).substr(0,3) }, | |
| + 'A' => { day-name($dt.day-of-week) }, | |
| + 'b' => { month-name($dt.month).substr(0,3) }, | |
| + 'B' => { month-name($dt.month) }, | |
| 'C' => { ($dt.year/100).fmt('%02d') }, | |
| 'e' => { $dt.day.fmt('%2d') }, | |
| 'F' => { $dt.year.fmt('%04d') ~ '-' ~ $dt.month.fmt( | |
| @@ -27,16 +28,16 @@ module DateTime::strftime { | |
| 'p' => { ($dt.hour < 12) ?? 'am' !! 'pm' }, | |
| 'P' => { ($dt.hour < 12) ?? 'AM' !! 'PM' }, | |
| 'r' => { (($dt.hour+23)%12+1).fmt('%02d') ~ ':' ~ | |
| - $dt.minute.fmt('%02d') ~ ':' ~ $dt.second.fmt('%02d') | |
| + $dt.minute.fmt('%02d') ~ ':' ~ $dt.whole-second.fmt('%02d') | |
| ~ (($.hour < 12) ?? 'am' !! 'pm') }, | |
| 'R' => { $dt.hour.fmt('%02d') ~ ':' ~ $dt.minute.fmt('%02d') }, | |
| - 's' => { $dt.to-epoch.fmt('%d') }, | |
| + 's' => { $dt.posix.fmt('%d') }, | |
| 't' => { "\t" }, | |
| - 'T' => { $dt.hour.fmt('%02d') ~ ':' ~ $dt.minute.fmt('%02d') ~ ':' ~ $dt.second.fmt('%02d') }, | |
| + 'T' => { $dt.hour.fmt('%02d') ~ ':' ~ $dt.minute.fmt('%02d') ~ ':' ~ $dt.whole-second.fmt('%02d') }, | |
| 'u' => { ~ $dt.day-of-week.fmt('%d') }, | |
| 'w' => { ~ (($dt.day-of-week+6) % 7).fmt('%d') }, | |
| 'x' => { $dt.year.fmt('%04d') ~ '-' ~ $dt.month.fmt('%02d') ~ '-' ~ $dt.day.fmt('%2d') }, | |
| - 'X' => { $dt.hour.fmt('%02d') ~ ':' ~ $dt.minute.fmt('%02d') ~ ':' ~ $dt.second.fmt('%02d') }, | |
| + 'X' => { $dt.hour.fmt('%02d') ~ ':' ~ $dt.minute.fmt('%02d') ~ ':' ~ $dt.whole-second.fmt('%02d') }, | |
| 'y' => { ($dt.year % 100).fmt('%02d') }, | |
| '%' => { '%' }, | |
| '3' => { (($dt.second % 1)*1000).fmt('%03d') }, | |
| @@ -58,5 +59,17 @@ module DateTime::strftime { | |
| # // die "Unknown format letter '\%$0'").() }, :global ); | |
| return $result ~ $format; | |
| } | |
| + | |
| + sub day-name($i) { | |
| + # ISO 8601 says Monday is the first day of the week. | |
| + <Monday Tuesday Wednesday Thursday | |
| + Friday Saturday Sunday>[$i - 1] | |
| + } | |
| + | |
| + sub month-name($i) { | |
| + <January February March April May June July August | |
| + September October November December>[$i - 1] | |
| + } | |
| + | |
| } | |
| diff --git a/src/core/Date.pm b/src/core/Date.pm | |
| deleted file mode 100644 | |
| index 74e84c4..0000000 | |
| --- a/src/core/Date.pm | |
| +++ /dev/null | |
| @@ -1,161 +0,0 @@ | |
| -class Date { | |
| - | |
| - has Int $.year; | |
| - has Int $.month = 1; | |
| - has Int $.day = 1; | |
| - | |
| - has Int $.daycount; # = self!daycount-from-ymd($!year, $!month, $!day); | |
| - ## Assignment from here does not currently work. Moving to new(). | |
| - | |
| - method is-leap($year) { | |
| - return False if $year % 4; | |
| - return True if $year % 100; | |
| - $year % 400 == 0; | |
| - } | |
| - | |
| - multi method days-in-month($year, $month) { | |
| - my @month-length = 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31; | |
| - if ($month == 2) { | |
| - self.is-leap($year) ?? 29 !! 28; | |
| - } else { | |
| - @month-length[$month-1]; | |
| - } | |
| - } | |
| - | |
| - method assert-valid-date($year, $month, $day) { | |
| - die 'Invalid date: day < 1' if $day < 1; | |
| - die 'Invalid date: month < 1' if $month < 1; | |
| - die 'Invalid date: month > 12' if $month > 12; | |
| - my $dim = self.days-in-month($year, $month); | |
| - if $day > $dim { | |
| - die "Invalid date: day > $dim"; | |
| - } | |
| - } | |
| - | |
| - method leap-year() { self.is-leap($.year) } | |
| - multi method days-in-month() { self.days-in-month($.year, $.month) } | |
| - | |
| - method !daycount-from-ymd($y is copy, $m is copy, $d) { | |
| - # taken from <http://www.merlyn.demon.co.uk/daycount.htm> | |
| - if ($m < 3) { | |
| - $m += 12; | |
| - --$y; | |
| - } | |
| - return -678973 + $d + ((153 * $m - 2) div 5) | |
| - + 365 * $y + ($y div 4) | |
| - - ($y div 100) + ($y div 400); | |
| - } | |
| - | |
| - method !ymd-from-daycount($daycount) { | |
| - # taken from <http://www.merlyn.demon.co.uk/daycount.htm> | |
| - my $y = 0; | |
| - my $m = 0; | |
| - my $d = $daycount + 678881; | |
| - my $t = ((4 * ($d + 36525)) div 146097) - 1; | |
| - $y += 100 * $t; | |
| - $d -= 36524 * $t + ($t +> 2); | |
| - $t = ((4 * ($d + 366)) div 1461) - 1; | |
| - $y += $t; | |
| - $d -= 365 * $t + ($t +> 2); | |
| - $m = (5 * $d + 2) div 153; | |
| - $d -= (2 + $m * 153) div 5; | |
| - if ($m > 9) { | |
| - $m -= 12; | |
| - $y++; | |
| - } | |
| - return $y, $m + 3, $d+1; | |
| - } | |
| - | |
| - multi method new(:$year, :$month, :$day) { | |
| - self.assert-valid-date($year, $month, $day); | |
| - my $daycount = self!daycount-from-ymd($year,$month,$day); | |
| - self.bless(*, :$year, :$month, :$day, :$daycount); | |
| - } | |
| - | |
| - multi method new($year, $month, $day) { | |
| - self.new(:$year, :$month, :$day); | |
| - } | |
| - | |
| - multi method new(Str $date where { $date ~~ / | |
| - ^ <[0..9]>**4 '-' <[0..9]>**2 '-' <[0..9]>**2 $ | |
| - /}) { | |
| - self.new(|$date.split('-').map({ .Int })); | |
| - } | |
| - | |
| - multi method new-from-daycount($daycount) { | |
| - my ($year, $month, $day) = self!ymd-from-daycount($daycount); | |
| - self.bless(*, :$year, :$month, :$day, :$daycount); | |
| - } | |
| - | |
| - multi method new(::DateTime $dt) { | |
| - my $daycount = self!daycount-from-ymd($dt.year,$dt.month,$dt.day); | |
| - self.bless(*, | |
| - :year($dt.year), :month($dt.month), :day($dt.day), :$daycount | |
| - ); | |
| - } | |
| - | |
| - multi method today() { | |
| - my $dt = ::DateTime.now(); | |
| - self.new($dt); | |
| - } | |
| - | |
| - method DateTime(*%_) { | |
| - return ::DateTime.new(:year($.year), :month($.month), :day($.day), |%_); | |
| - } | |
| - | |
| - method day-of-week() { 1 + (($!daycount + 2) % 7) } | |
| - | |
| - multi method Str() { | |
| - sprintf '%04d-%02d-%02d', $.year, $.month, $.day; | |
| - } | |
| - | |
| - # arithmetics | |
| - multi method succ() { | |
| - Date.new-from-daycount($!daycount + 1); | |
| - } | |
| - multi method pred() { | |
| - Date.new-from-daycount($!daycount - 1); | |
| - } | |
| - | |
| - multi method perl() { | |
| - "Date.new($.year.perl(), $.month.perl(), $.day.perl())"; | |
| - } | |
| - | |
| -} | |
| - | |
| -multi infix:<+>(Date $d, Int $x) is export { | |
| - Date.new-from-daycount($d.daycount + $x) | |
| -} | |
| -multi infix:<+>(Int $x, Date $d) is export { | |
| - Date.new-from-daycount($d.daycount + $x) | |
| -} | |
| -multi infix:<->(Date $d, Int $x) is export { | |
| - Date.new-from-daycount($d.daycount - $x) | |
| -} | |
| -multi infix:<->(Date $a, Date $b) is export { | |
| - $a.daycount - $b.daycount; | |
| -} | |
| -multi infix:<cmp>(Date $a, Date $b) is export { | |
| - $a.daycount cmp $b.daycount | |
| -} | |
| -multi infix:«<=>»(Date $a, Date $b) is export { | |
| - $a.daycount <=> $b.daycount | |
| -} | |
| -multi infix:<==>(Date $a, Date $b) is export { | |
| - $a.daycount == $b.daycount | |
| -} | |
| -multi infix:<!=>(Date $a, Date $b) is export { | |
| - $a.daycount != $b.daycount | |
| -} | |
| -multi infix:«<=»(Date $a, Date $b) is export { | |
| - $a.daycount <= $b.daycount | |
| -} | |
| -multi infix:«<»(Date $a, Date $b) is export { | |
| - $a.daycount < $b.daycount | |
| -} | |
| -multi infix:«>=»(Date $a, Date $b) is export { | |
| - $a.daycount >= $b.daycount | |
| -} | |
| -multi infix:«>»(Date $a, Date $b) is export { | |
| - $a.daycount > $b.daycount | |
| -} | |
| diff --git a/src/core/DateTime.pm b/src/core/DateTime.pm | |
| deleted file mode 100644 | |
| index 5aae560..0000000 | |
| --- a/src/core/DateTime.pm | |
| +++ /dev/null | |
| @@ -1,248 +0,0 @@ | |
| -use v6; | |
| - | |
| -subset DateTime::Formatter where { .can( all<fmt-datetime fmt-ymd fmt-hms> )}; | |
| -subset DateTime::Parser where { .can( all<parse-datetime parse-ymd parse-hms> )}; | |
| - | |
| -# RAKUDO: When we have anonymous classes, we don't need to do it like this | |
| -class DefaultFormatter { | |
| - has $.date-sep is rw = '-'; | |
| - has $.time-sep is rw = ':'; | |
| - | |
| - method fmt-datetime($dt) { # should be typed 'DateTime' | |
| - $dt.iso8601(); | |
| - } | |
| - | |
| - method fmt-ymd($dt) { | |
| - $dt.year.fmt('%04d') ~ $.date-sep ~ | |
| - $dt.month.fmt('%02d') ~ $.date-sep ~ | |
| - $dt.day.fmt('%02d'); | |
| - } | |
| - | |
| - method fmt-hms($dt) { | |
| - $dt.hour.fmt('%02d') ~ $.time-sep ~ | |
| - $dt.minute.fmt('%02d') ~ $.time-sep ~ | |
| - $dt.second.fmt('%02d'); | |
| - } | |
| -} | |
| - | |
| -class DateTime { | |
| - | |
| - has Int $.year; | |
| - has Int $.month = 1; | |
| - has Int $.day = 1; | |
| - has Int $.hour = 0; | |
| - has Int $.minute = 0; | |
| - has Num $.second = 0.0; | |
| - has $.timezone = '+0000'; | |
| - | |
| - has DateTime::Formatter $!formatter; # = DefaultFormatter.new; | |
| - # does not seem to work | |
| - | |
| - method assert-valid-time($hour, $minute, $second) { | |
| - die 'Invalid time: hour < 0' if $hour < 0; | |
| - die 'Invalid time: hour > 23' if $hour > 23; | |
| - die 'Invalid time: minute < 0' if $minute < 0; | |
| - die 'Invalid time: minute > 59' if $minute > 59; | |
| - die 'Invalid time: second < 0' if $second < 0; | |
| - die 'Invalid time: second > 59' if $second > 59; | |
| - } | |
| - | |
| - multi method new(:$year!, Bool :$noassert=Bool::False, :$formatter=DefaultFormatter.new, *%_) { | |
| - if !$noassert { | |
| - ::Date.assert-valid-date($year, %_<month> // 1, %_<day> // 1); | |
| - self.assert-valid-time(%_<hour> // 0, %_<minute> // 0, %_<second> // 0); | |
| - } | |
| - self.bless(*, :$year, :$formatter, |%_); | |
| - } | |
| - | |
| - multi method new(Str $format, :$formatter=DefaultFormatter.new) { | |
| - if $format ~~ /^(\d**4)'-'(\d\d)'-'(\d\d)T(\d\d)':'(\d\d)':'(\d\d)(<[\-\+]>\d**4)$/ { | |
| - my $year = +$0; | |
| - my $month = +$1; | |
| - my $day = +$2; | |
| - my $hour = +$3; | |
| - my $minute = +$4; | |
| - my $second = +$5; | |
| - my $timezone = ~$6; | |
| - self.new( | |
| - :year($year.Int), :month($month.Int), :day($day.Int), | |
| - :hour($hour.Int), :minute($minute.Int), :second($second.Int), | |
| - :$timezone, :$formatter, :noassert(Bool::False) | |
| - ); | |
| - } | |
| - else { | |
| - die "DateTime.new(Str) expects an ISO8601 string\n"; | |
| - } | |
| - } | |
| - | |
| - multi method from-epoch($epoch, :$timezone='+0000', :$formatter=DefaultFormatter.new) { | |
| - my $time = floor($epoch); | |
| - my $fracsecond = $epoch - $time; | |
| - my $second = $time % 60; $time = $time div 60; | |
| - my $minute = $time % 60; $time = $time div 60; | |
| - my $hour = $time % 24; $time = $time div 24; | |
| - $second += $fracsecond; | |
| - # Day month and leap year arithmetic, based on Gregorian day #. | |
| - # 2000-01-01 noon UTC == 2451558.0 Julian == 2451545.0 Gregorian | |
| - $time += 2440588; # because 2000-01-01 == Unix epoch day 10957 | |
| - my $a = $time + 32044; # date algorithm from Claus Tøndering | |
| - my $b = (4 * $a + 3) div 146097; # 146097 = days in 400 years | |
| - my $c = $a - (146097 * $b) div 4; | |
| - my $d = (4 * $c + 3) div 1461; # 1461 = days in 4 years | |
| - my $e = $c - ($d * 1461) div 4; | |
| - my $m = (5 * $e + 2) div 153; # 153 = days in Mar-Jul Aug-Dec | |
| - my $day = $e - (153 * $m + 2) div 5 + 1; | |
| - my $month = $m + 3 - 12 * ($m div 10); | |
| - my $year = $b * 100 + $d - 4800 + $m div 10; | |
| - self.new(:$year, :$month, :$day, | |
| - :$hour, :$minute, :$second, | |
| - :$timezone, :$formatter, :noassert); | |
| - } | |
| - | |
| - multi method to-epoch { | |
| - my ( $a, $y, $m, $jd ); # algorithm from Claus Tøndering | |
| - $jd = $.day + floor((153 * $m + 2) / 5) + 365 * $y | |
| - + floor( $y / 4 ) - floor( $y / 100 ) + floor( $y / 400 ) - 32045; | |
| - $a = (14 - $.month) div 12; | |
| - $y = $.year + 4800 - $a; | |
| - $m = $.month + 12 * $a - 3; | |
| - $jd = $.day + (153 * $m + 2) div 5 + 365 * $y | |
| - + $y div 4 - $y div 100 + $y div 400 - 32045; | |
| - return ($jd - 2440588) * 24 * 60 * 60 | |
| - + ($.hour*60 + $.minute)*60 + $.second; | |
| - } | |
| - | |
| - multi method now() { | |
| - self.from-epoch( | |
| - time(), | |
| - :timezone('+0000'), | |
| - :formatter(DefaultFormatter.new) | |
| - ); | |
| - } | |
| - | |
| - multi method ymd() { | |
| - $!formatter.fmt-ymd(self); | |
| - } | |
| - | |
| - multi method hms() { | |
| - $!formatter.fmt-hms(self); | |
| - } | |
| - | |
| - method iso8601() { | |
| - # This should be the only formatting not done by the formatter | |
| - $.year.fmt( '%04d') ~ '-' ~ $.month.fmt( '%02d') ~ '-' ~ | |
| - $.day.fmt( '%02d') ~ 'T' ~ $.hour.fmt( '%02d') ~ ':' ~ | |
| - $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') ~ $.timezone; | |
| - } | |
| - | |
| - method Str() { | |
| - $!formatter.fmt-datetime(self); | |
| - } | |
| - | |
| - multi method truncate($unit) { | |
| - die 'Unknown truncation unit' | |
| - if $unit eq none(<second minute hour day month>); | |
| - given $unit { | |
| - when 'second' {} | |
| - $!second = 0; | |
| - when 'minute' {} | |
| - $!minute = 0; | |
| - when 'hour' {} | |
| - $!hour = 0; | |
| - when 'day' {} | |
| - $!day = 1; | |
| - when 'month' {} | |
| - $!month = 1; | |
| - } | |
| - } | |
| - | |
| - multi method today() { | |
| - self.now().truncate('day'); | |
| - } | |
| - | |
| - multi method day-of-week { # returns DayOfWeek { | |
| - my ( $a, $y, $m, $jd ); # algorithm from Claus Tøndering | |
| - $a = (14 - $.month) div 12; | |
| - $y = $.year + 4800 - $a; | |
| - $m = $.month + 12 * $a - 3; | |
| - $jd = $.day + (153 * $m + 2) div 5 + 365 * $y + $y div 4 | |
| - - $y div 100 +$y div 400 - 32045; | |
| - return ($jd + 1) % 7 + 1; | |
| - } | |
| - | |
| - multi method month-name { | |
| - return <January February March April May June July August | |
| - September October November December>[$.month-1]; | |
| - } | |
| - | |
| - multi method day-name { | |
| - return <Sunday Monday Tuesday Wednesday Thursday Friday | |
| - Saturday>[self.day-of-week-1]; | |
| - } | |
| - | |
| - method set(:$year, :$month, :$day, | |
| - :$hour, :$minute, :$second, | |
| - :$timezone, :$formatter) { | |
| - # Do this first so that the other nameds have a chance to | |
| - # override. | |
| - if defined $timezone { | |
| - # First attempt. Probably wrong. | |
| - # Confirmed, this does NOT work. TODO: FIXME: Make it work. | |
| - # Notes: The Timezone is in HHMM format. We must parse that | |
| - # in order to figure out what timezone shift to use. | |
| - #my $difference = $timezone - $!timezone; | |
| - #$!hour += $difference; | |
| - $!timezone = $timezone; | |
| - } | |
| - | |
| - $!year = $year // $!year; | |
| - $!month = $month // $!month; | |
| - $!day = $day // $!day; | |
| - $!hour = $hour // $!hour; | |
| - $!minute = $minute // $!minute; | |
| - $!second = $second // $!second; | |
| - $!formatter = $formatter // $!formatter; | |
| - } | |
| - | |
| - # RAKUDO: These setters are temporary, until we have Proxy | |
| - # objects with a STORE method | |
| - method set-year($year) { self.set(:$year) } | |
| - method set-month($month) { self.set(:$month) } | |
| - method set-day($day) { self.set(:$day) } | |
| - method set-hour($hour) { self.set(:$hour) } | |
| - method set-minute($minute) { self.set(:$minute) } | |
| - method set-second($second) { self.set(:$second) } | |
| - method set-timezone($timezone) { self.set(:$timezone) } | |
| - method set-formatter($formatter) { self.set(:$formatter) } | |
| - | |
| - method Date() { | |
| - return ::Date.new(self); | |
| - } | |
| - | |
| - multi method perl() { | |
| - "DateTime.new('" ~ self.iso8601 ~ "')"; | |
| - } | |
| - | |
| - | |
| -} | |
| - | |
| -=begin pod | |
| - | |
| -=head1 SEE ALSO | |
| -Perl 6 spec <S32-Temporal|http://perlcabal.org/syn/S32/Temporal.html>. | |
| -The Perl 5 DateTime Project home page L<http://datetime.perl.org>. | |
| -Perl 5 perldoc L<doc:DateTime> and L<doc:Time::Local>. | |
| - | |
| -The best yet seen explanation of calendars, by Claus Tøndering | |
| -L<Calendar FAQ|http://www.tondering.dk/claus/calendar.html>. | |
| -Similar algorithms at L<http://www.hermetic.ch/cal_stud/jdn.htm> | |
| -and L<http://www.merlyn.demon.co.uk/daycount.htm>. | |
| - | |
| -<ISO 8601|http://en.wikipedia.org/wiki/ISO_8601> | |
| -<Time zones|http://en.wikipedia.org/wiki/List_of_time_zones> | |
| - | |
| -As per the recommendation, the strftime() method has bee moved into a | |
| -loadable module called DateTime::strftime. | |
| - | |
| -=end pod | |
| - | |
| diff --git a/src/core/Temporal.pm b/src/core/Temporal.pm | |
| new file mode 100644 | |
| index 0000000..83084d1 | |
| --- /dev/null | |
| +++ b/src/core/Temporal.pm | |
| @@ -0,0 +1,432 @@ | |
| +use v6; | |
| + | |
| +class Calendrical { | |
| + has Int $.year; | |
| + has Int $.month = 1; | |
| + has Int $.day = 1; | |
| + | |
| + multi method is-leap-year($y = $!year) { | |
| + $y %% 4 and not $y %% 100 or $y %% 400 | |
| + } | |
| + | |
| + multi method days-in-month($year = $!year, $month = $!month) { | |
| + $month == 2 ?? self.is-leap-year($year) ?? 29 !! 28 | |
| + !! $month == 4|6|9|11 ?? 30 | |
| + !! 31 | |
| + } | |
| + | |
| + method daycount-from-ymd($y is copy, $m is copy, $d) { | |
| + # taken from <http://www.merlyn.demon.co.uk/daycount.htm> | |
| + $y .= Int; | |
| + $m .= Int; | |
| + if ($m < 3) { | |
| + $m += 12; | |
| + --$y; | |
| + } | |
| + -678973 + $d + (153 * $m - 2) div 5 | |
| + + 365 * $y + $y div 4 | |
| + - $y div 100 + $y div 400; | |
| + } | |
| + | |
| + method set-ymd-from-daycount($daycount) { | |
| + # taken from <http://www.merlyn.demon.co.uk/daycount.htm> | |
| + $!day = $daycount.Int + 678881; | |
| + my $t = (4 * ($!day + 36525)) div 146097 - 1; | |
| + $!year = 100 * $t; | |
| + $!day -= 36524 * $t + ($t +> 2); | |
| + $t = (4 * ($!day + 366)) div 1461 - 1; | |
| + $!year += $t; | |
| + $!day -= 365 * $t + ($t +> 2); | |
| + $!month = (5 * $!day + 2) div 153; | |
| + $!day -= (2 + $!month * 153) div 5 - 1; | |
| + if ($!month > 9) { | |
| + $!month -= 12; | |
| + $!year++; | |
| + } | |
| + $!month += 3; | |
| + } | |
| + | |
| + multi method get-daycount { | |
| + self.daycount-from-ymd($.year, $.month, $.day) | |
| + } | |
| + | |
| + method day-of-month() { $.day } | |
| + | |
| + method day-of-week($daycount = self.get-daycount) { | |
| + ($daycount + 2) % 7 + 1 | |
| + } | |
| + | |
| + multi method week() { # algorithm from Claus Tøndering | |
| + my $a = $.year - ($.month <= 2).floor; | |
| + my $b = $a div 4 - $a div 100 + $a div 400; | |
| + my $c = ($a - 1) div 4 - ($a - 1) div 100 + ($a - 1) div 400; | |
| + my $s = $b - $c; | |
| + my $e = $.month <= 2 ?? 0 !! $s + 1; | |
| + my $f = $.day + do $.month <= 2 | |
| + ?? 31*($.month - 1) - 1 | |
| + !! (153*($.month - 3) + 2) div 5 + 58 + $s; | |
| + | |
| + my $g = ($a + $b) % 7; | |
| + my $d = ($f + $g - $e) % 7; | |
| + my $n = $f + 3 - $d; | |
| + | |
| + $n < 0 ?? ($.year - 1, 53 - ($g - $s) div 5) | |
| + !! $n > 364 + $s ?? ($.year + 1, 1) | |
| + !! ($.year, $n div 7 + 1); | |
| + } | |
| + | |
| + multi method week-year() { | |
| + self.week.[0] | |
| + } | |
| + | |
| + multi method week-number() { | |
| + self.week.[1] | |
| + } | |
| + | |
| + multi method weekday-of-month { | |
| + ($.day - 1) div 7 + 1 | |
| + } | |
| + | |
| + multi method day-of-year() { | |
| + [+] $.day, map { self.days-in-month($.year, $^m) }, 1 ..^ $.month | |
| + } | |
| + | |
| + method try-assignment($lvalue is rw, $rvalue, $name, $range) { | |
| + $rvalue.defined or return; | |
| + +$rvalue ~~ $range or | |
| + or die "$name must be in {$range.perl}\n"; | |
| + $lvalue = +$rvalue; | |
| + } | |
| + | |
| + method try-setting-date(:$year, :$month, :$day) { | |
| + $year.defined and $!year = +$year; | |
| + self.try-assignment($!month, $month, 'month', 1 .. 12); | |
| + self.try-assignment($!day, $day, "day of $!year/$!month", | |
| + 1 .. self.days-in-month); | |
| + } | |
| + | |
| +} | |
| + | |
| +sub default-formatter(::DateTime $dt) { | |
| +# ISO 8601 timestamp | |
| + my $o = $dt.offset; | |
| + $o %% 60 | |
| + or warn "Default DateTime formatter: offset $o not divisible by 60.\n"; | |
| + sprintf '%04d-%02d-%02dT%02d:%02d:%02d%s', | |
| + $dt.year, $dt.month, $dt.day, | |
| + $dt.hour, $dt.minute, $dt.whole-second, | |
| + do $o | |
| + ?? sprintf '%s%02d%02d', | |
| + $o < 0 ?? '-' !! '+', | |
| + ($o.abs / 60 / 60).floor, | |
| + ($o.abs / 60 % 60).floor | |
| + !! 'Z' | |
| +} | |
| + | |
| +class DateTime is Calendrical { | |
| + has Int $.hour = 0; | |
| + has Int $.minute = 0; | |
| + has $.second = 0.0; | |
| + has $.timezone = 0; # UTC | |
| + has &.formatter; # = &default-formatter; # Doesn't work (not in scope?). | |
| + | |
| + multi method new(Int :$year!, :$timezone=0, :&formatter=&default-formatter, *%_) { | |
| + # Rather than directly constructing the object we want, | |
| + # take advantage of the validation login in DateTime.set. | |
| + # But don't let $timezone get to .set, or it might change | |
| + # the hour, etc. | |
| + my $dt = self.bless(*, :$year, :$timezone, :&formatter); | |
| + $dt.set(|%_); | |
| + $dt; | |
| + } | |
| + | |
| + multi method new(::Date :$date!, *%_) { | |
| + self.new(year => $date.year, month => $date.month, | |
| + day => $date.day, |%_) | |
| + } | |
| + | |
| + # TODO: multi method new(Instant $i, ...) { ... } | |
| + | |
| + multi method new(Int $time is copy, :$timezone, :&formatter=&default-formatter) { | |
| + # Interpret $time as a POSIX time. | |
| + my $second = $time % 60; $time = $time div 60; | |
| + my $minute = $time % 60; $time = $time div 60; | |
| + my $hour = $time % 24; $time = $time div 24; | |
| + # Day month and leap year arithmetic, based on Gregorian day #. | |
| + # 2000-01-01 noon UTC == 2451558.0 Julian == 2451545.0 Gregorian | |
| + $time += 2440588; # because 2000-01-01 == Unix epoch day 10957 | |
| + my $a = $time + 32044; # date algorithm from Claus Tøndering | |
| + my $b = (4 * $a + 3) div 146097; # 146097 = days in 400 years | |
| + my $c = $a - (146097 * $b) div 4; | |
| + my $d = (4 * $c + 3) div 1461; # 1461 = days in 4 years | |
| + my $e = $c - ($d * 1461) div 4; | |
| + my $m = (5 * $e + 2) div 153; # 153 = days in Mar-Jul Aug-Dec | |
| + my $day = $e - (153 * $m + 2) div 5 + 1; | |
| + my $month = $m + 3 - 12 * ($m div 10); | |
| + my $year = $b * 100 + $d - 4800 + $m div 10; | |
| + my $dt = self.new(:$year, :$month, :$day, | |
| + :$hour, :$minute, :$second, :&formatter); | |
| + $timezone.defined and $dt.set(timezone => $timezone); | |
| + $dt; | |
| + } | |
| + | |
| + multi method new(Str $format, :$timezone is copy = 0, :&formatter=&default-formatter) { | |
| + $format ~~ /^ (\d**4) '-' (\d\d) '-' (\d\d) T (\d\d) ':' (\d\d) ':' (\d\d) (Z || (<[\-\+]>) (\d\d)(\d\d))? $/ | |
| + or die "DateTime.new(Str) expects an ISO 8601 string\n"; | |
| + my $year = (+$0).Int; | |
| + my $month = (+$1).Int; | |
| + my $day = (+$2).Int; | |
| + my $hour = (+$3).Int; | |
| + my $minute = (+$4).Int; | |
| + my $second = +$5; | |
| + if $6 { | |
| + $timezone | |
| + and die "DateTime.new(Str): :timezone argument not allowed with a timestamp offset"; | |
| + if $6 eq 'Z' { | |
| + $timezone = 0; | |
| + } else { | |
| + $timezone = (($6[0][1]*60 + $6[0][2]) * 60).Int; | |
| + # RAKUDO: .Int is needed to avoid to avoid the nasty '-0'. | |
| + $6[0][0] eq '-' and $timezone = -$timezone; | |
| + } | |
| + } | |
| + DateTime.new(:$year, :$month, :$day, :$hour, :$minute, | |
| + :$second, :$timezone, :&formatter); | |
| + } | |
| + | |
| + multi method now(:$timezone=0, :&formatter=&default-formatter) { | |
| + # FIXME: Default to the user's time zone instead of UTC. | |
| + # FIXME: Include fractional seconds. | |
| + self.new(time, :$timezone, :&formatter) | |
| + } | |
| + | |
| + # TODO: multi method Instant() { ... } | |
| + | |
| + multi method posix() { | |
| + self.offset | |
| + and return self.clone.set(timezone => 0).posix; | |
| + # algorithm from Claus Tøndering | |
| + my $a = (14 - $.month.Int) div 12; | |
| + my $y = $.year.Int + 4800 - $a; | |
| + my $m = $.month.Int + 12 * $a - 3; | |
| + my $jd = $.day + (153 * $m + 2) div 5 + 365 * $y | |
| + + $y div 4 - $y div 100 + $y div 400 - 32045; | |
| + ($jd - 2440588) * 24 * 60 * 60 | |
| + + 60*(60*$.hour + $.minute) + self.whole-second; | |
| + } | |
| + | |
| + method offset($tz = $!timezone) { | |
| + $tz ~~ Callable ?? $tz(self, True) !! $tz | |
| + } | |
| + | |
| + multi method truncate(:$to) { | |
| + # RAKUDO: When supplying positional arguments by name works | |
| + # again, this won't be necessary. | |
| + self.truncate($to); | |
| + } | |
| + | |
| + multi method truncate($to) { | |
| + die 'Unknown truncation unit' | |
| + if $to eq none(<second minute hour day week month year>); | |
| + given $to { | |
| + $!second .= floor; | |
| + when 'second' {} | |
| + $!second = 0; | |
| + when 'minute' {} | |
| + $!minute = 0; | |
| + when 'hour' {} | |
| + $!hour = 0; | |
| + when 'week' { | |
| + my $dc = self.get-daycount; | |
| + my $new-dc = $dc - self.day-of-week($dc) + 1; | |
| + self.set-ymd-from-daycount($new-dc); | |
| + } | |
| + when 'day' {} | |
| + $!day = 1; | |
| + when 'month' {} | |
| + $!month = 1; | |
| + } | |
| + self; | |
| + } | |
| + | |
| + multi method whole-second() { | |
| + floor $.second | |
| + } | |
| + | |
| + method set(:$year, :$month, :$day, | |
| + :$hour, :$minute, :$second, | |
| + :$timezone, :&formatter) { | |
| + # Do this first so that the other nameds have a chance to | |
| + # override. | |
| + if defined $timezone and $timezone !eqv $!timezone { | |
| + my $old-offset = self.offset; | |
| + my $new-offset = $timezone ~~ Callable | |
| + ?? $timezone(self.clone.set(timezone => 0), False) | |
| + !! $timezone; | |
| + my $c = $!second + $new-offset - $old-offset; | |
| + $!second = $c % 60; | |
| + my $a = $!minute + floor $c / 60; | |
| + $!minute = $a % 60; | |
| + my $b = $!hour + floor $a / 60; | |
| + $!hour = $b % 24; | |
| + # Let Calendrical handle any further rollover. | |
| + floor $b / 24 and self.set-ymd-from-daycount\ | |
| + (self.get-daycount + floor $b / 24); | |
| + $!timezone = $timezone; | |
| + } | |
| + | |
| + self.try-setting-date(:$year, :$month, :$day); | |
| + self.try-assignment($!hour, $hour, 'hour', 0 ..^ 24); | |
| + self.try-assignment($!minute, $minute, 'minute', 0 ..^ 60); | |
| + self.try-assignment($!second, $second, 'second', 0 ..^ 62); | |
| + &formatter.defined and &!formatter = &formatter; | |
| + | |
| + self; | |
| + } | |
| + | |
| + # RAKUDO: These setters are temporary, until we have Proxy | |
| + # objects with a STORE method | |
| + method set-year($year) { self.set(:$year) } | |
| + method set-month($month) { self.set(:$month) } | |
| + method set-day($day) { self.set(:$day) } | |
| + method set-day-of-month($day) { self.set(:$day) } | |
| + method set-hour($hour) { self.set(:$hour) } | |
| + method set-minute($minute) { self.set(:$minute) } | |
| + method set-second($second) { self.set(:$second) } | |
| + method set-timezone($timezone) { self.set(:$timezone) } | |
| + method set-formatter(&formatter) { self.set(:&formatter) } | |
| + | |
| + method Date() { | |
| + return ::Date.new(self); | |
| + } | |
| + | |
| + method Str() { | |
| + &!formatter(self) | |
| + } | |
| + | |
| + multi method perl() { | |
| + "DateTime.new(year => $.year, month => $.month, day => $.day, " ~ | |
| + "hour => $.hour, minute => $.minute, second => $.second, " ~ | |
| + "timezone => $.timezone.perl()" ~ | |
| + do $.formatter eqv &default-formatter | |
| + ?? ')' | |
| + !! ", formatter => $.formatter.perl())" | |
| + } | |
| + | |
| +} | |
| + | |
| +class Date is Calendrical { | |
| + has Int $.daycount; | |
| + | |
| + method !set-daycount($dc) { $!daycount = $dc } | |
| + | |
| + multi method get-daycount { $!daycount } | |
| + | |
| + multi method new(:$year!, :$month, :$day) { | |
| + my $d = self.bless(*, :$year); | |
| + $d.try-setting-date(:$month, :$day); | |
| + $d!set-daycount(self.daycount-from-ymd($year,$month,$day)); | |
| + $d; | |
| + } | |
| + | |
| + multi method new($year, $month, $day) { | |
| + self.new(:$year, :$month, :$day); | |
| + } | |
| + | |
| + multi method new(Str $date where { $date ~~ / | |
| + ^ <[0..9]>**4 '-' <[0..9]>**2 '-' <[0..9]>**2 $ | |
| + /}) { | |
| + self.new(|$date.split('-').map(*.Int)); | |
| + } | |
| + | |
| + multi method new(::DateTime $dt) { | |
| + self.bless(*, | |
| + :year($dt.year), :month($dt.month), :day($dt.day), | |
| + :daycount(self.daycount-from-ymd($dt.year,$dt.month,$dt.day)) | |
| + ); | |
| + } | |
| + | |
| + multi method new-from-daycount($daycount) { | |
| + my $d = self.bless(*, :$daycount); | |
| + $d.set-ymd-from-daycount($daycount); | |
| + $d; | |
| + } | |
| + | |
| + multi method today() { | |
| + my $dt = ::DateTime.now(); | |
| + self.new($dt); | |
| + } | |
| + | |
| + multi method succ() { | |
| + Date.new-from-daycount($!daycount + 1); | |
| + } | |
| + multi method pred() { | |
| + Date.new-from-daycount($!daycount - 1); | |
| + } | |
| + | |
| + multi method Str() { | |
| + sprintf '%04d-%02d-%02d', $.year, $.month, $.day; | |
| + } | |
| + | |
| + multi method perl() { | |
| + "Date.new($.year.perl(), $.month.perl(), $.day.perl())"; | |
| + } | |
| + | |
| +} | |
| + | |
| +multi infix:<+>(Date $d, Int $x) is export { | |
| + Date.new-from-daycount($d.daycount + $x) | |
| +} | |
| +multi infix:<+>(Int $x, Date $d) is export { | |
| + Date.new-from-daycount($d.daycount + $x) | |
| +} | |
| +multi infix:<->(Date $d, Int $x) is export { | |
| + Date.new-from-daycount($d.daycount - $x) | |
| +} | |
| +multi infix:<->(Date $a, Date $b) is export { | |
| + $a.daycount - $b.daycount; | |
| +} | |
| +multi infix:<cmp>(Date $a, Date $b) is export { | |
| + $a.daycount cmp $b.daycount | |
| +} | |
| +multi infix:«<=>»(Date $a, Date $b) is export { | |
| + $a.daycount <=> $b.daycount | |
| +} | |
| +multi infix:<==>(Date $a, Date $b) is export { | |
| + $a.daycount == $b.daycount | |
| +} | |
| +multi infix:<!=>(Date $a, Date $b) is export { | |
| + $a.daycount != $b.daycount | |
| +} | |
| +multi infix:«<=»(Date $a, Date $b) is export { | |
| + $a.daycount <= $b.daycount | |
| +} | |
| +multi infix:«<»(Date $a, Date $b) is export { | |
| + $a.daycount < $b.daycount | |
| +} | |
| +multi infix:«>=»(Date $a, Date $b) is export { | |
| + $a.daycount >= $b.daycount | |
| +} | |
| +multi infix:«>»(Date $a, Date $b) is export { | |
| + $a.daycount > $b.daycount | |
| +} | |
| + | |
| +=begin pod | |
| + | |
| +=head1 SEE ALSO | |
| +Perl 6 spec <S32-Temporal|http://perlcabal.org/syn/S32/Temporal.html>. | |
| +The Perl 5 DateTime Project home page L<http://datetime.perl.org>. | |
| +Perl 5 perldoc L<doc:DateTime> and L<doc:Time::Local>. | |
| + | |
| +The best yet seen explanation of calendars, by Claus Tøndering | |
| +L<Calendar FAQ|http://www.tondering.dk/claus/calendar.html>. | |
| +Similar algorithms at L<http://www.hermetic.ch/cal_stud/jdn.htm> | |
| +and L<http://www.merlyn.demon.co.uk/daycount.htm>. | |
| + | |
| +<ISO 8601|http://en.wikipedia.org/wiki/ISO_8601> | |
| +<Time zones|http://en.wikipedia.org/wiki/List_of_time_zones> | |
| + | |
| +As per the recommendation, the strftime() method has bee moved into a | |
| +loadable module called DateTime::strftime. | |
| + | |
| +=end pod | |
| diff --git a/src/core/system.pm b/src/core/system.pm | |
| index e73e8f3..ac2d975 100644 | |
| --- a/src/core/system.pm | |
| +++ b/src/core/system.pm | |
| @@ -29,5 +29,8 @@ sub sleep($seconds = Inf) { # fractional seconds also allowed | |
| } | |
| sub time() { | |
| - pir::time__n() | |
| + floor pir::time__n() | |
| + # FIXME: Can probably be implemented more efficiently, by | |
| + # getting integer seconds directly. | |
| + # http://docs.parrot.org/parrot/latest/html/src/ops/sys.ops.html#time%28out_INT%29 | |
| } | |
| -- | |
| 1.7.0.4 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment