Skip to content

Instantly share code, notes, and snippets.

/Temporal patch, try 2

Created July 20, 2010 23:44
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save anonymous/483792 to your computer and use it in GitHub Desktop.
Save anonymous/483792 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
Temporal patch, try 2
From 1b57a798d3f8e9f3d951dc72347e12b2fe4348d9 Mon Sep 17 00:00:00 2001
From: Kodi Arfer <hippo@Thoth.(none)>
Date: Tue, 20 Jul 2010 18:41:37 -0500
Subject: [PATCH] Temporal goodness.
---
CREDITS | 4 +
build/Makefile.in | 3 +-
lib/DateTime/strftime.pm | 41 ++++-
src/core/Date.pm | 161 -----------------
src/core/DateTime.pm | 248 --------------------------
src/core/Temporal.pm | 432 ++++++++++++++++++++++++++++++++++++++++++++++
src/core/system.pm | 5 +-
7 files changed, 472 insertions(+), 422 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 e6f800d..40b1b22 100644
--- a/CREDITS
+++ b/CREDITS
@@ -227,6 +227,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 1dbfd34..c19af17 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 7986e30..210c1d0 100644
--- a/lib/DateTime/strftime.pm
+++ b/lib/DateTime/strftime.pm
@@ -1,6 +1,8 @@
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 +11,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,22 +29,29 @@ 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') },
'6' => { (($dt.second % 1)*1000000).fmt('%06d') },
'9' => { (($dt.second % 1)*1000000000).fmt('%09d') },
- 'z' => { $dt.timezone }
+ 'z' => { $dt.timezone ~~ Callable and die "stftime: Can't use 'z' with Callable time zones.";
+ my $o = $dt.timezone;
+ $o
+ ?? sprintf '%s%02d%02d',
+ $o < 0 ?? '-' !! '+',
+ ($o.abs / 60 / 60).floor,
+ ($o.abs / 60 % 60).floor
+ !! 'Z' }
;
my $result = '';
while $format ~~ / ^ (<-['%']>*) '%' (.)(.*) $ / {
@@ -59,5 +68,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..005fb47
--- /dev/null
+++ b/src/core/Temporal.pm
@@ -0,0 +1,432 @@
+use v6;
+
+class Dateish {
+ 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 Dateish {
+ 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 Dateish 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 Dateish {
+ 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