Temporal and Date revision #1911
Labels
Comments
From @supernovusFind attached a patch which implements several changes to the Temporal and - Temporal and Date now use a role called DateLike which contains common And a rather significant change: - The DateTime::strftime method has been extracted out of the Temporal.pm There are updated tests for the new functionality, that I will commit to the |
From @supernovus0001-Temporal-Date-modifications.patchFrom 72b077751d1344298d30500c96f5fef910642c43 Mon Sep 17 00:00:00 2001
From: Timothy Totten <2010@huri.net>
Date: Sat, 3 Jul 2010 18:29:16 -0700
Subject: [PATCH] Temporal/Date modifications.
More refactoring of Temporal and Date.
Changed how DateTime::strftime works.
Added DateTime::strftime to Makefile.in
Fixed bugs in Date/Temporal
Changed time-zone to timezone as per spec.
---
.gitignore | 1 +
build/Makefile.in | 11 +++-
lib/DateTime/strftime.pm | 70 ++++++++++++++++++++++
src/core/Date.pm | 59 +++++++++++--------
src/core/Temporal.pm | 147 +++++++++++++++++-----------------------------
t/spectest.data | 1 +
6 files changed, 169 insertions(+), 120 deletions(-)
create mode 100644 lib/DateTime/strftime.pm
diff --git a/.gitignore b/.gitignore
index defc2cc..fc65063 100644
--- a/.gitignore
+++ b/.gitignore
@@ -36,3 +36,4 @@ src/binder/bind.bundle
src/binder/bind.o
docs/test_summary.times
docs/test_summary.times.tmp
+lib/DateTime/strftime.pir
diff --git a/build/Makefile.in b/build/Makefile.in
index 666ec62..2323640 100644
--- a/build/Makefile.in
+++ b/build/Makefile.in
@@ -281,8 +281,8 @@ HARNESS_WITH_FUDGE_JOBS = $(HARNESS_WITH_FUDGE) --jobs
STAGESTATS = @stagestats@
-# the default target
-all: $(PERL6_EXE) Test.pir
+# the default target, TODO: make libraries in 'lib' a variable.
+all: $(PERL6_EXE) Test.pir lib/DateTime/strftime.pir
# the install target
install: all
@@ -291,6 +291,9 @@ install: all
$(CP) Test.pm $(DESTDIR)$(PERL6_LANG_DIR)/lib
$(CP) Test.pir $(DESTDIR)$(PERL6_LANG_DIR)/lib
$(CP) lib/*.pm $(DESTDIR)$(PERL6_LANG_DIR)/lib
+ $(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/lib/DateTime
+ $(CP) lib/DateTime/*.pm $(DESTDIR)$(PERL6_LANG_DIR)/lib/DateTime
+ $(CP) lib/DateTime/*.pir $(DESTDIR)$(PERL6_LANG_DIR)/lib/DateTime
$(MKPATH) $(DESTDIR)$(PARROT_LIB_DIR)/dynext
$(CP) $(DYNPMC) $(DYNOPS) $(DESTDIR)$(PARROT_LIB_DIR)/dynext
$(MKPATH) $(DESTDIR)$(PARROT_BIN_DIR)
@@ -401,6 +404,10 @@ $(PMC_DIR)/objectref.pmc : $(PMC_DIR)/objectref_pmc.template build/gen_objectref
Test.pir: Test.pm perl6.pbc
$(PARROT) $(PARROT_ARGS) perl6.pbc $(STAGESTATS) --target=pir --output=Test.pir Test.pm
+## loadable libraries. This should be refactored into something generic.
+lib/DateTime/strftime.pir: lib/DateTime/strftime.pm perl6.pbc
+ $(PARROT) $(PARROT_ARGS) perl6.pbc $(STAGESTATS) --target=pir --output=lib/DateTime/strftime.pir lib/DateTime/strftime.pm
+
test : coretest
fulltest: coretest spectest stresstest
diff --git a/lib/DateTime/strftime.pm b/lib/DateTime/strftime.pm
new file mode 100644
index 0000000..253f65d
--- /dev/null
+++ b/lib/DateTime/strftime.pm
@@ -0,0 +1,70 @@
+use v6;
+# A strftime() method for DateTime objects.
+# This used to use augment, but now it uses run-time role composition instead.
+#
+# use DateTime::strftime;
+# my $d = DateTime.now;
+# $d does DateTime::strftime;
+# say $d.strftime('%Y-%m-%d');
+#
+role DateTime::strftime {
+ multi method strftime( Str $format is copy ) {
+ my %substitutions =
+ # Standard substitutions for yyyy mm dd hh mm ss output.
+ 'Y' => { $.year.fmt( '%04d') },
+ 'm' => { $.month.fmt( '%02d') },
+ 'd' => { $.day.fmt( '%02d') },
+ 'H' => { $.hour.fmt( '%02d') },
+ 'M' => { $.minute.fmt('%02d') },
+ 'S' => { $.second.fmt('%02d') },
+ # Special substitutions (Posix-only subset of DateTime or libc)
+ 'a' => { $.day-name.substr(0,3) },
+ 'A' => { $.day-name },
+ 'b' => { $.month-name.substr(0,3) },
+ 'B' => { $.month-name },
+ 'C' => { ($.year/100).fmt('%02d') },
+ 'e' => { $.day.fmt('%2d') },
+ 'F' => { $.year.fmt('%04d') ~ '-' ~ $.month.fmt(
+ '%02d') ~ '-' ~ $.day.fmt('%02d') },
+ 'I' => { (($.hour+23)%12+1).fmt('%02d') },
+ 'k' => { $.hour.fmt('%2d') },
+ 'l' => { (($.hour+23)%12+1).fmt('%2d') },
+ 'n' => { "\n" },
+ 'N' => { (($.second % 1)*1000000000).fmt('%09d') },
+ 'p' => { ($.hour < 12) ?? 'am' !! 'pm' },
+ 'P' => { ($.hour < 12) ?? 'AM' !! 'PM' },
+ 'r' => { (($.hour+23)%12+1).fmt('%02d') ~ ':' ~
+ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d')
+ ~ (($.hour < 12) ?? 'am' !! 'pm') },
+ 'R' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') },
+ 's' => { $.to-epoch.fmt('%d') },
+ 't' => { "\t" },
+ 'T' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') },
+ 'u' => { ~ $.day-of-week.fmt('%d') },
+ 'w' => { ~ (($.day-of-week+6) % 7).fmt('%d') },
+ 'x' => { $.year.fmt('%04d') ~ '-' ~ $.month.fmt('%02d') ~ '-' ~ $.day.fmt('%2d') },
+ 'X' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') },
+ 'y' => { ($.year % 100).fmt('%02d') },
+ '%' => { '%' },
+ '3' => { (($.second % 1)*1000).fmt('%03d') },
+ '6' => { (($.second % 1)*1000000).fmt('%06d') },
+ '9' => { (($.second % 1)*1000000000).fmt('%09d') }
+ ;
+ my $result = '';
+ while $format ~~ / ^ (<-['%']>*) '%' (.)(.*) $ / {
+ unless %substitutions.exists(~$1) { die "unknown strftime format: %$1"; }
+ $result ~= $0 ~ %substitutions{~$1}();
+ $format = ~$2;
+ if $1 eq '3'|'6'|'9' {
+ if $format.substr(0,1) ne 'N' { die "strftime format %$1 must be followed by N"; }
+ $format = $format.substr(1);
+ }
+ }
+ # The subst for masak++'s nicer-strftime branch is NYI
+ # $format .= subst( /'%'(\w|'%')/, { (%substitutions{~$0}
+ # // die "Unknown format letter '\%$0'").() }, :global );
+ return $result ~ $format;
+ }
+
+}
+
diff --git a/src/core/Date.pm b/src/core/Date.pm
index e2a1327..3256c1b 100644
--- a/src/core/Date.pm
+++ b/src/core/Date.pm
@@ -1,33 +1,42 @@
-class Date {
- sub is-leap($year) {
+role DateLike {
+ method !is-leap($year) {
return False if $year % 4;
return True if $year % 100;
$year % 400 == 0;
}
- sub days-in-month($year, $month) {
+ method !days-in-month($year, $month) {
my @month-length = 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31;
if ($month == 2) {
- is-leap($year) ?? 29 !! 28;
+ self!is-leap($year) ?? 29 !! 28;
} else {
@month-length[$month-1];
}
}
- sub assert-valid-date($year, $month, $day) {
+ 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 = days-in-month($year, $month);
+ my $dim = self!days-in-month($year, $month);
if $day > $dim {
die "Invalid date: day > $dim";
}
}
+
has Int $.year;
- has Int $.month;
- has Int $.day;
+ has Int $.month = 1;
+ has Int $.day = 1;
+
+ method leap-year() { self!is-leap($.year) }
+ method days-in-month() { self!days-in-month($.year, $.month) }
+
+}
+
+class Date does DateLike {
- has Int $.daycount = self!daycount-from-ymd($!year, $!month, $!day);
+ has Int $.daycount; # = self!daycount-from-ymd($!year, $!month, $!day);
+ ## Assignment from here does not currently work. Moving to new().
method !daycount-from-ymd($y is copy, $m is copy, $d) {
# taken from <http://www.merlyn.demon.co.uk/daycount.htm>
@@ -60,25 +69,20 @@ class Date {
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);
+ }
- # TODO: checking for out-of-range errors
multi method new($year, $month, $day) {
- assert-valid-date($year, $month, $day);
- self.bless(*, :$year, :$month, :$day);
- }
- multi method new(:$year, :$month, :$day) {
- assert-valid-date($year, $month, $day);
- self.bless(*, :$year, :$month, :$day);
+ self.new(:$year, :$month, :$day);
}
multi method new(Str $date where { $date ~~ /
^ <[0..9]>**4 '-' <[0..9]>**2 '-' <[0..9]>**2 $
/}) {
- my ($year, $month, $day) = $date.split('-').map({ .Int });
- assert-valid-date($year, $month, $day);
- self.bless(*, :$year, :$month, :$day);
-# RAKUDO: doesn't work yet - find out why
-# self.new(|$date.split('-'));
+ self.new(|$date.split('-').map({ .Int }));
}
multi method new-from-daycount($daycount) {
@@ -87,17 +91,22 @@ class Date {
}
multi method new(::DateTime $dt) {
- self.bless(*, :year($dt.year), :month($dt.month), :day($dt.day));
+ 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.bless(*, :year($dt.year), :month($dt.month), :day($dt.day));
+ self.new($dt);
}
+ method DateTime(*%_) {
+ return ::DateTime.new(:year($.year), :month($.month), :day($.day), |%_);
+ }
+
method day-of-week() { 1 + (($!daycount + 2) % 7) }
- method leap-year() { is-leap($.year) }
- method days-in-month() { days-in-month($.year, $.month) }
multi method Str() {
sprintf '%04d-%02d-%02d', $.year, $.month, $.day;
diff --git a/src/core/Temporal.pm b/src/core/Temporal.pm
index b5f8289..ed5e081 100644
--- a/src/core/Temporal.pm
+++ b/src/core/Temporal.pm
@@ -25,42 +25,53 @@ class DefaultFormatter {
}
}
-class DateTime {
- has $.year;
- has $.month = 1;
- has $.day = 1;
- has $.hour = 0;
- has $.minute = 0;
- has $.second = 0.0;
- has $.time-zone = '+0000';
+class DateTime does DateLike {
+ 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
- multi method new(Int :$year!, *%_) {
- self.bless(*, :$year, :formatter(DefaultFormatter.new), |%_);
+ 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;
}
- # The parse() method should actually be an MMD variant of new(), but
- # somehow that did not work :-( Patches welcome.
- multi method parse(Str $format) {
+ multi method new(:$year!, Bool :$noassert=Bool::False, :$formatter=DefaultFormatter.new, *%_) {
+ if !$noassert {
+ self!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 $time-zone = ~$6;
- self.bless(*, :$year, :$month, :$day, :$hour, :$minute,
- :$second, :$time-zone, :formatter(DefaultFormatter.new) );
+ 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.parse expects an ISO8601 string\n";
+ die "DateTime.new(Str) expects an ISO8601 string\n";
}
}
- multi method from-epoch($epoch, :$timezone, :$formatter=DefaultFormatter.new) {
+ 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;
@@ -81,7 +92,7 @@ class DateTime {
my $year = $b * 100 + $d - 4800 + $m div 10;
self.new(:$year, :$month, :$day,
:$hour, :$minute, :$second,
- :$timezone, :$formatter);
+ :$timezone, :$formatter, :noassert);
}
multi method to-epoch {
@@ -117,71 +128,13 @@ class DateTime {
# 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') ~ $.time-zone;
+ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') ~ $.timezone;
}
method Str() {
$!formatter.fmt-datetime(self);
}
- multi method strftime( Str $format is copy ) {
- my %substitutions =
- # Standard substitutions for yyyy mm dd hh mm ss output.
- 'Y' => { $.year.fmt( '%04d') },
- 'm' => { $.month.fmt( '%02d') },
- 'd' => { $.day.fmt( '%02d') },
- 'H' => { $.hour.fmt( '%02d') },
- 'M' => { $.minute.fmt('%02d') },
- 'S' => { $.second.fmt('%02d') },
- # Special substitutions (Posix-only subset of DateTime or libc)
- 'a' => { $.day-name.substr(0,3) },
- 'A' => { $.day-name },
- 'b' => { $.month-name.substr(0,3) },
- 'B' => { $.month-name },
- 'C' => { ($.year/100).fmt('%02d') },
- 'e' => { $.day.fmt('%2d') },
- 'F' => { $.year.fmt('%04d') ~ '-' ~ $.month.fmt(
- '%02d') ~ '-' ~ $.day.fmt('%02d') },
- 'I' => { (($.hour+23)%12+1).fmt('%02d') },
- 'k' => { $.hour.fmt('%2d') },
- 'l' => { (($.hour+23)%12+1).fmt('%2d') },
- 'n' => { "\n" },
- 'N' => { (($.second % 1)*1000000000).fmt('%09d') },
- 'p' => { ($.hour < 12) ?? 'am' !! 'pm' },
- 'P' => { ($.hour < 12) ?? 'AM' !! 'PM' },
- 'r' => { (($.hour+23)%12+1).fmt('%02d') ~ ':' ~
- $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d')
- ~ (($.hour < 12) ?? 'am' !! 'pm') },
- 'R' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') },
- 's' => { $.to-epoch.fmt('%d') },
- 't' => { "\t" },
- 'T' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') },
- 'u' => { ~ $.day-of-week.fmt('%d') },
- 'w' => { ~ (($.day-of-week+6) % 7).fmt('%d') },
- 'x' => { $.year.fmt('%04d') ~ '-' ~ $.month.fmt('%02d') ~ '-' ~ $.day.fmt('%2d') },
- 'X' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') },
- 'y' => { ($.year % 100).fmt('%02d') },
- '%' => { '%' },
- '3' => { (($.second % 1)*1000).fmt('%03d') },
- '6' => { (($.second % 1)*1000000).fmt('%06d') },
- '9' => { (($.second % 1)*1000000000).fmt('%09d') }
- ;
- my $result = '';
- while $format ~~ / ^ (<-['%']>*) '%' (.)(.*) $ / {
- unless %substitutions.exists(~$1) { die "unknown strftime format: %$1"; }
- $result ~= $0 ~ %substitutions{~$1}();
- $format = ~$2;
- if $1 eq '3'|'6'|'9' {
- if $format.substr(0,1) ne 'N' { die "strftime format %$1 must be followed by N"; }
- $format = $format.substr(1);
- }
- }
- # The subst for masak++'s nicer-strftime branch is NYI
- # $format .= subst( /'%'(\w|'%')/, { (%substitutions{~$0}
- # // die "Unknown format letter '\%$0'").() }, :global );
- return $result ~ $format;
- }
-
multi method truncate($unit) {
die 'Unknown truncation unit'
if $unit eq none(<second minute hour day month>);
@@ -225,14 +178,17 @@ class DateTime {
method set(:$year, :$month, :$day,
:$hour, :$minute, :$second,
- :$time-zone, :$formatter) {
+ :$timezone, :$formatter) {
# Do this first so that the other nameds have a chance to
# override.
- if defined $time-zone {
+ if defined $timezone {
# First attempt. Probably wrong.
- my $difference = $time-zone - $!time-zone;
- $!hour += $difference;
- $!time-zone = $time-zone;
+ # 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;
@@ -252,13 +208,18 @@ class DateTime {
method set-hour($hour) { self.set(:$hour) }
method set-minute($minute) { self.set(:$minute) }
method set-second($second) { self.set(:$second) }
- method set-time-zone($time-zone) { self.set(:$time-zone) }
+ 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
@@ -276,8 +237,8 @@ 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>
-To accommodate more Temporal expectations without bloating the core executable, I am planning to move DateTime::strftime into a loadable module. The move will also validate how tools handle "core modules" (eg copying, compiling to PIR) beyond only Test.pm.
-If it works, I intend to gradually move more non essential code (a subjective call, admittedly) as possible into loadable modules. Which actual code moves is less important, using the capability is more important.
-
+As per the recommendation, the strftime() method has bee moved into a
+loadable module called DateTime::strftime.
+
=end pod
diff --git a/t/spectest.data b/t/spectest.data
index 8d04c77..570d198 100644
--- a/t/spectest.data
+++ b/t/spectest.data
@@ -576,6 +576,7 @@ S32-str/uc.t # icu
S32-str/words.t # icu
S32-temporal/Date.t
S32-temporal/DateTime.t
+S32-temporal/DateTime-strftime.t
S32-trig/e.t
# S32-trig/pi.t
S32-trig/sin.t
--
1.6.0.4
|
From @supernovusI have attached a new patch that replaces the old one. The changes in this patch are much simpler, based on recommendations from |
From @supernovus0001-Temporal-Date-modifications-and-refactoring.patchFrom bf3296e17e87c4059bb8440cacf5ccf36f75f2b7 Mon Sep 17 00:00:00 2001
From: Timothy Totten <2010@huri.net>
Date: Sat, 3 Jul 2010 18:29:16 -0700
Subject: [PATCH] Temporal/Date modifications and refactoring.
Changed how DateTime::strftime works.
Added DateTime::strftime to Makefile.in
Changed time-zone to timezone as per spec.
Changed DateTime.parse() to DateTime.new() as per spec.
Temporal => DateTime, and simplified changes.
---
.gitignore | 1 +
build/Makefile.in | 13 ++-
lib/DateTime/strftime.pm | 62 ++++++++++
src/core/Date.pm | 56 +++++----
src/core/DateTime.pm | 248 ++++++++++++++++++++++++++++++++++++++++
src/core/Temporal.pm | 283 ----------------------------------------------
t/spectest.data | 1 +
7 files changed, 353 insertions(+), 311 deletions(-)
create mode 100644 lib/DateTime/strftime.pm
create mode 100644 src/core/DateTime.pm
delete mode 100644 src/core/Temporal.pm
diff --git a/.gitignore b/.gitignore
index defc2cc..fc65063 100644
--- a/.gitignore
+++ b/.gitignore
@@ -36,3 +36,4 @@ src/binder/bind.bundle
src/binder/bind.o
docs/test_summary.times
docs/test_summary.times.tmp
+lib/DateTime/strftime.pir
diff --git a/build/Makefile.in b/build/Makefile.in
index 4febd81..3baff0a 100644
--- a/build/Makefile.in
+++ b/build/Makefile.in
@@ -226,7 +226,7 @@ CORE_SOURCES = \
src/cheats/match-bool.pm \
src/cheats/process.pm \
src/core/Date.pm \
- src/core/Temporal.pm \
+ src/core/DateTime.pm \
src/core/Match.pm \
src/core/Attribute.pm \
src/core/CallFrame.pm \
@@ -283,8 +283,8 @@ HARNESS_WITH_FUDGE_JOBS = $(HARNESS_WITH_FUDGE) --jobs
STAGESTATS = @stagestats@
-# the default target
-all: $(PERL6_EXE) Test.pir
+# the default target, TODO: make libraries in 'lib' a variable.
+all: $(PERL6_EXE) Test.pir lib/DateTime/strftime.pir
# the install target
install: all
@@ -293,6 +293,9 @@ install: all
$(CP) Test.pm $(DESTDIR)$(PERL6_LANG_DIR)/lib
$(CP) Test.pir $(DESTDIR)$(PERL6_LANG_DIR)/lib
$(CP) lib/*.pm $(DESTDIR)$(PERL6_LANG_DIR)/lib
+ $(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/lib/DateTime
+ $(CP) lib/DateTime/*.pm $(DESTDIR)$(PERL6_LANG_DIR)/lib/DateTime
+ $(CP) lib/DateTime/*.pir $(DESTDIR)$(PERL6_LANG_DIR)/lib/DateTime
$(MKPATH) $(DESTDIR)$(PARROT_LIB_DIR)/dynext
$(CP) $(DYNPMC) $(DYNOPS) $(DESTDIR)$(PARROT_LIB_DIR)/dynext
$(MKPATH) $(DESTDIR)$(PARROT_BIN_DIR)
@@ -405,6 +408,10 @@ $(PMC_DIR)/objectref.pmc : $(PMC_DIR)/objectref_pmc.template build/gen_objectref
Test.pir: Test.pm perl6.pbc
$(PARROT) $(PARROT_ARGS) perl6.pbc $(STAGESTATS) --target=pir --output=Test.pir Test.pm
+## loadable libraries. This should be refactored into something generic.
+lib/DateTime/strftime.pir: lib/DateTime/strftime.pm perl6.pbc
+ $(PARROT) $(PARROT_ARGS) perl6.pbc $(STAGESTATS) --target=pir --output=lib/DateTime/strftime.pir lib/DateTime/strftime.pm
+
test : coretest
fulltest: coretest stresstest
diff --git a/lib/DateTime/strftime.pm b/lib/DateTime/strftime.pm
new file mode 100644
index 0000000..677641a
--- /dev/null
+++ b/lib/DateTime/strftime.pm
@@ -0,0 +1,62 @@
+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.
+ 'Y' => { $dt.year.fmt( '%04d') },
+ 'm' => { $dt.month.fmt( '%02d') },
+ 'd' => { $dt.day.fmt( '%02d') },
+ 'H' => { $dt.hour.fmt( '%02d') },
+ 'M' => { $dt.minute.fmt('%02d') },
+ 'S' => { $dt.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 },
+ 'C' => { ($dt.year/100).fmt('%02d') },
+ 'e' => { $dt.day.fmt('%2d') },
+ 'F' => { $dt.year.fmt('%04d') ~ '-' ~ $dt.month.fmt(
+ '%02d') ~ '-' ~ $dt.day.fmt('%02d') },
+ 'I' => { (($dt.hour+23)%12+1).fmt('%02d') },
+ 'k' => { $dt.hour.fmt('%2d') },
+ 'l' => { (($dt.hour+23)%12+1).fmt('%2d') },
+ 'n' => { "\n" },
+ 'N' => { (($dt.second % 1)*1000000000).fmt('%09d') },
+ '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')
+ ~ (($.hour < 12) ?? 'am' !! 'pm') },
+ 'R' => { $dt.hour.fmt('%02d') ~ ':' ~ $dt.minute.fmt('%02d') },
+ 's' => { $dt.to-epoch.fmt('%d') },
+ 't' => { "\t" },
+ 'T' => { $dt.hour.fmt('%02d') ~ ':' ~ $dt.minute.fmt('%02d') ~ ':' ~ $dt.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') },
+ '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') }
+ ;
+ my $result = '';
+ while $format ~~ / ^ (<-['%']>*) '%' (.)(.*) $ / {
+ unless %substitutions.exists(~$1) { die "unknown strftime format: %$1"; }
+ $result ~= $0 ~ %substitutions{~$1}();
+ $format = ~$2;
+ if $1 eq '3'|'6'|'9' {
+ if $format.substr(0,1) ne 'N' { die "strftime format %$1 must be followed by N"; }
+ $format = $format.substr(1);
+ }
+ }
+ # The subst for masak++'s nicer-strftime branch is NYI
+ # $format .= subst( /'%'(\w|'%')/, { (%substitutions{~$0}
+ # // die "Unknown format letter '\%$0'").() }, :global );
+ return $result ~ $format;
+ }
+}
+
diff --git a/src/core/Date.pm b/src/core/Date.pm
index e2a1327..74e84c4 100644
--- a/src/core/Date.pm
+++ b/src/core/Date.pm
@@ -1,33 +1,39 @@
class Date {
- sub is-leap($year) {
+
+ 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;
}
- sub days-in-month($year, $month) {
+ 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) {
- is-leap($year) ?? 29 !! 28;
+ self.is-leap($year) ?? 29 !! 28;
} else {
@month-length[$month-1];
}
}
- sub assert-valid-date($year, $month, $day) {
+ 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 = days-in-month($year, $month);
+ my $dim = self.days-in-month($year, $month);
if $day > $dim {
die "Invalid date: day > $dim";
}
}
- has Int $.year;
- has Int $.month;
- has Int $.day;
- has Int $.daycount = self!daycount-from-ymd($!year, $!month, $!day);
+ 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>
@@ -60,25 +66,20 @@ class Date {
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);
+ }
- # TODO: checking for out-of-range errors
multi method new($year, $month, $day) {
- assert-valid-date($year, $month, $day);
- self.bless(*, :$year, :$month, :$day);
- }
- multi method new(:$year, :$month, :$day) {
- assert-valid-date($year, $month, $day);
- self.bless(*, :$year, :$month, :$day);
+ self.new(:$year, :$month, :$day);
}
multi method new(Str $date where { $date ~~ /
^ <[0..9]>**4 '-' <[0..9]>**2 '-' <[0..9]>**2 $
/}) {
- my ($year, $month, $day) = $date.split('-').map({ .Int });
- assert-valid-date($year, $month, $day);
- self.bless(*, :$year, :$month, :$day);
-# RAKUDO: doesn't work yet - find out why
-# self.new(|$date.split('-'));
+ self.new(|$date.split('-').map({ .Int }));
}
multi method new-from-daycount($daycount) {
@@ -87,17 +88,22 @@ class Date {
}
multi method new(::DateTime $dt) {
- self.bless(*, :year($dt.year), :month($dt.month), :day($dt.day));
+ 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.bless(*, :year($dt.year), :month($dt.month), :day($dt.day));
+ self.new($dt);
}
+ method DateTime(*%_) {
+ return ::DateTime.new(:year($.year), :month($.month), :day($.day), |%_);
+ }
+
method day-of-week() { 1 + (($!daycount + 2) % 7) }
- method leap-year() { is-leap($.year) }
- method days-in-month() { days-in-month($.year, $.month) }
multi method Str() {
sprintf '%04d-%02d-%02d', $.year, $.month, $.day;
diff --git a/src/core/DateTime.pm b/src/core/DateTime.pm
new file mode 100644
index 0000000..5aae560
--- /dev/null
+++ b/src/core/DateTime.pm
@@ -0,0 +1,248 @@
+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
deleted file mode 100644
index b5f8289..0000000
--- a/src/core/Temporal.pm
+++ /dev/null
@@ -1,283 +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 $.year;
- has $.month = 1;
- has $.day = 1;
- has $.hour = 0;
- has $.minute = 0;
- has $.second = 0.0;
- has $.time-zone = '+0000';
-
- has DateTime::Formatter $!formatter; # = DefaultFormatter.new;
- # does not seem to work
-
- multi method new(Int :$year!, *%_) {
- self.bless(*, :$year, :formatter(DefaultFormatter.new), |%_);
- }
-
- # The parse() method should actually be an MMD variant of new(), but
- # somehow that did not work :-( Patches welcome.
- multi method parse(Str $format) {
- 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 $time-zone = ~$6;
- self.bless(*, :$year, :$month, :$day, :$hour, :$minute,
- :$second, :$time-zone, :formatter(DefaultFormatter.new) );
- }
- else {
- die "DateTime.parse expects an ISO8601 string\n";
- }
- }
-
- multi method from-epoch($epoch, :$timezone, :$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);
- }
-
- 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') ~ $.time-zone;
- }
-
- method Str() {
- $!formatter.fmt-datetime(self);
- }
-
- multi method strftime( Str $format is copy ) {
- my %substitutions =
- # Standard substitutions for yyyy mm dd hh mm ss output.
- 'Y' => { $.year.fmt( '%04d') },
- 'm' => { $.month.fmt( '%02d') },
- 'd' => { $.day.fmt( '%02d') },
- 'H' => { $.hour.fmt( '%02d') },
- 'M' => { $.minute.fmt('%02d') },
- 'S' => { $.second.fmt('%02d') },
- # Special substitutions (Posix-only subset of DateTime or libc)
- 'a' => { $.day-name.substr(0,3) },
- 'A' => { $.day-name },
- 'b' => { $.month-name.substr(0,3) },
- 'B' => { $.month-name },
- 'C' => { ($.year/100).fmt('%02d') },
- 'e' => { $.day.fmt('%2d') },
- 'F' => { $.year.fmt('%04d') ~ '-' ~ $.month.fmt(
- '%02d') ~ '-' ~ $.day.fmt('%02d') },
- 'I' => { (($.hour+23)%12+1).fmt('%02d') },
- 'k' => { $.hour.fmt('%2d') },
- 'l' => { (($.hour+23)%12+1).fmt('%2d') },
- 'n' => { "\n" },
- 'N' => { (($.second % 1)*1000000000).fmt('%09d') },
- 'p' => { ($.hour < 12) ?? 'am' !! 'pm' },
- 'P' => { ($.hour < 12) ?? 'AM' !! 'PM' },
- 'r' => { (($.hour+23)%12+1).fmt('%02d') ~ ':' ~
- $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d')
- ~ (($.hour < 12) ?? 'am' !! 'pm') },
- 'R' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') },
- 's' => { $.to-epoch.fmt('%d') },
- 't' => { "\t" },
- 'T' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') },
- 'u' => { ~ $.day-of-week.fmt('%d') },
- 'w' => { ~ (($.day-of-week+6) % 7).fmt('%d') },
- 'x' => { $.year.fmt('%04d') ~ '-' ~ $.month.fmt('%02d') ~ '-' ~ $.day.fmt('%2d') },
- 'X' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') },
- 'y' => { ($.year % 100).fmt('%02d') },
- '%' => { '%' },
- '3' => { (($.second % 1)*1000).fmt('%03d') },
- '6' => { (($.second % 1)*1000000).fmt('%06d') },
- '9' => { (($.second % 1)*1000000000).fmt('%09d') }
- ;
- my $result = '';
- while $format ~~ / ^ (<-['%']>*) '%' (.)(.*) $ / {
- unless %substitutions.exists(~$1) { die "unknown strftime format: %$1"; }
- $result ~= $0 ~ %substitutions{~$1}();
- $format = ~$2;
- if $1 eq '3'|'6'|'9' {
- if $format.substr(0,1) ne 'N' { die "strftime format %$1 must be followed by N"; }
- $format = $format.substr(1);
- }
- }
- # The subst for masak++'s nicer-strftime branch is NYI
- # $format .= subst( /'%'(\w|'%')/, { (%substitutions{~$0}
- # // die "Unknown format letter '\%$0'").() }, :global );
- return $result ~ $format;
- }
-
- 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,
- :$time-zone, :$formatter) {
- # Do this first so that the other nameds have a chance to
- # override.
- if defined $time-zone {
- # First attempt. Probably wrong.
- my $difference = $time-zone - $!time-zone;
- $!hour += $difference;
- $!time-zone = $time-zone;
- }
-
- $!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-time-zone($time-zone) { self.set(:$time-zone) }
- method set-formatter($formatter) { self.set(:$formatter) }
-
- method Date() {
- return ::Date.new(self);
- }
-
-}
-
-=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>
-
-To accommodate more Temporal expectations without bloating the core executable, I am planning to move DateTime::strftime into a loadable module. The move will also validate how tools handle "core modules" (eg copying, compiling to PIR) beyond only Test.pm.
-If it works, I intend to gradually move more non essential code (a subjective call, admittedly) as possible into loadable modules. Which actual code moves is less important, using the capability is more important.
-
-=end pod
-
diff --git a/t/spectest.data b/t/spectest.data
index f187282..0f7d7c4 100644
--- a/t/spectest.data
+++ b/t/spectest.data
@@ -581,6 +581,7 @@ S32-str/uc.t # icu
S32-str/words.t # icu
S32-temporal/Date.t
S32-temporal/DateTime.t
+S32-temporal/DateTime-strftime.t
S32-trig/e.t
# S32-trig/pi.t
S32-trig/sin.t # long
--
1.6.0.4
|
|
@supernovus - Status changed from 'new' to 'open' |
From @supernovusOn Tue Jul 06 15:07:43 2010, supernovus wrote:
Changed from the original patch: * There is no more Role in use. Instead DateTime uses class methods of * The Temporal.pm file has been renamed to DateTime.pm for consistency. * The DateTime::strftime library is now a module that exports a |
From @moritzCould you please rebase the patch? It doesn't apply cleanly, and I don't (Seriously, git could do better, IMHO) |
From @moritzgood old patch -p1 worked much better. Applied, thanks for the patch. Cheers, |
|
@moritz - Status changed from 'open' to 'resolved' |
From @supernovusI have rebased the patch to the latest master branch. The latest patch replaces the existing two. On Tue, Jul 13, 2010 at 1:21 PM, Moritz Lenz via RT <
|
From @supernovus0001-Temporal-Date-modifications-and-refactoring.patchFrom 02bddb9777ae9c8f893172a0d4fa102439e0bb63 Mon Sep 17 00:00:00 2001
From: Timothy Totten <2010@huri.net>
Date: Sat, 3 Jul 2010 18:29:16 -0700
Subject: [PATCH] Temporal/Date modifications and refactoring.
Changed how DateTime::strftime works.
Added DateTime::strftime to Makefile.in
Changed time-zone to timezone as per spec.
Changed DateTime.parse() to DateTime.new() as per spec.
Temporal => DateTime, and simplified changes.
Rebased due to conflicts in latest git head.
---
.gitignore | 1 +
build/Makefile.in | 12 ++-
lib/DateTime/strftime.pm | 62 ++++++++++
src/core/Date.pm | 56 +++++----
src/core/DateTime.pm | 248 ++++++++++++++++++++++++++++++++++++++++
src/core/Temporal.pm | 283 ----------------------------------------------
t/spectest.data | 1 +
7 files changed, 352 insertions(+), 311 deletions(-)
create mode 100644 lib/DateTime/strftime.pm
create mode 100644 src/core/DateTime.pm
delete mode 100644 src/core/Temporal.pm
diff --git a/.gitignore b/.gitignore
index defc2cc..fc65063 100644
--- a/.gitignore
+++ b/.gitignore
@@ -36,3 +36,4 @@ src/binder/bind.bundle
src/binder/bind.o
docs/test_summary.times
docs/test_summary.times.tmp
+lib/DateTime/strftime.pir
diff --git a/build/Makefile.in b/build/Makefile.in
index ba22a4c..44241bf 100644
--- a/build/Makefile.in
+++ b/build/Makefile.in
@@ -225,7 +225,7 @@ CORE_SOURCES = \
src/core/system.pm \
src/cheats/process.pm \
src/core/Date.pm \
- src/core/Temporal.pm \
+ src/core/DateTime.pm \
src/core/Match.pm \
src/core/Attribute.pm \
src/core/CallFrame.pm \
@@ -282,8 +282,8 @@ HARNESS_WITH_FUDGE_JOBS = $(HARNESS_WITH_FUDGE) --jobs
STAGESTATS = @stagestats@
-# the default target
-all: $(PERL6_EXE) Test.pir
+# the default target, TODO: make libraries in 'lib' a variable.
+all: $(PERL6_EXE) Test.pir lib/DateTime/strftime.pir
# the install target
install: all
@@ -293,6 +293,9 @@ install: all
$(CP) Test.pir $(DESTDIR)$(PERL6_LANG_DIR)/lib
$(CP) lib/*.pm $(DESTDIR)$(PERL6_LANG_DIR)/lib
$(CP) lib/*.pir $(DESTDIR)$(PERL6_LANG_DIR)/lib
+ $(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/lib/DateTime
+ $(CP) lib/DateTime/*.pm $(DESTDIR)$(PERL6_LANG_DIR)/lib/DateTime
+ $(CP) lib/DateTime/*.pir $(DESTDIR)$(PERL6_LANG_DIR)/lib/DateTime
$(MKPATH) $(DESTDIR)$(PARROT_LIB_DIR)/dynext
$(CP) $(DYNPMC) $(DYNOPS) $(DESTDIR)$(PARROT_LIB_DIR)/dynext
$(MKPATH) $(DESTDIR)$(PARROT_BIN_DIR)
@@ -404,6 +407,9 @@ $(PMC_DIR)/objectref.pmc : $(PMC_DIR)/objectref_pmc.template build/gen_objectref
Test.pir: Test.pm perl6.pbc
$(PARROT) $(PARROT_ARGS) perl6.pbc $(STAGESTATS) --target=pir --output=Test.pir Test.pm
+## loadable libraries. This should be refactored into something generic.
+lib/DateTime/strftime.pir: lib/DateTime/strftime.pm perl6.pbc
+ $(PARROT) $(PARROT_ARGS) perl6.pbc $(STAGESTATS) --target=pir --output=lib/DateTime/strftime.pir lib/DateTime/strftime.pm
test : coretest
diff --git a/lib/DateTime/strftime.pm b/lib/DateTime/strftime.pm
new file mode 100644
index 0000000..677641a
--- /dev/null
+++ b/lib/DateTime/strftime.pm
@@ -0,0 +1,62 @@
+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.
+ 'Y' => { $dt.year.fmt( '%04d') },
+ 'm' => { $dt.month.fmt( '%02d') },
+ 'd' => { $dt.day.fmt( '%02d') },
+ 'H' => { $dt.hour.fmt( '%02d') },
+ 'M' => { $dt.minute.fmt('%02d') },
+ 'S' => { $dt.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 },
+ 'C' => { ($dt.year/100).fmt('%02d') },
+ 'e' => { $dt.day.fmt('%2d') },
+ 'F' => { $dt.year.fmt('%04d') ~ '-' ~ $dt.month.fmt(
+ '%02d') ~ '-' ~ $dt.day.fmt('%02d') },
+ 'I' => { (($dt.hour+23)%12+1).fmt('%02d') },
+ 'k' => { $dt.hour.fmt('%2d') },
+ 'l' => { (($dt.hour+23)%12+1).fmt('%2d') },
+ 'n' => { "\n" },
+ 'N' => { (($dt.second % 1)*1000000000).fmt('%09d') },
+ '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')
+ ~ (($.hour < 12) ?? 'am' !! 'pm') },
+ 'R' => { $dt.hour.fmt('%02d') ~ ':' ~ $dt.minute.fmt('%02d') },
+ 's' => { $dt.to-epoch.fmt('%d') },
+ 't' => { "\t" },
+ 'T' => { $dt.hour.fmt('%02d') ~ ':' ~ $dt.minute.fmt('%02d') ~ ':' ~ $dt.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') },
+ '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') }
+ ;
+ my $result = '';
+ while $format ~~ / ^ (<-['%']>*) '%' (.)(.*) $ / {
+ unless %substitutions.exists(~$1) { die "unknown strftime format: %$1"; }
+ $result ~= $0 ~ %substitutions{~$1}();
+ $format = ~$2;
+ if $1 eq '3'|'6'|'9' {
+ if $format.substr(0,1) ne 'N' { die "strftime format %$1 must be followed by N"; }
+ $format = $format.substr(1);
+ }
+ }
+ # The subst for masak++'s nicer-strftime branch is NYI
+ # $format .= subst( /'%'(\w|'%')/, { (%substitutions{~$0}
+ # // die "Unknown format letter '\%$0'").() }, :global );
+ return $result ~ $format;
+ }
+}
+
diff --git a/src/core/Date.pm b/src/core/Date.pm
index e2a1327..74e84c4 100644
--- a/src/core/Date.pm
+++ b/src/core/Date.pm
@@ -1,33 +1,39 @@
class Date {
- sub is-leap($year) {
+
+ 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;
}
- sub days-in-month($year, $month) {
+ 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) {
- is-leap($year) ?? 29 !! 28;
+ self.is-leap($year) ?? 29 !! 28;
} else {
@month-length[$month-1];
}
}
- sub assert-valid-date($year, $month, $day) {
+ 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 = days-in-month($year, $month);
+ my $dim = self.days-in-month($year, $month);
if $day > $dim {
die "Invalid date: day > $dim";
}
}
- has Int $.year;
- has Int $.month;
- has Int $.day;
- has Int $.daycount = self!daycount-from-ymd($!year, $!month, $!day);
+ 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>
@@ -60,25 +66,20 @@ class Date {
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);
+ }
- # TODO: checking for out-of-range errors
multi method new($year, $month, $day) {
- assert-valid-date($year, $month, $day);
- self.bless(*, :$year, :$month, :$day);
- }
- multi method new(:$year, :$month, :$day) {
- assert-valid-date($year, $month, $day);
- self.bless(*, :$year, :$month, :$day);
+ self.new(:$year, :$month, :$day);
}
multi method new(Str $date where { $date ~~ /
^ <[0..9]>**4 '-' <[0..9]>**2 '-' <[0..9]>**2 $
/}) {
- my ($year, $month, $day) = $date.split('-').map({ .Int });
- assert-valid-date($year, $month, $day);
- self.bless(*, :$year, :$month, :$day);
-# RAKUDO: doesn't work yet - find out why
-# self.new(|$date.split('-'));
+ self.new(|$date.split('-').map({ .Int }));
}
multi method new-from-daycount($daycount) {
@@ -87,17 +88,22 @@ class Date {
}
multi method new(::DateTime $dt) {
- self.bless(*, :year($dt.year), :month($dt.month), :day($dt.day));
+ 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.bless(*, :year($dt.year), :month($dt.month), :day($dt.day));
+ self.new($dt);
}
+ method DateTime(*%_) {
+ return ::DateTime.new(:year($.year), :month($.month), :day($.day), |%_);
+ }
+
method day-of-week() { 1 + (($!daycount + 2) % 7) }
- method leap-year() { is-leap($.year) }
- method days-in-month() { days-in-month($.year, $.month) }
multi method Str() {
sprintf '%04d-%02d-%02d', $.year, $.month, $.day;
diff --git a/src/core/DateTime.pm b/src/core/DateTime.pm
new file mode 100644
index 0000000..5aae560
--- /dev/null
+++ b/src/core/DateTime.pm
@@ -0,0 +1,248 @@
+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
deleted file mode 100644
index b5f8289..0000000
--- a/src/core/Temporal.pm
+++ /dev/null
@@ -1,283 +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 $.year;
- has $.month = 1;
- has $.day = 1;
- has $.hour = 0;
- has $.minute = 0;
- has $.second = 0.0;
- has $.time-zone = '+0000';
-
- has DateTime::Formatter $!formatter; # = DefaultFormatter.new;
- # does not seem to work
-
- multi method new(Int :$year!, *%_) {
- self.bless(*, :$year, :formatter(DefaultFormatter.new), |%_);
- }
-
- # The parse() method should actually be an MMD variant of new(), but
- # somehow that did not work :-( Patches welcome.
- multi method parse(Str $format) {
- 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 $time-zone = ~$6;
- self.bless(*, :$year, :$month, :$day, :$hour, :$minute,
- :$second, :$time-zone, :formatter(DefaultFormatter.new) );
- }
- else {
- die "DateTime.parse expects an ISO8601 string\n";
- }
- }
-
- multi method from-epoch($epoch, :$timezone, :$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);
- }
-
- 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') ~ $.time-zone;
- }
-
- method Str() {
- $!formatter.fmt-datetime(self);
- }
-
- multi method strftime( Str $format is copy ) {
- my %substitutions =
- # Standard substitutions for yyyy mm dd hh mm ss output.
- 'Y' => { $.year.fmt( '%04d') },
- 'm' => { $.month.fmt( '%02d') },
- 'd' => { $.day.fmt( '%02d') },
- 'H' => { $.hour.fmt( '%02d') },
- 'M' => { $.minute.fmt('%02d') },
- 'S' => { $.second.fmt('%02d') },
- # Special substitutions (Posix-only subset of DateTime or libc)
- 'a' => { $.day-name.substr(0,3) },
- 'A' => { $.day-name },
- 'b' => { $.month-name.substr(0,3) },
- 'B' => { $.month-name },
- 'C' => { ($.year/100).fmt('%02d') },
- 'e' => { $.day.fmt('%2d') },
- 'F' => { $.year.fmt('%04d') ~ '-' ~ $.month.fmt(
- '%02d') ~ '-' ~ $.day.fmt('%02d') },
- 'I' => { (($.hour+23)%12+1).fmt('%02d') },
- 'k' => { $.hour.fmt('%2d') },
- 'l' => { (($.hour+23)%12+1).fmt('%2d') },
- 'n' => { "\n" },
- 'N' => { (($.second % 1)*1000000000).fmt('%09d') },
- 'p' => { ($.hour < 12) ?? 'am' !! 'pm' },
- 'P' => { ($.hour < 12) ?? 'AM' !! 'PM' },
- 'r' => { (($.hour+23)%12+1).fmt('%02d') ~ ':' ~
- $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d')
- ~ (($.hour < 12) ?? 'am' !! 'pm') },
- 'R' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') },
- 's' => { $.to-epoch.fmt('%d') },
- 't' => { "\t" },
- 'T' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') },
- 'u' => { ~ $.day-of-week.fmt('%d') },
- 'w' => { ~ (($.day-of-week+6) % 7).fmt('%d') },
- 'x' => { $.year.fmt('%04d') ~ '-' ~ $.month.fmt('%02d') ~ '-' ~ $.day.fmt('%2d') },
- 'X' => { $.hour.fmt('%02d') ~ ':' ~ $.minute.fmt('%02d') ~ ':' ~ $.second.fmt('%02d') },
- 'y' => { ($.year % 100).fmt('%02d') },
- '%' => { '%' },
- '3' => { (($.second % 1)*1000).fmt('%03d') },
- '6' => { (($.second % 1)*1000000).fmt('%06d') },
- '9' => { (($.second % 1)*1000000000).fmt('%09d') }
- ;
- my $result = '';
- while $format ~~ / ^ (<-['%']>*) '%' (.)(.*) $ / {
- unless %substitutions.exists(~$1) { die "unknown strftime format: %$1"; }
- $result ~= $0 ~ %substitutions{~$1}();
- $format = ~$2;
- if $1 eq '3'|'6'|'9' {
- if $format.substr(0,1) ne 'N' { die "strftime format %$1 must be followed by N"; }
- $format = $format.substr(1);
- }
- }
- # The subst for masak++'s nicer-strftime branch is NYI
- # $format .= subst( /'%'(\w|'%')/, { (%substitutions{~$0}
- # // die "Unknown format letter '\%$0'").() }, :global );
- return $result ~ $format;
- }
-
- 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,
- :$time-zone, :$formatter) {
- # Do this first so that the other nameds have a chance to
- # override.
- if defined $time-zone {
- # First attempt. Probably wrong.
- my $difference = $time-zone - $!time-zone;
- $!hour += $difference;
- $!time-zone = $time-zone;
- }
-
- $!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-time-zone($time-zone) { self.set(:$time-zone) }
- method set-formatter($formatter) { self.set(:$formatter) }
-
- method Date() {
- return ::Date.new(self);
- }
-
-}
-
-=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>
-
-To accommodate more Temporal expectations without bloating the core executable, I am planning to move DateTime::strftime into a loadable module. The move will also validate how tools handle "core modules" (eg copying, compiling to PIR) beyond only Test.pm.
-If it works, I intend to gradually move more non essential code (a subjective call, admittedly) as possible into loadable modules. Which actual code moves is less important, using the capability is more important.
-
-=end pod
-
diff --git a/t/spectest.data b/t/spectest.data
index a66c720..3c94317 100644
--- a/t/spectest.data
+++ b/t/spectest.data
@@ -584,6 +584,7 @@ S32-str/uc.t # icu
S32-str/words.t # icu
S32-temporal/Date.t
S32-temporal/DateTime.t
+S32-temporal/DateTime-strftime.t
S32-trig/e.t
# S32-trig/pi.t
S32-trig/sin.t # long
--
1.6.0.4
|
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#76376 (status was 'resolved')
Searchable as RT76376$
The text was updated successfully, but these errors were encountered: