From 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 @@ -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, %_ // 1, %_ // 1); + self!assert-valid-time(%_ // 0, %_ // 0, %_ // 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(); @@ -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.