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