1. my class DateTime does Dateish {
  2. has int $.hour;
  3. has int $.minute;
  4. has $.second;
  5. has int $.timezone; # UTC
  6. # Not an optimization but a necessity to ensure that
  7. # $dt.utc.local.utc is equivalent to $dt.utc. Otherwise,
  8. # DST-induced ambiguity could ruin our day.
  9. method !formatter() { # ISO 8601 timestamp
  10. sprintf '%s-%02d-%02dT%02d:%02d:%s%s',
  11. self!year-Str, $!month, $!day, $!hour, $!minute,
  12. $!second.floor == $!second
  13. ?? $!second.Int.fmt('%02d')
  14. !! $!second.fmt('%09.6f'),
  15. $!timezone == 0
  16. ?? 'Z'
  17. !! $!timezone > 0
  18. ?? sprintf('+%02d:%02d',
  19. ($!timezone/3600).floor,
  20. ($!timezone/60%60).floor)
  21. !! sprintf('-%02d:%02d',
  22. ($!timezone.abs/3600).floor,
  23. ($!timezone.abs/60%60).floor)
  24. }
  25. my $valid-units := nqp::hash(
  26. 'second', 0,
  27. 'seconds', 0,
  28. 'minute', 0,
  29. 'minutes', 0,
  30. 'hour', 0,
  31. 'hours', 0,
  32. 'day', 0,
  33. 'days', 0,
  34. 'week', 0,
  35. 'weeks', 0,
  36. 'month', 1,
  37. 'months', 1,
  38. 'year', 1,
  39. 'years', 1,
  40. );
  41. method !VALID-UNIT($unit) {
  42. nqp::existskey($valid-units,$unit)
  43. ?? $unit
  44. !! X::DateTime::InvalidDeltaUnit.new(:$unit).throw
  45. }
  46. method !SET-SELF(\y,\mo,\d,\h,\mi,\s,\t,\f) {
  47. $!year = y;
  48. $!month = mo;
  49. $!day = d;
  50. $!hour = h;
  51. $!minute = mi;
  52. $!second = s;
  53. $!timezone = t;
  54. &!formatter = f;
  55. self
  56. }
  57. method !new-from-positional(DateTime:
  58. Int() $year,
  59. Int() $month,
  60. Int() $day,
  61. Int() $hour,
  62. Int() $minute,
  63. $second, # can have fractional seconds
  64. %extra,
  65. :$timezone = 0,
  66. :&formatter,
  67. ) {
  68. 1 <= $month <= 12
  69. || X::OutOfRange.new(:what<Month>,:got($month),:range<1..12>).throw;
  70. 1 <= $day <= self.DAYS-IN-MONTH($year,$month)
  71. || X::OutOfRange.new(
  72. :what<Day>,
  73. :got($day),
  74. :range("1..{self.DAYS-IN-MONTH($year,$month)}")
  75. ).throw;
  76. 0 <= $hour <= 23
  77. || X::OutOfRange.new(:what<Hour>,:got($hour),:range<0..23>).throw;
  78. 0 <= $minute <= 59
  79. || X::OutOfRange.new(:what<Minute>,:got($minute),:range<0..59>).throw;
  80. (^61).in-range($second,'Second'); # some weird semantics need this
  81. my $dt = nqp::eqaddr(self.WHAT,DateTime)
  82. ?? nqp::create(self)!SET-SELF(
  83. $year,$month,$day,$hour,$minute,$second,$timezone,&formatter)
  84. !! self.bless(
  85. :$year,:$month,:$day,
  86. :$hour,:$minute,:$second,:$timezone,:&formatter,|%extra);
  87. $second >= 60 ?? $dt!check-leap-second !! $dt
  88. }
  89. method !check-leap-second {
  90. my $utc := $!timezone ?? self.utc !! self;
  91. X::OutOfRange.new(
  92. what => 'Second',
  93. range => "0..^60",
  94. got => $!second,
  95. comment => 'a leap second can occur only at 23:59',
  96. ).throw unless $utc.hour == 23 && $utc.minute == 59;
  97. my $date := $utc.yyyy-mm-dd;
  98. X::OutOfRange.new(
  99. what => 'Second',
  100. range => "0..^60",
  101. got => $!second,
  102. comment => "There is no leap second on UTC $date",
  103. ).throw unless Rakudo::Internals.is-leap-second-date($date);
  104. self
  105. }
  106. proto method new(|) {*}
  107. multi method new(DateTime:
  108. \y,\mo,\d,\h,\mi,\s,:$timezone = 0,:&formatter,*%_) {
  109. self!new-from-positional(y,mo,d,h,mi,s,%_,:$timezone,:&formatter)
  110. }
  111. multi method new(DateTime:
  112. :$year!,
  113. :$month = 1,
  114. :$day = 1,
  115. :$hour = 0,
  116. :$minute = 0,
  117. :$second = 0,
  118. :$timezone = 0,
  119. :&formatter,
  120. *%_
  121. ) {
  122. self!new-from-positional(
  123. $year,$month,$day,$hour,$minute,$second,%_,:$timezone,:&formatter)
  124. }
  125. multi method new(DateTime: Date:D :$date!, *%_) {
  126. self.new(:year($date.year),:month($date.month),:day($date.day),|%_)
  127. }
  128. multi method new(DateTime: Instant:D $i, :$timezone = 0, *%_) {
  129. my ($p, $leap-second) = $i.to-posix;
  130. my $dt = self.new( floor($p - $leap-second).Int, |%_ );
  131. $dt.clone(
  132. :second($dt.second + $p % 1 + $leap-second), |%_
  133. ).in-timezone($timezone)
  134. }
  135. multi method new(DateTime:
  136. Numeric:D $time is copy, :$timezone = 0, :&formatter, *%_
  137. ) {
  138. # Interpret $time as a POSIX time.
  139. my $second = $time % 60; $time = $time.Int div 60;
  140. my int $minute = $time % 60; $time = $time div 60;
  141. my int $hour = $time % 24; $time = $time div 24;
  142. # Day month and leap year arithmetic, based on Gregorian day #.
  143. # 2000-01-01 noon UTC == 2451558.0 Julian == 2451545.0 Gregorian
  144. $time += 2440588; # because 2000-01-01 == Unix epoch day 10957
  145. my Int $a = $time + 32044; # date algorithm from Claus Tøndering
  146. my Int $b = (4 * $a + 3) div 146097; # 146097 = days in 400 years
  147. my Int $c = $a - (146097 * $b) div 4;
  148. my Int $d = (4 * $c + 3) div 1461; # 1461 = days in 4 years
  149. my Int $e = $c - ($d * 1461) div 4;
  150. my Int $m = (5 * $e + 2) div 153; # 153 = days in Mar-Jul Aug-Dec
  151. my int $day = $e - (153 * $m + 2) div 5 + 1;
  152. my int $month = $m + 3 - 12 * ($m div 10);
  153. my Int $year = $b * 100 + $d - 4800 + $m div 10;
  154. my $dt = self === DateTime
  155. ?? ( %_ ?? die "Unexpected named parameter{"s" if %_ > 1} "
  156. ~ %_.keys.map({"`$_`"}).join(", ") ~ " passed. Were you "
  157. ~ "trying to use the named parameter form of .new() but "
  158. ~ "accidentally passed one named parameter as a positional?"
  159. !! nqp::create(self)!SET-SELF(
  160. $year,$month,$day,$hour,$minute,$second,0,&formatter)
  161. ) !! self.bless(
  162. :$year,:$month,:$day,
  163. :$hour,:$minute,:$second,:timezone(0),:&formatter,|%_);
  164. $timezone ?? $dt.in-timezone($timezone) !! $dt
  165. }
  166. multi method new(DateTime:
  167. Str:D $datetime, :$timezone is copy, :&formatter, *%_
  168. ) {
  169. X::Temporal::InvalidFormat.new(
  170. invalid-str => $datetime,
  171. target => 'DateTime',
  172. format => 'an ISO 8601 timestamp (yyyy-mm-ddThh:mm:ssZ or yyyy-mm-ddThh:mm:ss+01:00)',
  173. ).throw unless $datetime.chars == $datetime.codes and $datetime ~~ /^
  174. (<[+-]>? \d**4 \d*) # year
  175. '-'
  176. (\d\d) # month
  177. '-'
  178. (\d\d) # day
  179. <[Tt]> # time separator
  180. (\d\d) # hour
  181. ':'
  182. (\d\d) # minute
  183. ':'
  184. (\d\d[<[\.,]>\d ** 1..6]?) # second
  185. (<[Zz]> || (<[\-\+]>) (\d\d) (':'? (\d\d))? )? # timezone
  186. $/;
  187. if $6 {
  188. X::DateTime::TimezoneClash.new.throw with $timezone;
  189. if $6.chars != 1 {
  190. X::OutOfRange.new(
  191. what => "minutes of timezone",
  192. got => +$6[2][0],
  193. range => "0..^60",
  194. ).throw if $6[2] && $6[2][0] > 59;
  195. $timezone = (($6[1]*60 + ($6[2][0] // 0)) * 60).Int;
  196. # RAKUDO: .Int is needed to avoid to avoid the nasty '-0'.
  197. $timezone = -$timezone if $6[0] eq '-';
  198. }
  199. }
  200. $timezone //= 0;
  201. self!new-from-positional(
  202. $0,$1,$2,$3,$4,+(~$5.subst(",",".")),%_,:$timezone,:&formatter)
  203. }
  204. method now(:$timezone=$*TZ, :&formatter --> DateTime:D) {
  205. self.new(nqp::time_n(), :$timezone, :&formatter)
  206. }
  207. method clone(*%_) {
  208. my $h := nqp::getattr(%_,Map,'$!storage');
  209. self!new-from-positional(
  210. nqp::existskey($h,'year') ?? nqp::atkey($h,'year') !! $!year,
  211. nqp::existskey($h,'month') ?? nqp::atkey($h,'month') !! $!month,
  212. nqp::existskey($h,'day') ?? nqp::atkey($h,'day') !! $!day,
  213. nqp::existskey($h,'hour') ?? nqp::atkey($h,'hour') !! $!hour,
  214. nqp::existskey($h,'minute') ?? nqp::atkey($h,'minute') !! $!minute,
  215. nqp::existskey($h,'second') ?? nqp::atkey($h,'second') !! $!second,
  216. %_,
  217. timezone => nqp::existskey($h,'timezone')
  218. ?? nqp::atkey($h,'timezone') !! $!timezone,
  219. formatter => nqp::existskey($h,'formatter')
  220. ?? nqp::atkey($h,'formatter') !! &!formatter,
  221. )
  222. }
  223. method !clone-without-validating(*%_) { # A premature optimization.
  224. return self.clone(|%_) unless self === DateTime;
  225. my $h := nqp::getattr(%_,Map,'$!storage');
  226. nqp::create(self)!SET-SELF(
  227. nqp::existskey($h,'year') ?? nqp::atkey($h,'year') !! $!year,
  228. nqp::existskey($h,'month') ?? nqp::atkey($h,'month') !! $!month,
  229. nqp::existskey($h,'day') ?? nqp::atkey($h,'day') !! $!day,
  230. nqp::existskey($h,'hour') ?? nqp::atkey($h,'hour') !! $!hour,
  231. nqp::existskey($h,'minute') ?? nqp::atkey($h,'minute') !! $!minute,
  232. nqp::existskey($h,'second') ?? nqp::atkey($h,'second') !! $!second,
  233. nqp::existskey($h,'timezone')
  234. ?? nqp::atkey($h,'timezone') !! $!timezone,
  235. &!formatter,
  236. )
  237. }
  238. method Instant() {
  239. Instant.from-posix: self.posix + $!second % 1, $!second >= 60;
  240. }
  241. method posix($ignore-timezone?) {
  242. return self.utc.posix if $!timezone && !$ignore-timezone;
  243. # algorithm from Claus Tøndering
  244. my int $a = (14 - $!month) div 12;
  245. my int $y = $!year + 4800 - $a;
  246. my int $m = $!month + 12 * $a - 3;
  247. my int $jd = $!day + (153 * $m + 2) div 5 + 365 * $y
  248. + $y div 4 - $y div 100 + $y div 400 - 32045;
  249. ($jd - 2440588) * 86400
  250. + $!hour * 3600
  251. + $!minute * 60
  252. + self.whole-second
  253. }
  254. method offset() { $!timezone }
  255. method offset-in-minutes() { $!timezone / 60 }
  256. method offset-in-hours() { $!timezone / 3600 }
  257. method hh-mm-ss() { sprintf "%02d:%02d:%02d", $!hour,$!minute,$!second }
  258. method later(:$earlier, *%unit) {
  259. my @pairs = %unit.pairs;
  260. die "More than one time unit supplied" if @pairs > 1;
  261. die "No time unit supplied" unless @pairs;
  262. my $unit = self!VALID-UNIT(@pairs.AT-POS(0).key);
  263. my $amount = @pairs.AT-POS(0).value.Int;
  264. $amount = -$amount if $earlier;
  265. # work on instant (tai)
  266. if $unit.starts-with('second') {
  267. self.new(self.Instant + $amount, :$!timezone, :&!formatter)
  268. }
  269. # on a leap second and not moving by second
  270. elsif $!second >= 60 {
  271. my $dt := self!clone-without-validating(
  272. :second($!second-1)).later(|($unit => $amount));
  273. $dt.hour == 23 && $dt.minute == 59 && $dt.second >= 59
  274. && Rakudo::Internals.is-leap-second-date($dt.yyyy-mm-dd)
  275. ?? $dt!clone-without-validating(:$!second)
  276. !! $dt
  277. }
  278. # month,year
  279. elsif nqp::atkey($valid-units,$unit) {
  280. my $date :=
  281. Date.new($!year,$!month,$!day).later(|($unit => $amount));
  282. nqp::create(self)!SET-SELF(
  283. nqp::getattr($date,Date,'$!year'),
  284. nqp::getattr($date,Date,'$!month'),
  285. nqp::getattr($date,Date,'$!day'),
  286. $!hour, $!minute, $!second, $!timezone, &!formatter
  287. )
  288. }
  289. # minute,hour,day,week
  290. else {
  291. my int $minute = $!minute;
  292. my int $hour = $!hour;
  293. $minute += $amount if $unit.starts-with('minute');
  294. $hour += floor($minute / 60);
  295. $minute %= 60;
  296. $hour += $amount if $unit.starts-with('hour');
  297. my $day-delta = floor($hour / 24);
  298. $hour %= 24;
  299. $day-delta = $amount if $unit.starts-with('day');
  300. $day-delta = 7 * $amount if $unit.starts-with('week');
  301. my $date := Date.new-from-daycount(self.daycount + $day-delta);
  302. nqp::create(self)!SET-SELF(
  303. nqp::getattr($date,Date,'$!year'),
  304. nqp::getattr($date,Date,'$!month'),
  305. nqp::getattr($date,Date,'$!day'),
  306. $hour, $minute, $!second, $!timezone, &!formatter)
  307. }
  308. }
  309. method truncated-to(Cool $unit) {
  310. my %parts;
  311. given self!VALID-UNIT($unit) {
  312. %parts<second> = self.whole-second;
  313. when 'second' | 'seconds' {}
  314. %parts<second> = 0;
  315. when 'minute' | 'minutes' {}
  316. %parts<minute> = 0;
  317. when 'hour' | 'hours' {}
  318. %parts<hour> = 0;
  319. when 'day' | 'days' {}
  320. %parts = self!truncate-ymd($unit, %parts);
  321. }
  322. self!clone-without-validating(|%parts);
  323. }
  324. method whole-second() { $!second.Int }
  325. method in-timezone($timezone) {
  326. return self if $timezone == $!timezone;
  327. my int $old-offset = self.offset;
  328. my int $new-offset = $timezone.Int;
  329. my %parts;
  330. # Is the logic for handling leap seconds right?
  331. # I don't know, but it passes the tests!
  332. my $a = ($!second >= 60 ?? 59 !! $!second)
  333. + $new-offset - $old-offset;
  334. %parts<second> = $!second >= 60 ?? $!second !! $a % 60;
  335. my Int $b = $!minute + floor($a) div 60;
  336. %parts<minute> = $b % 60;
  337. my Int $c = $!hour + $b div 60;
  338. %parts<hour> = $c % 24;
  339. # Let Dateish handle any further rollover.
  340. self!ymd-from-daycount(self.daycount + $c div 24,
  341. %parts<year>,%parts<month>,%parts<day>) if $c div 24;
  342. self!clone-without-validating: :$timezone, |%parts;
  343. }
  344. method utc() { self.in-timezone(0) }
  345. method local() { self.in-timezone($*TZ) }
  346. proto method Date() {*}
  347. multi method Date(DateTime:D:) { Date.new($!year,$!month,$!day) }
  348. multi method Date(DateTime:U:) { Date }
  349. method DateTime() { self }
  350. multi method perl(DateTime:D:) {
  351. self.^name
  352. ~ ".new($!year,$!month,$!day,$!hour,$!minute,$!second"
  353. ~ (',' ~ :$!timezone.perl if $!timezone)
  354. ~ ')'
  355. }
  356. }
  357. Rakudo::Internals.REGISTER-DYNAMIC: '$*TZ', {
  358. PROCESS::<$TZ> = Rakudo::Internals.get-local-timezone-offset
  359. }
  360. multi sub infix:«<»(DateTime:D \a, DateTime:D \b) {
  361. a.Instant < b.Instant
  362. }
  363. multi sub infix:«>»(DateTime:D \a, DateTime:D \b) {
  364. a.Instant > b.Instant
  365. }
  366. multi sub infix:«<=»(DateTime:D \a, DateTime:D \b) {
  367. a.Instant <= b.Instant
  368. }
  369. multi sub infix:«>=»(DateTime:D \a, DateTime:D \b) {
  370. a.Instant >= b.Instant
  371. }
  372. multi sub infix:«==»(DateTime:D \a, DateTime:D \b) {
  373. a.Instant == b.Instant
  374. }
  375. multi sub infix:«!=»(DateTime:D \a, DateTime:D \b) {
  376. a.Instant != b.Instant
  377. }
  378. multi sub infix:«<=>»(DateTime:D \a, DateTime:D \b) {
  379. a.Instant <=> b.Instant
  380. }
  381. multi sub infix:«cmp»(DateTime:D \a, DateTime:D \b) {
  382. a.Instant cmp b.Instant
  383. }
  384. multi sub infix:<->(DateTime:D \a, DateTime:D \b) {
  385. a.Instant - b.Instant
  386. }
  387. multi sub infix:<->(DateTime:D \a, Duration:D \b) {
  388. a.new(a.Instant - b).in-timezone(a.timezone)
  389. }
  390. multi sub infix:<+>(DateTime:D \a, Duration:D \b) {
  391. a.new(a.Instant + b).in-timezone(a.timezone)
  392. }
  393. multi sub infix:<+>(Duration:D \a, DateTime:D \b) {
  394. b.new(b.Instant + a).in-timezone(b.timezone)
  395. }