Permalink
Switch branches/tags
2016.01-preparation RT123215 RT132710-traits-from-all-multies RT132710-traits-warn-on-non-proto Routine_consolidate_flag_fields actions_shared alpha angular_bracket_literal_semantics arr-con-not-item awesome-malformed-loops better-O better-loop better_line_coverage birdless-2 birdless braids cache_most_common_cds callable-default-value callsite_flags_sso car-grant-unreduce claim-prototype coercer-fixes compiled-hyper-dispatch cont container-compare-metaop cpp cur-candidates curfs-candidates-refactor curly definedness_for_hash_and_arr_sigil dist_resources eval-server-improvements export-constant failed_match2Nil faster-permutations fix-Callable-composition fix-Hash-Mu-keys--RT-1357201 fix-R1723 fix-equiv fix-thunks fix_eval_in_precomp fix_precompilationstore_abstraction froggs_multibyte from_nqp generate_buildallplan generate_buildallplan_2 generate_buildallplan_3 glrish gmr hllbool hotfix-2015.01 hyper_threaded hyper_tracks_sequence_numbers inherit-from-nqp-class interface-inconsistency iterator_mixin_re-use jit_nativecall js jsoff json_timing_stuff jvm-begin-eval jvm-sockets jvm_interop_dispatchers jvmbl language_versions lazy-subst leave less-wrapping lex2loc2 lexical_module_load lexical_require lines-vm-chomp main_named_params master missing-clones moar-gen2-frame-opts moar/reframe monkey-implies-no-precomp more-local-lowering multidim named_pod_vars native-str-ops nativecall-cint nativecall_specialized_sub_bodies new-nil newio ng nil-assign nil-noniterable no-strict no-vm-at-startup no_p5_warnings nom nqp-dogfood nqp-lib-windows nqp-mbc optimize_for_again optimizer_lexicalref_lowering p6for_op parameter-perl parrot-690 parrot-icu-required parrot-iocleanup1-take2 platform_library_name pod-slang-tbrowder pod-table postrelease-opts pr/229 precomp-singleprocess-resurrection precomp-store-redesign priv-role-attrs prune_matches query_repos_old query_repos raccoon ratlab-fattish-rat recursive-gist regex_optimizer release/2015.07.2 relocateable-precomp remove-migration repo_v1 repository_registry rescalar resources return-type-check-plugin return-without-lexotic richer-positional role_diamond rt-127977 rt128156_fix_precomp_deps_validation safely_stringify_core_exceptions scientific-notation-using-div_In segv-coercer-qast setdispatcherfor setops sha1bin sigsp sink-phasers sized-arrays smile spacey spesh-plugins speshplugin_guardstaticcode staged-settings standalone-jar supplier-preserving-refactor support_meta_classes_written_in_perl6 support_perl6_meta_classes there_is_no_return tmp_highfive try-does-use-fatal tune-hash udp_receive_hostname_port undefinitehow-default-defaults unfaster-words unifyunit use-nqp varopt vmarray-list vmarray whenever_last_redo wip-openpipe worry_broken_heredoc_stopper
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
450 lines (411 sloc) 15.6 KB
my class DateTime does Dateish {
has int $.hour;
has int $.minute;
has $.second;
has int $.timezone; # UTC
# Not an optimization but a necessity to ensure that
# $dt.utc.local.utc is equivalent to $dt.utc. Otherwise,
# DST-induced ambiguity could ruin our day.
method !formatter() { # ISO 8601 timestamp
sprintf '%s-%02d-%02dT%02d:%02d:%s%s',
self!year-Str, $!month, $!day, $!hour, $!minute,
$!second.floor == $!second
?? $!second.Int.fmt('%02d')
!! $!second.fmt('%09.6f'),
$!timezone == 0
?? 'Z'
!! $!timezone > 0
?? sprintf('+%02d:%02d',
($!timezone/3600).floor,
($!timezone/60%60).floor)
!! sprintf('-%02d:%02d',
($!timezone.abs/3600).floor,
($!timezone.abs/60%60).floor)
}
my $valid-units := nqp::hash(
'second', 0,
'seconds', 0,
'minute', 0,
'minutes', 0,
'hour', 0,
'hours', 0,
'day', 0,
'days', 0,
'week', 0,
'weeks', 0,
'month', 1,
'months', 1,
'year', 1,
'years', 1,
);
method !VALID-UNIT($unit) {
nqp::existskey($valid-units,$unit)
?? $unit
!! X::DateTime::InvalidDeltaUnit.new(:$unit).throw
}
method !SET-SELF(
$!year,
$!month,
$!day,
$!hour,
$!minute,
$!second,
$!timezone,
&!formatter,
) {
self
}
method !new-from-positional(DateTime:
Int() $year,
Int() $month,
Int() $day,
Int() $hour,
Int() $minute,
$second, # can have fractional seconds
%extra,
:$timezone = 0,
:&formatter,
) {
1 <= $month <= 12
|| X::OutOfRange.new(:what<Month>,:got($month),:range<1..12>).throw;
1 <= $day <= self!DAYS-IN-MONTH($year,$month)
|| X::OutOfRange.new(
:what<Day>,
:got($day),
:range("1..{self!DAYS-IN-MONTH($year,$month)}")
).throw;
0 <= $hour <= 23
|| X::OutOfRange.new(:what<Hour>,:got($hour),:range<0..23>).throw;
0 <= $minute <= 59
|| X::OutOfRange.new(:what<Minute>,:got($minute),:range<0..59>).throw;
(^61).in-range($second,'Second'); # some weird semantics need this
my $dt = nqp::eqaddr(self.WHAT,DateTime)
?? nqp::create(self)!SET-SELF(
$year,$month,$day,$hour,$minute,$second,$timezone,&formatter)
!! self.bless(
:$year,:$month,:$day,
:$hour,:$minute,:$second,:$timezone,:&formatter,|%extra);
$second >= 60 ?? $dt!check-leap-second !! $dt
}
method !check-leap-second {
my $utc := $!timezone ?? self.utc !! self;
X::OutOfRange.new(
what => 'Second',
range => "0..^60",
got => $!second,
comment => 'a leap second can occur only at 23:59',
).throw unless $utc.hour == 23 && $utc.minute == 59;
my $date := $utc.yyyy-mm-dd;
X::OutOfRange.new(
what => 'Second',
range => "0..^60",
got => $!second,
comment => "There is no leap second on UTC $date",
).throw unless Rakudo::Internals.is-leap-second-date($date);
self
}
proto method new(|) {*}
multi method new(DateTime:
\y,\mo,\d,\h,\mi,\s,:$timezone = 0,:&formatter,*%_) {
self!new-from-positional(y,mo,d,h,mi,s,%_,:$timezone,:&formatter)
}
multi method new(DateTime:
:$year!,
:$month = 1,
:$day = 1,
:$hour = 0,
:$minute = 0,
:$second = 0,
:$timezone = 0,
:&formatter,
*%_
) {
self!new-from-positional(
$year,$month,$day,$hour,$minute,$second,%_,:$timezone,:&formatter)
}
multi method new(DateTime: Date:D :$date!, *%_) {
self.new(:year($date.year),:month($date.month),:day($date.day),|%_)
}
multi method new(DateTime: Instant:D $i, :$timezone = 0, *%_) {
my ($p, $leap-second) = $i.to-posix;
my $dt = self.new( floor($p - $leap-second).Int, |%_ );
$dt.clone(
:second($dt.second + $p % 1 + $leap-second), |%_
).in-timezone($timezone)
}
multi method new(DateTime:
Numeric:D $time is copy, :$timezone = 0, :&formatter, *%_
) {
# Interpret $time as a POSIX time.
my $second = $time % 60; $time = $time.Int div 60;
my int $minute = $time % 60; $time = $time div 60;
my int $hour = $time % 24; $time = $time div 24;
# Day month and leap year arithmetic, based on Gregorian day #.
# 2000-01-01 noon UTC == 2451558.0 Julian == 2451545.0 Gregorian
$time += 2440588; # because 2000-01-01 == Unix epoch day 10957
my Int $a = $time + 32044; # date algorithm from Claus Tøndering
my Int $b = (4 * $a + 3) div 146097; # 146097 = days in 400 years
my Int $c = $a - (146097 * $b) div 4;
my Int $d = (4 * $c + 3) div 1461; # 1461 = days in 4 years
my Int $e = $c - ($d * 1461) div 4;
my Int $m = (5 * $e + 2) div 153; # 153 = days in Mar-Jul Aug-Dec
my int $day = $e - (153 * $m + 2) div 5 + 1;
my int $month = $m + 3 - 12 * ($m div 10);
my Int $year = $b * 100 + $d - 4800 + $m div 10;
my $dt = nqp::eqaddr(self.WHAT,DateTime)
?? ( %_ ?? die "Unexpected named parameter{"s" if %_ > 1} "
~ %_.keys.map({"`$_`"}).join(", ") ~ " passed. Were you "
~ "trying to use the named parameter form of .new() but "
~ "accidentally passed one named parameter as a positional?"
!! nqp::create(self)!SET-SELF(
$year,$month,$day,$hour,$minute,$second,0,&formatter)
) !! self.bless(
:$year,:$month,:$day,
:$hour,:$minute,:$second,:timezone(0),:&formatter,|%_);
$timezone ?? $dt.in-timezone($timezone) !! $dt
}
multi method new(DateTime:
Str:D $datetime, :$timezone is copy, :&formatter, *%_
) {
X::Temporal::InvalidFormat.new(
invalid-str => $datetime,
target => 'DateTime',
format => 'an ISO 8601 timestamp (yyyy-mm-ddThh:mm:ssZ or yyyy-mm-ddThh:mm:ss+01:00)',
).throw unless $datetime.chars == $datetime.codes and $datetime ~~ /^
(<[+-]>? \d**4 \d*) # year
'-'
(\d\d) # month
'-'
(\d\d) # day
<[Tt]> # time separator
(\d\d) # hour
':'
(\d\d) # minute
':'
(\d\d[<[\.,]>\d ** 1..6]?) # second
(<[Zz]> || (<[\-\+]>) (\d\d) (':'? (\d\d))? )? # timezone
$/;
if $6 {
X::DateTime::TimezoneClash.new.throw with $timezone;
if $6.chars != 1 {
X::OutOfRange.new(
what => "minutes of timezone",
got => +$6[2][0],
range => "0..^60",
).throw if $6[2] && $6[2][0] > 59;
$timezone = (($6[1]*60 + ($6[2][0] // 0)) * 60).Int;
# RAKUDO: .Int is needed to avoid to avoid the nasty '-0'.
$timezone = -$timezone if $6[0] eq '-';
}
}
$timezone //= 0;
self!new-from-positional(
$0,$1,$2,$3,$4,+(~$5.subst(",",".")),%_,:$timezone,:&formatter)
}
method now(:$timezone=$*TZ, :&formatter --> DateTime:D) {
self.new(nqp::time_n(), :$timezone, :&formatter)
}
method clone(*%_) {
my \h := nqp::getattr(%_,Map,'$!storage');
self!new-from-positional(
nqp::ifnull(nqp::atkey(h,'year'), $!year),
nqp::ifnull(nqp::atkey(h,'month'), $!month),
nqp::ifnull(nqp::atkey(h,'day'), $!day),
nqp::ifnull(nqp::atkey(h,'hour'), $!hour),
nqp::ifnull(nqp::atkey(h,'minute'),$!minute),
nqp::ifnull(nqp::atkey(h,'second'),$!second),
%_,
timezone => nqp::ifnull(nqp::atkey(h,'timezone'),$!timezone),
formatter => nqp::ifnull(nqp::atkey(h,'formatter'),&!formatter),
)
}
method !clone-without-validating(*%_) { # A premature optimization.
nqp::if(
nqp::eqaddr(self.WHAT,DateTime),
nqp::stmts(
(my \h := nqp::getattr(%_,Map,'$!storage')),
nqp::create(self)!SET-SELF(
nqp::ifnull(nqp::atkey(h,'year'), $!year),
nqp::ifnull(nqp::atkey(h,'month'), $!month),
nqp::ifnull(nqp::atkey(h,'day'), $!day),
nqp::ifnull(nqp::atkey(h,'hour'), $!hour),
nqp::ifnull(nqp::atkey(h,'minute'), $!minute),
nqp::ifnull(nqp::atkey(h,'second'), $!second),
nqp::ifnull(nqp::atkey(h,'timezone'),$!timezone),
&!formatter,
)
),
self.clone(|%_)
)
}
method Instant() {
Instant.from-posix: self.posix + $!second % 1, $!second >= 60;
}
method posix($ignore-timezone?) {
return self.utc.posix if $!timezone && !$ignore-timezone;
# algorithm from Claus Tøndering
my int $a = (14 - $!month) div 12;
my int $y = $!year + 4800 - $a;
my int $m = $!month + 12 * $a - 3;
my int $jd = $!day + (153 * $m + 2) div 5 + 365 * $y
+ $y div 4 - $y div 100 + $y div 400 - 32045;
($jd - 2440588) * 86400
+ $!hour * 3600
+ $!minute * 60
+ self.whole-second
}
method offset() { $!timezone }
method offset-in-minutes() { $!timezone / 60 }
method offset-in-hours() { $!timezone / 3600 }
method hh-mm-ss() { sprintf "%02d:%02d:%02d", $!hour,$!minute,$!second }
method later(:$earlier, *%unit) {
# basic sanity check
nqp::if(
nqp::eqaddr(
(my \later := (my \iterator := %unit.iterator).pull-one),
IterationEnd
),
(die "No time unit supplied"),
nqp::unless(
nqp::eqaddr(iterator.pull-one,IterationEnd),
(die "More than one time unit supplied")
)
);
my $unit := later.key;
my $amount = later.value;
$amount = -$amount if $earlier;
# work on instant (tai)
if $unit.starts-with('second') {
self.new(self.Instant + $amount, :$!timezone, :&!formatter)
}
else {
$amount .= Int;
# on a leap second and not moving by second
if $!second >= 60 {
my $dt := self!clone-without-validating(
:second($!second-1)).later(|($unit => $amount));
$dt.hour == 23 && $dt.minute == 59 && $dt.second >= 59
&& Rakudo::Internals.is-leap-second-date($dt.yyyy-mm-dd)
?? $dt!clone-without-validating(:$!second)
!! $dt
}
# month,year
elsif nqp::atkey($valid-units,$unit) {
my $date :=
Date.new($!year,$!month,$!day).later(|($unit => $amount));
nqp::create(self)!SET-SELF(
nqp::getattr($date,Date,'$!year'),
nqp::getattr($date,Date,'$!month'),
nqp::getattr($date,Date,'$!day'),
$!hour, $!minute, $!second, $!timezone, &!formatter
)
}
# minute,hour,day,week
else {
my int $minute = $!minute;
my int $hour = $!hour;
$minute += $amount if $unit.starts-with('minute');
$hour += floor($minute / 60);
$minute %= 60;
$hour += $amount if $unit.starts-with('hour');
my $day-delta = floor($hour / 24);
$hour %= 24;
$day-delta = $amount if $unit.starts-with('day');
$day-delta = 7 * $amount if $unit.starts-with('week');
my $date := Date.new-from-daycount(self.daycount + $day-delta);
nqp::create(self)!SET-SELF(
nqp::getattr($date,Date,'$!year'),
nqp::getattr($date,Date,'$!month'),
nqp::getattr($date,Date,'$!day'),
$hour, $minute, $!second, $!timezone, &!formatter)
}
}
}
method truncated-to(Cool $unit) {
my %parts;
given self!VALID-UNIT($unit) {
%parts<second> = self.whole-second;
when 'second' | 'seconds' {}
%parts<second> = 0;
when 'minute' | 'minutes' {}
%parts<minute> = 0;
when 'hour' | 'hours' {}
%parts<hour> = 0;
when 'day' | 'days' {}
%parts = self!truncate-ymd($unit, %parts);
}
self!clone-without-validating(|%parts);
}
method whole-second() { $!second.Int }
method in-timezone(Int(Cool) $timezone) {
return self if $timezone == $!timezone;
my int $old-offset = self.offset;
my int $new-offset = $timezone.Int;
my %parts;
# Is the logic for handling leap seconds right?
# I don't know, but it passes the tests!
my $a = ($!second >= 60 ?? 59 !! $!second)
+ $new-offset - $old-offset;
%parts<second> = $!second >= 60 ?? $!second !! $a % 60;
my Int $b = $!minute + floor($a) div 60;
%parts<minute> = $b % 60;
my Int $c = $!hour + $b div 60;
%parts<hour> = $c % 24;
# Let Dateish handle any further rollover.
self!ymd-from-daycount(self.daycount + $c div 24,
%parts<year>,%parts<month>,%parts<day>) if $c div 24;
self!clone-without-validating: :$timezone, |%parts;
}
method utc() { self.in-timezone(0) }
method local() { self.in-timezone($*TZ) }
proto method Date() {*}
multi method Date(DateTime:D:) { Date.new($!year,$!month,$!day) }
multi method Date(DateTime:U:) { Date }
method DateTime() { self }
multi method perl(DateTime:D:) {
self.^name
~ ".new($!year,$!month,$!day,$!hour,$!minute,$!second"
~ (',' ~ :$!timezone.perl if $!timezone)
~ ')'
}
}
Rakudo::Internals.REGISTER-DYNAMIC: '$*TZ', {
PROCESS::<$TZ> = Rakudo::Internals.get-local-timezone-offset
}
multi sub infix:«<»(DateTime:D \a, DateTime:D \b) {
a.Instant < b.Instant
}
multi sub infix:«>»(DateTime:D \a, DateTime:D \b) {
a.Instant > b.Instant
}
multi sub infix:«<=»(DateTime:D \a, DateTime:D \b) {
a.Instant <= b.Instant
}
multi sub infix:«>=»(DateTime:D \a, DateTime:D \b) {
a.Instant >= b.Instant
}
multi sub infix:«==»(DateTime:D \a, DateTime:D \b) {
a.Instant == b.Instant
}
multi sub infix:«!=»(DateTime:D \a, DateTime:D \b) {
a.Instant != b.Instant
}
multi sub infix:«<=>»(DateTime:D \a, DateTime:D \b) {
a.Instant <=> b.Instant
}
multi sub infix:«cmp»(DateTime:D \a, DateTime:D \b) {
a.Instant cmp b.Instant
}
multi sub infix:<->(DateTime:D \a, DateTime:D \b) {
a.Instant - b.Instant
}
multi sub infix:<->(DateTime:D \a, Duration:D \b) {
a.new(a.Instant - b).in-timezone(a.timezone)
}
multi sub infix:<+>(DateTime:D \a, Duration:D \b) {
a.new(a.Instant + b).in-timezone(a.timezone)
}
multi sub infix:<+>(Duration:D \a, DateTime:D \b) {
b.new(b.Instant + a).in-timezone(b.timezone)
}
# vim: ft=perl6 expandtab sw=4