From 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 @@ -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 )}; +subset DateTime::Parser where { .can( all )}; + +# 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, %_ // 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 $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(); + 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 [$.month-1]; + } + + multi method day-name { + return [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 . +The Perl 5 DateTime Project home page L. +Perl 5 perldoc L and L. + +The best yet seen explanation of calendars, by Claus Tøndering +L. +Similar algorithms at L +and L. + + +