From f268a59aa9b8451c894f2bec1abd3c263ee8bcb9 Mon Sep 17 00:00:00 2001 From: jetmonk <47283218+jetmonk@users.noreply.github.com> Date: Fri, 1 Nov 2019 16:08:37 -1000 Subject: [PATCH] Initial commit --- README.md | 175 +++++ jd-time-utils-cl-date-time-parser.lisp | 980 +++++++++++++++++++++++++ jd-time-utils-package.lisp | 35 + jd-time-utils-parse.lisp | 120 +++ jd-time-utils-struct.lisp | 71 ++ jd-time-utils-test.lisp | 65 ++ jd-time-utils-utils.lisp | 307 ++++++++ jd-time-utils.asd | 33 + 8 files changed, 1786 insertions(+) create mode 100644 README.md create mode 100644 jd-time-utils-cl-date-time-parser.lisp create mode 100644 jd-time-utils-package.lisp create mode 100644 jd-time-utils-parse.lisp create mode 100644 jd-time-utils-struct.lisp create mode 100644 jd-time-utils-test.lisp create mode 100644 jd-time-utils-utils.lisp create mode 100644 jd-time-utils.asd diff --git a/README.md b/README.md new file mode 100644 index 0000000..fb4ea95 --- /dev/null +++ b/README.md @@ -0,0 +1,175 @@ +# jd-time-utils - time utilities to work before 1900-01-01, using Julian Days + +Includes replacement for encode-universal-time and decode-universal-time +and routines for parsing time into a structure including calendar date, fractional +year, and Julian day, second, and nanosecond. + +Includes modified version of cl-date-time-parser + +## Dependencies + +* anaphora +* cl-ppcre +* local-time +* parse-float - several versions OK; must have (parse-float:parse-float string) +* bordeaux-threads + +## Principles + +Standard Lisp universal time (UT) is defined using 1900-00-00T00:00:00 as UT=0, and +dates before 1900 are not allowed. + +This package uses the astronomical Julian Day as its internal basis, and extends UT +to negative dates. + +Julian Day 0 is on January 1, 4713 BC, proleptic (extended) Julian calendar +and November 24, 4714 BC, in the proleptic Gregorian calendar. + +Negative Julian days are allowed, so it works far into the past or +future. Internally, time is represented as Julian Day, Julian Second +(in Julian Day), and Julian nanonsecond, and the span is limited by +the representation of seconds of time in the integers used (about a +billion years for 55 bits). + +When converting calendar dates (YYYY,MM,DD,HH,MM,SS) to absolute time units +(Julian Day, Julian seconds, or UT seconds), note that by default dates +before Oct 15,1582 are treated as Julian, not Gregorian (no leap years). +This can be disabled using keyword ":GREGORIAN-TRANSITION NIL" + +# Caveats + +* Time zone is 0 (GMT) by default, not localtime. +* There is no knowledge of Daylight Savings Time. It does not exist in these routines. +* The included version of cl-date-time-parser seems to have had the signs of hardwired timezones reversed. This is fixed (?). We hope this is correct. + +## Examples + +#### alternatives for encode and decode universal time + +encoding universal time: + +```` + (jd-time-utils:encode-universal-time/extended + 1.1 2 3 31 12 1800 ;; SEC MIN HR DATE MONTH YEAR + :time-zone 0) ;; new keyword + ==> + -3124213079 ;; negative seconds before 1900 + 100000023 ;; nanoseconds (with single float rounding error) +```` + +decoding universal time: + +```` +(jd-time-utils:decode-universal-time/extended -3124213079 +==> + (jd-time-utils:decode-universal-time/extended + -3124213079 + :time-zone 0 + :gregorian-transition t ;; only affects dates before Oct 15,1582 + :nanoseconds 100000000) ;; nanonseconds keyword + ==> + 1 2 3 31 12 1800 ;; SEC MIN HR DATE MONTH YEAR + 2 ;; DAY-OF-WEEK (0-6) + 100000000 ;; NANOSECONDS + 0 ;; TIME-ZONE +```` + +#### Time parsing into a DATE-TIME structure + + +Using standard formats borrowed from CL-DATE-TIME-PARSER +```` + (jd-time-utils:parse-date-time-string + "5:42:00.1 July 4, 1976 GMT" :output-timezone 0) + ==> + #S(jd-time-utils:date-time + :year 1976 + :month 7 + :day 4 + :hour 5 + :minute 42 + :second 0 + :fractional-second 0.1d0 + :day-of-week 6 + :ut 2414295720 + :timezone 0 ;; see :OUTPUT-TIMEZONE + :fractional-year 1976.5061133911404d0 + ;; days, seconds, and nanoseconds since Julian January 1, 4713 BC + :julian-time #S(jd-time-utils:julian-time + :day 2442964 + :second 20520 + :nanosecond 100000000)) +```` + +Parse in a different timezone (EST); note default conversion to timezone 0 + +```` + (jd-time-utils:parse-date-time-string + "5:42:00.1 July 4, 1976 EST") + ==> + #S(jd-time-utils:date-time + :year 1976 + :month 7 + :day 4 + :hour 10 ;; 5 hours later than above + :minute 42 + :second 0 + :fractional-second 0.1d0 + :day-of-week 6 + :ut 2414313720 + :timezone 0 ;; timezone is still zero + :fractional-year 1976.5066826078983d0 + :julian-time #S(jd-time-utils:julian-time + :day 2442964 + :second 38520 + :nanosecond 100000000)) +```` + +Using a stated format :MM-DD-YY, and turning off general formats + +```` + (jd-time-utils:parse-date-time-string + "07/05/76" :date-convention :mm-dd-yy :try-standard-formats nil) + ==> + #S(jd-time-utils:date-time + :year 1976 + :month 7 + :day 5 + :hour 0 + :minute 0 + :second 0 + :fractional-second 0.0d0 + :day-of-week 0 + :ut 2414361600 + :timezone 0 + :fractional-year 1976.5081967213114d0 + :julian-time #S(jd-time-utils:julian-time + :day 2442965 + :second 0 + :nanosecond 0)) +```` + +Convert 1899-12-31T23:59:59 to a structure + +```` + (jd-time-utils::build-date-time-struct-from-ut + -1 ;; one second before Lisp era + :timezone 10) + ==> + #S(jd-time-utils:date-time + :year 1899 + :month 12 + :day 31 + :hour 13 + :minute 59 + :second 59 + :fractional-second 0.0d0 + :day-of-week 6 + :ut -1 + :timezone 10 ;; new output timezone (10 zones west of meridian) + :fractional-year 1899.9999999682902d0 + :julian-time #S(jd-time-utils:julian-time + :day 2415020 + :second 86399 + :nanosecond 0)) +```` diff --git a/jd-time-utils-cl-date-time-parser.lisp b/jd-time-utils-cl-date-time-parser.lisp new file mode 100644 index 0000000..f06966d --- /dev/null +++ b/jd-time-utils-cl-date-time-parser.lisp @@ -0,0 +1,980 @@ +;;;; Last modified: 2014-05-18 14:40:06 tkych + +;; cl-date-time-parser/date-time-parser.lisp + +;; Copyright (c) 2013 Takaya OCHIAI +;; This software is released under the MIT License. +;; For more details, see cl-date-time-parser/LICENSE +;; + +;; SLIGHTLY MODIFIED FOR TIME-UTILS, to use +;; encode-universal-time/extended and decode-universal-time/extended + +#| + +Original License +================================================================ +Copyright (c) 2013 Takaya OCHIAI + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +================================================================ +|# + + +;;==================================================================== +;; Date-Time-Parser +;;==================================================================== + +(in-package :cl-user) +(defpackage #:cl-date-time-parser/jd-time-utils + (:use :cl) + (:import-from #:anaphora #:it #:aif #:acond) + (:import-from #:split-sequence #:split-sequence) + (:import-from #:parse-float #:parse-float) ;; note that we use OUR parse float, not internet + (:export #:parse-date-time)) + +(in-package #:cl-date-time-parser/jd-time-utils) + + +;;-------------------------------------------------------------------- +;; Eval-Test for CL-Date-Time-Parser +;;-------------------------------------------------------------------- + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *features-tmp* *features*) + + ;; when release, the following line should be comment in. + (setf *features* (remove :et *features*)) + + ;; when release, the following two lines should be comment out. + ;; (ql:quickload '(:cl-ppcre :split-sequence :anaphora :local-time :parse-float)) + ;; (pushnew :et *features*) + ) + +#+et +(eval-when (:compile-toplevel :load-toplevel :execute) + + (defmacro =>? (form want &optional test) + "Check whether FORM is evaluated to WANT by TEST (default is `equal`). +If first element of WANT is `:values`, then check mutiple values." + (if (and (listp want) (eq :values (first want))) + `(assert (funcall ,(if test test ''equal) + (multiple-value-list ,form) + (list ,@(rest want)))) + `(assert (funcall ,(if test test ''equal) + ,form ,want)))) + + (defmacro =>t? (form) + "Check whether FORM is evaluated to T." + `(=>? ,form t)) + + (defmacro =>nil? (form) + "Check whether FORM is evaluated to NIL." + `(=>? ,form nil)) + + ) ;end of #+et + + +;;-------------------------------------------------------------------- +;; Special Variables +;;-------------------------------------------------------------------- + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant +second+ 1) + (defconstant +minuite-secs+ (* 60 +second+)) + (defconstant +hour-secs+ (* 60 +minuite-secs+)) + (defconstant +day-secs+ (* 24 +hour-secs+))) + +(defparameter *month-vec-in-normal-year* + #("0 is not month number." + 0 2678400 5097600 7776000 10368000 13046400 15638400 18316800 + 20995200 23587200 26265600 28857600)) + +(defparameter *month-vec-in-leap-year* + #("0 is not month number." + 0 2678400 5184000 7862400 10454400 13132800 15724800 18403200 + 21081600 23673600 26352000 28944000)) + +(defparameter *month-ht-in-normal-year* + (alexandria:plist-hash-table + '("Jan" 0 + "Feb" 2678400 + "Mar" 5097600 + "Apr" 7776000 + "May" 10368000 + "Jun" 13046400 + "Jul" 15638400 + "Aug" 18316800 + "Sep" 20995200 + "Oct" 23587200 + "Nov" 26265600 + "Dec" 28857600 + + ;; invalid month name + "January" 0 + "February" 2678400 + "March" 5097600 + "April" 7776000 + "May" 10368000 + "June" 13046400 + "July" 15638400 + "August" 18316800 + "September" 20995200 + "October" 23587200 + "November" 26265600 + "December" 28857600) + :test #'equalp)) + +(defparameter *month-ht-in-leap-year* + (alexandria:plist-hash-table + '("Jan" 0 + "Feb" 2678400 + "Mar" 5184000 + "Apr" 7862400 + "May" 10454400 + "Jun" 13132800 + "Jul" 15724800 + "Aug" 18403200 + "Sep" 21081600 + "Oct" 23673600 + "Nov" 26352000 + "Dec" 28944000 + + ;; invalid month name + "January" 0 + "February" 2678400 + "March" 5184000 + "April" 7862400 + "May" 10454400 + "June" 13132800 + "July" 15724800 + "August" 18403200 + "September" 21081600 + "October" 23673600 + "November" 26352000 + "December" 28944000) + :test #'equalp)) + +(defparameter *tz-abbrev-to-offset* + (alexandria:plist-hash-table + '("UT" 0 + "GMT" 0 + "ADT" +10800 ;; JTK - it looks like timezone signs were reversed + "AST" +14400 + "EDT" +14400 + "EST" +18000 + "CDT" +18000 + "CST" +21600 + "MDT" +21600 + "MST" +25200 + "PDT" +25200 + "PST" +28800 + + "AT" +14400 + "ET" +18000 + "CT" +21600 + "MT" +25200 + "PT" +28800 + + ;; Memo: Military-time-zone is defined by rfc822, and obsoluted by rfc1123, + ;; rfc2822 and rfc5322. For more details see. rfc1123, 5.2.14. + "A" #.(* 1 3600) "B" #.(* 2 3600) "C" #.(* 3 3600) "D" #.(* 4 3600) + "E" #.(* 5 3600) "F" #.(* 6 3600) "G" #.(* 7 3600) "H" #.(* 8 3600) + "I" #.(* 9 3600) "K" #.(* 10 3600) "L" #.(* 11 3600) "M" #.(* 12 3600) + "N" #.(* -1 3600) "O" #.(* -2 3600) "P" #.(* -3 3600) "Q" #.(* -4 3600) + "R" #.(* -5 3600) "S" #.(* -6 3600) "T" #.(* -7 3600) "U" #.(* -8 3600) + "V" #.(* -9 3600) "W" #.(* -10 3600) "X" #.(* -11 3600) "Y" #.(* -12 3600) + ;; Zulu time + "Z" 0 + ) + :test #'equalp)) + +(defparameter *day-of-week* + (alexandria:plist-hash-table + '("Mon" 1 + "Tue" 1 + "Wed" 1 + "Thu" 1 + "Fri" 1 + "Sat" 1 + "Sun" 1 + + ;; invalid day name + "Monday" 1 + "Tuesday" 1 + "Wednesday" 1 + "Thursday" 1 + "Friday" 1 + "Saturday" 1 + "Sunday" 1) + :test #'equalp)) + + +;;-------------------------------------------------------------------- +;; Parse-Date-Time +;;-------------------------------------------------------------------- + +;; JTK - added locking around hash table manipulation +(let ((tz-lock (bordeaux-threads:make-lock "timezone-hashl-lock"))) + (defun get-offset (tz-abbrev) + (aif (bordeaux-threads:with-lock-held (tz-lock) + (gethash tz-abbrev *tz-abbrev-to-offset* nil)) + it + (let ((offset (handler-case + (calc-offset tz-abbrev) + (error () + (error "~S is not parsed as time-zone." + tz-abbrev))))) + (bordeaux-threads:with-lock-held (tz-lock) + (setf (gethash tz-abbrev *tz-abbrev-to-offset*) + offset)))))) + + + + ;; !!! UGLY: using un-official api for local-time. !!! +(defun calc-offset (tz-abbrev) + "Return offset for the time-zone-abbrev. If not find offset, return NIL." + (symbol-macrolet ((timezones local-time::*abbreviated-subzone-name->timezone-list*)) + (let ((tz (aif (gethash tz-abbrev timezones nil) + (first it) + (when (zerop (hash-table-count timezones)) + (local-time::reread-timezone-repository) + (first (gethash tz-abbrev timezones nil)))))) + (when tz + (loop + :for sub :across (local-time::timezone-subzones tz) + :do (when (equal tz-abbrev (local-time::subzone-abbrev sub)) + (return (- (local-time::subzone-offset sub))))))))) + +#+et (=>? (get-offset "JST") (* +9 60 60)) +#+et (=>? (get-offset "GMT") 0) +#+et (=>? (get-offset "MDT") (* +6 60 60)) + + +(defun year-to-ut (year) + (jd-time-utils:encode-universal-time/extended 0 0 0 1 1 year :timezone 0)) + +#+et (=>? (year-to-ut 1900) 0) +#+et (=>? (year-to-ut 1901) (* 365 24 60 60)) +#+et (=>? (year-to-ut 1902) (+ (year-to-ut 1901) (* 365 24 60 60))) +#+et (=>? (year-to-ut 1905) (+ (year-to-ut 1904) (* 366 24 60 60))) +#+et (=>? (year-to-ut 2000) + (local-time:timestamp-to-universal + (local-time:parse-timestring "2000-01-01T00:00:00Z"))) +#+et (=>? (year-to-ut 2013) + (local-time:timestamp-to-universal + (local-time:parse-timestring "2013-01-01T00:00:00Z"))) + + +(defun leap-year-p (year) + "Return T if YEAR is a leap year, otherwise NIL. +c.f. RFC3339, (Appendix C. Leap Years)" + (check-type year (integer 1000 9999)) + (and (zerop (mod year 4)) + (or (not (zerop (mod year 100))) + (zerop (mod year 400))))) + +#+et (=>nil? (leap-year-p 1999)) +#+et (=>t? (leap-year-p 2000)) +#+et (=>nil? (leap-year-p 2001)) + + +(defun month-to-ut (month leap-year?) + (etypecase month + (string (gethash month (if leap-year? + *month-ht-in-leap-year* + *month-ht-in-normal-year*))) + (integer (svref (if leap-year? + *month-vec-in-leap-year* + *month-vec-in-normal-year*) + month)))) + +#+et (=>t? (and (every (lambda (m) (= (month-to-ut m t) + (month-to-ut m nil))) + '("Jan" "January" 1)) + (every (lambda (m) (= (month-to-ut m t) + (month-to-ut m nil))) + '("Feb" "February" 2)) + (every (lambda (m) (= (* 24 60 60) + (- (month-to-ut m t) + (month-to-ut m nil)))) + '("Mar" "March" 3)) + (every (lambda (m) (= (* 24 60 60) + (- (month-to-ut m t) + (month-to-ut m nil)))) + '("Apr" "April" 4)) + (every (lambda (m) (= (* 24 60 60) + (- (month-to-ut m t) + (month-to-ut m nil)))) + '("Dec" "December" 12)))) + + +(defun parse-rfc822-genus (date-time-string) + "Parse DATE-TIME-STRING with RFC822 (RFC1123, RFC2822, RFC5322), +RFC850 (RFC1036) or asctime format, and return + (values UNIVERSAL-TIME FRACTION). + +Reference: + * RFC822 -- http://tools.ietf.org/html/rfc822 + * RFC2822 -- http://tools.ietf.org/html/rfc2822 + * RFC5322 -- http://tools.ietf.org/html/rfc5322 + * RFC850 -- http://tools.ietf.org/html/rfc850 + * RFC1036 -- http://tools.ietf.org/html/rfc1036 + * asctime -- http://en.cppreference.com/w/c/chrono/asctime +" + (let ((universal-time 0) + (fraction 0) + (leap-year? 0) + (month nil) + (day-parsed? nil)) + (flet ((parse-time-part (token) + ;; hh:mm(:ss([:.]ss?)?)? + (let ((time-parts (ppcre:split "[.:]" token))) + (loop + :for d :in time-parts + :for secs :in '#.(list +hour-secs+ +minuite-secs+ +second+) + :do (incf universal-time (* secs (parse-integer d)))) + (when (= 4 (length time-parts)) + (let ((frac-part (car (last time-parts)))) + (setf fraction + (parse-float + (replace (copy-seq "0.0000") + frac-part :start1 2))))))) + + (parse-year (year) + (incf universal-time (year-to-ut year)) + (setf leap-year? (leap-year-p year))) + + (parse-days (token) ; "DD" + (let ((num-days (parse-integer token))) + (incf universal-time (* (1- num-days) +day-secs+))))) + + (dolist (token (ppcre:split "(?=[+-]\\d{2}:?\\d{2})|[, -]|(?=\\d[A-Za-z]+$)" + date-time-string)) + (when (string/= "" token) + ;; Memo: + ;; * Check whether last char is digit-char or not, + ;; in order to interpret "+9000" and "4" as num-token + ;; !! TODO: check all time-zone-abbrev, whether not using digit-chars. + ;; * alpha-char-p return T only when [a-zA-Z]. + ;; Using digit-char-p, we enable to extend + ;; *month-secs-in-normal-year(or leap-year)* to non-alphabet local chars. + (if (not (digit-char-p (char token (1- (length token))))) + + ;; A. Parse char-token + (acond + ;; Memo: consistency is not checking. + ;; i.e. "Mon, 21 Jul 2013 07:22:21 GMT" and "Sun, 21 Jul 2013 07:22:21 GMT" + ;; are parsed to the same universal time value. + ((gethash token *day-of-week* nil) + nil) + ;; we don't know the year yet, calc month is after parse year. + ((gethash token *month-ht-in-normal-year* nil) + (setf month token)) + ((get-offset token) + (incf universal-time it)) + (t nil)) + + ;; B. Parse num-token + (case (length token) + ;; "DD", "YY" + ((1 2) (if day-parsed? + (let* ((num (parse-integer token)) + ;; c.f. rfc5322, p.34 (4.3. Obsolete Date and Time) + (year (cond ((<= 0 num 49) (+ 2000 num)) + ((<= 50 num 99) (+ 1900 num)) + (t num)))) + (parse-year year)) + (progn + (parse-days token) + (setf day-parsed? t)))) + ;; "YYY", c.f. rfc5322, p.34 (4.3. Obsolete Date and Time) + (3 (parse-year (+ 1900 (parse-integer token)))) + ;; "YYYY" + (4 (parse-year (parse-integer token))) + ;; hh:mm(:ss)?([+-]hh:?mm)? or [+-]hh:?mm + (t (let ((tokens (ppcre:split "[+-]" token))) + (ecase (length tokens) + ;; "hh:mm:ss.ss", "hh:mm:ss", "hh:mm" + (1 (parse-time-part token)) + ;; "hh:mm:ss+hh:mm", "hh:mm:ss+hhmm", "hh:mm+hh:mm", "hh:mm+hhmm" + (2 (destructuring-bind (time time-zone) tokens + (parse-time-part time) + (let ((sign (if (find #\+ token) -1 +1)) ;sign becomes inverse + (hour (parse-integer time-zone :end 2)) + (minute (parse-integer + time-zone :start (if (find #\: time-zone) 3 2)))) + (incf universal-time (* sign (+ (* hour #.+hour-secs+) + (* minute #.+minuite-secs+)))))))))))))) + + (when (equal 0 leap-year?) + ;; Memo: get-decoded-time returns date-time depending system time-zone. + (let ((this-year (nth-value 5 (jd-time-utils:decode-universal-time/extended + (get-universal-time) :timezone 0)))) + (warn "YEAR was not detected in ~S as RFC822-Genus. YEAR was supplemented with this year, \"~S\"." + date-time-string this-year) + (parse-year this-year))) + + (incf universal-time (month-to-ut month leap-year?))) + + (values universal-time fraction))) + + +#+et (flet ((rfc822 (x) (parse-rfc822-genus x)) + (enc (&rest args) (apply #'encode-universal-time args))) + + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00 GMT") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00 gmt") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00 Z") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00Z") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00 z") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00z") + (:values (enc 0 0 0 1 1 2013 0) 0)) + + (=>? (rfc822 "Sat, 02 Mar 2013 01:23:45 EDT") + (:values (enc 45 23 1 2 3 2013 -4) 0)) + (=>? (rfc822 "Sat, 02 Mar 2013 01:23:45 FOOBAZBAR") + (:values (enc 45 23 1 2 3 2013 0) 0)) + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00 JST") + (:values (enc 0 0 0 1 1 2013 -9) 0)) + (=>? (rfc822 "Sat, 01 Feb 2013 01:23:45 JST") + (:values (enc 45 23 1 1 2 2013 -9) 0)) + (=>? (rfc822 "01 Dec 13 00:00 JST") + (:values (enc 0 0 0 1 12 2013 -9) 0)) + + (=>? (rfc822 "24 Dec 49 12:00 EST") + (:values (enc 0 0 12 24 12 2049 -5) 0)) + (=>? (rfc822 "24 Dec 50 12:00 EST") + (:values (enc 0 0 12 24 12 1950 -5) 0)) + + (=>? (rfc822 "Sat, 01 Jan 2000 00:00:00.42 GMT") + (:values (enc 0 0 0 1 1 2000 0) 0.42)) + (=>? (rfc822 "Sat, 01 Jan 2000 00:00:00:42 GMT") + (:values (enc 0 0 0 1 1 2000 0) 0.42)) + + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00 +0700") + (:values (enc 0 0 0 1 1 2013 -7) 0)) + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00+1300") + (:values (enc 0 0 0 1 1 2013 -13) 0)) + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00 +07:00") + (:values (enc 0 0 0 1 1 2013 -7) 0)) + (=>? (rfc822 "Sat, 01 Jan 2013 00:00:00+13:00") + (:values (enc 0 0 0 1 1 2013 -13) 0)) + (=>? (rfc822 "Sat, 01 Mar 2008 19:42:34 -0500") + (:values (enc 34 42 19 1 3 2008 5) 0)) + (=>? (rfc822 "Sat, 01 Mar 2008 19:42:34-0500") + (:values (enc 34 42 19 1 3 2008 5) 0)) + (=>? (rfc822 "Sat, 01 Mar 2008 19:42:34 -05:00") + (:values (enc 34 42 19 1 3 2008 5) 0)) + (=>? (rfc822 "Sat, 01 Mar 2008 19:42:34-05:00") + (:values (enc 34 42 19 1 3 2008 5) 0)) + + (=>? (rfc822 "Thu, 01 Jan 2004") + (:values (enc 0 0 0 1 1 2004 0) 0)) + (=>? (rfc822 "01 Jan 2004") + (:values (enc 0 0 0 1 1 2004 0) 0)) + (=>? (rfc822 "1 Jan 04") + (:values (enc 0 0 0 1 1 2004 0) 0)) + + (=>? (rfc822 "Sun Jan 4 16:29:06 PST 2004") + (:values (enc 6 29 16 4 1 2004 -8) 0)) + + (=>? (rfc822 "Thu Jul 23 19:42:23 JST 2013") + (:values (enc 23 42 19 23 7 2013 -9) 0)) + + (=>? (rfc822 "Thudesday, 23-Jul-13 19:42:23 GMT") + (:values (enc 23 42 19 23 7 2013 0) 0)) + + ;; supplemental this year + (let ((this-year (nth-value 5 (decode-universal-time + (get-universal-time) 0)))) + (=>? (rfc822 "Thu, 01 Jan") + (:values (enc 0 0 0 1 1 this-year 0) 0)) + (=>? (rfc822 "01 Jan") + (:values (enc 0 0 0 1 1 this-year 0) 0)) + (=>? (rfc822 "1 Jan") + (:values (enc 0 0 0 1 1 this-year 0) 0))) + + ) + + +(defun parse-iso8601-genus (date-time-string) + "Parse DATE-TIME-STRING with ISO8601, W3CDTF or RFC3339 format, +and return (values UNIVERSAL-TIME FRACTION). + +Reference: + * ISO8601:1988, 2000, 2004 + -- http://www.iso.org/iso/home/standards/iso8601.htm + * W3CDTF -- http://www.w3.org/TR/1998/NOTE-datetime-19980827 + * RFC3339 -- http://tools.ietf.org/html/rfc3339 +" + (let* ((universal-time 0) + (fraction 0) + (leap-year? nil) + ;; date-time separater is #\T, #\t or #\Space, c.f. rfc3339, 5.6. + (date-time (ppcre:split "(?<=\\d)[Tt ](?=\\d|$)" date-time-string)) + (date-part (first date-time)) + (time-part (second date-time))) + (when time-part + (let* ((time-zone (ppcre:split "(?<=\\d)(?=[zZ+-])" time-part)) + (time-part (first time-zone)) + (zone-part (second time-zone))) + + ;; 0. Parse ZONE-part: + (when zone-part + (unless (string-equal "Z" zone-part) + (case (length zone-part) + ((2 3) ; "+h", "+hh" + (decf universal-time (* #.+hour-secs+ (parse-integer zone-part)))) + (5 ; "+hhmm" + (multiple-value-bind (h m) + (truncate (parse-integer zone-part) 100) + (decf universal-time (+ (* h #.+hour-secs+) (* m #.+minuite-secs+))))) + (6 ; "+hh:mm" + (multiple-value-bind (h m) + (truncate (parse-integer (remove #\: zone-part)) 100) + (decf universal-time (+ (* h #.+hour-secs+) (* m #.+minuite-secs+))))) + (t + (error "~S in ~S is unknown time-format as ISO8601-Genus" + zone-part date-time-string))))) + + ;; 1. Parse TIME-part: + (if (every #'digit-char-p time-part) + (loop ;Basic format: "hh", "hhmm", "hhmmss", "hhmmssss" + :repeat (ceiling (length time-part) 2) + :for (start end) :in '((0 2) (2 4) (4 6)) + :for num := (parse-integer time-part :start start :end end) + :for secs :in '#.(list +hour-secs+ +minuite-secs+ +second+) + :do (incf universal-time (* num secs)) + :finally (when (<= 7 (length time-part)) + (setf fraction + (parse-float (replace time-part "00000."))))) + (loop ;Extended format: "hh:mm", "hh:mm:ss", "hh:mm:ss,ss" + :for d :in (ppcre:split "[:,.]" time-part) ;"," for iso8601, "." for rfc3339 + :for secs :in '#.(list +hour-secs+ +minuite-secs+ +second+) + :do (incf universal-time (* (parse-integer d) secs)) + :finally (when (<= 10 (length time-part)) + (setf fraction + (parse-float (replace time-part "00000000.")))))))) + + ;; 2. Parse DATE-part: + (labels + ;; 2.0. Parse DATE-part (local functions): + ((parse-weeks (token) ;"Www" + (let ((num-weeks (parse-integer token :start 1 :end 3))) + (incf universal-time (* 7 (1- num-weeks) +day-secs+)))) + + (parse-days (token) ;"D", "DDD" + (let ((num-days (parse-integer token))) + (incf universal-time (* (1- num-days) +day-secs+)))) + + (parse-month (month leap-year?) + (incf universal-time (month-to-ut month leap-year?))) + + (parse-year (year) + (incf universal-time (year-to-ut year)) + (setf leap-year? (leap-year-p year))) + + (parse-extended-format (date) + ;; Parse iso8601 extended format + ;; "YYYY-MM", "YY-MM-DD", "YYYY-MM-DD", "YYYY-DDD", "YYYY-Www-D", "YYYYYY-DDD" + (loop + :for token :in (split-sequence #\- date) + :with year-parsed? := nil + :with month-parsed? := nil + :do (case (length token) + ;; "YY", "MM", "DD" + (2 (if year-parsed? + (if month-parsed? + (parse-days token) + (progn + (parse-month (parse-integer token) leap-year?) + (setf month-parsed? t))) + (progn + ;; c.f. RFC 3339, 3. Two Digit Years, last item + (when (<= #.(char-code #\:) (char-code (char token 0))) + (let ((broken-two-digit-year (copy-seq token))) + (setf (char token 0) + (digit-char (- (char-code (char token 0)) #.(char-code #\:)))) + (warn "Broken two-digit year ~S was parsed as \"~S\". (c.f. RFC 3339, 3.)" + broken-two-digit-year (+ 2000 (parse-integer token))))) + (parse-year (+ 2000 (parse-integer token))) + (setf year-parsed? t)))) + ;; "YYYY", "YYYYYY" + ((4 6) (parse-year (parse-integer token)) + (setf year-parsed? t)) + ;; "Www", "D", "DDD" + ((1 3) (if (find #\W token :test #'char-equal) + (parse-weeks token) + (parse-days token))) + (t (error "~S in ~S is unknown time-format as ISO8601-Genus" + token date))))) + + (parse-basic-format (date) + ;; Parse iso8601 basic format + ;; "CC", "DDD", "YYYY", "YYDDD", "YYMMDD", "YYYYDDD", "YYYYMMDD" + (case (length date) + ;; Memo: + ;; ISO8601-century format can not be parsed. + ;; ISO8601-century is a 2-digit which slided forward 99 years comparing to ordinay-century. + ;; e.g. 20 iso8601-century means the year between 2000 and 2099, + ;; whereas usually 20th century means the year between 1901 and 2000. + ;; "CC" + (2 (error "ISO8601 century ~S could not be parsed." date)) + ;; "DDD" + (3 (parse-days date)) + ;; "YYYY" + (4 (parse-year (parse-integer date))) + ;; "YYDDD" + (5 ;; c.f. RFC 3339, 3. Two Digit Years, last item + (when (<= #.(char-code #\:) (char-code (char date 0))) + (let ((broken-two-digit-year (subseq date 0 2))) + (setf (char date 0) + (digit-char (- (char-code (char date 0)) #.(char-code #\:)))) + (warn "Broken two-digit year ~S was parsed as \"~S\". (c.f. RFC 3339, 3.)" + broken-two-digit-year (+ 2000 (parse-integer date :start 0 :end 2))))) + (parse-year (+ 2000 (parse-integer date :start 0 :end 2))) + (parse-days (subseq date 2))) + ;; "YYMMDD" + (6 (parse-year (+ 2000 (parse-integer date :start 0 :end 2))) + (parse-month (parse-integer date :start 2 :end 4) leap-year?) + (parse-days (subseq date 4))) + ;; "YYYYDDD" + (7 (parse-year (parse-integer date :start 0 :end 4)) + (parse-days (subseq date 4))) + ;; "YYYYMMDD" + (8 (parse-year (parse-integer date :start 0 :end 4)) + (parse-month (parse-integer date :start 4 :end 6) leap-year?) + (parse-days (subseq date 6))) + (t (error "~S in ~S is unknown time-format as ISO8601-Genus" + date date-time-string))))) + + ;; 2.1. Parse DATE-part (main): + (if (find #\- date-part) + ;; Extended format: + ;; "-YY", "-YY-MM", "-YYMM", "-YY-MM-DD", + ;; "YYYY-MM", "YYYY-MM-DD", "YYYY-DDD", "YYYY-Www-D", "YYYYYY-DDD" + (if (char= #\- (char date-part 0)) + ;; "-YY", "-YY-MM", "-YYMM", "-YY-MM-DD" -> "20YY", "20YY-MM", "20YYMM", "20YY-MM-DD" + (let ((replaced (ppcre:regex-replace "-" date-part "20"))) + (if (find #\- replaced) + ;; "20YY-MM", "20YY-MM-DD" + (parse-extended-format replaced) + ;; "20YY", "20YYMM" -> "20YY0101", "20YYMM01" + (parse-basic-format (replace (copy-seq "00000101") replaced)))) + ;; "YYYY-MM", "YYYY-MM-DD", "YYYY-DDD", "YYYY-Www-D", "YYYYYY-DDD" + (parse-extended-format date-part)) + ;; Basic format: + ;; "CC", "YYYY", "YYDDD", "YYMMDD", "YYYYMMDD", "YYYYWwwD" + (parse-basic-format date-part))) + + ;; 3. Return values + (values universal-time fraction))) + + +#+et (flet ((iso8601 (x) (parse-iso8601-genus x)) + (enc (&rest args) (apply #'encode-universal-time args))) + + (=>? (iso8601 "2000-01-01T00:00:00Z") + (:values (enc 0 0 0 1 1 2000 0) 0)) + + (=>? (iso8601 "2003-12-31T10:14:55.7-08:00") + (:values (enc 55 14 10 31 12 2003 +8) 0.7)) + (=>? (iso8601 "2003-12-31T10:14:55.7-0800") + (:values (enc 55 14 10 31 12 2003 +8) 0.7)) + + (=>? (iso8601 "2003-12-31T10:14:55+08:00") + (:values (enc 55 14 10 31 12 2003 -8) 0)) + (=>? (iso8601 "2003-12-31T10:14:55+0800") + (:values (enc 55 14 10 31 12 2003 -8) 0)) + + (=>? (iso8601 "2003-12-31T10:14:55.7Z") + (:values (enc 55 14 10 31 12 2003 0) 0.7)) + (=>? (iso8601 "2003-12-31T10:14:55Z") + (:values (enc 55 14 10 31 12 2003 0) 0)) + + (=>? (iso8601 "2003-12-31T10:14Z") + (:values (enc 0 14 10 31 12 2003 0) 0)) + + (=>? (iso8601 "2003-12-31T101455-08:00") + (:values (enc 55 14 10 31 12 2003 +8) 0)) + (=>? (iso8601 "2003-12-31T101455-0800") + (:values (enc 55 14 10 31 12 2003 +8) 0)) + (=>? (iso8601 "2003-12-31T1014-08:00") + (:values (enc 0 14 10 31 12 2003 +8) 0)) + (=>? (iso8601 "2003-12-31T1014-0800") + (:values (enc 0 14 10 31 12 2003 +8) 0)) + (=>? (iso8601 "2003-12-31T1014557Z") + (:values (enc 55 14 10 31 12 2003 0) 0.7)) + (=>? (iso8601 "2003-12-31T101455Z") + (:values (enc 55 14 10 31 12 2003 0) 0)) + (=>? (iso8601 "2003-12-31T1014Z") + (:values (enc 0 14 10 31 12 2003 0) 0)) + (=>? (iso8601 "2003-12-31T10Z") + (:values (enc 0 0 10 31 12 2003 0) 0)) + + (=>? (iso8601 "2003") + (:values (enc 0 0 0 1 1 2003 0) 0)) + (=>? (iso8601 "2003-12") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (iso8601 "2003-12-31") + (:values (enc 0 0 0 31 12 2003 0) 0)) + (=>? (iso8601 "20031231") + (:values (enc 0 0 0 31 12 2003 0) 0)) + + (=>? (iso8601 "-03-12") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (iso8601 "-03") + (:values (enc 0 0 0 1 1 2003 0) 0)) + (=>? (iso8601 "-0312") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (iso8601 "-03-12-31") + (:values (enc 0 0 0 31 12 2003 0) 0)) + + (=>? (iso8601 "03-12-31") + (:values (enc 0 0 0 31 12 2003 0) 0)) + + (=>? (iso8601 "031231") + (:values (enc 0 0 0 31 12 2003 0) 0)) + + (=>? (iso8601 "2003335") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (iso8601 "2003-335") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (iso8601 "03335") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (iso8601 "03-335") + (:values (enc 0 0 0 1 12 2003 0) 0)) + ) + + +(defun parse-date-time (date-time-string) + "Parse DATE-TIME-STRING, and return (values UNIVERSAL-TIME FRACTION). +DATE-TIME-STRING must represent the date-time after 1900-01-01T00:00:00Z. + +Parsable Formats: + * RFC822 Genus: RFC822 (RFC1123, RFC2822, RFC5322), RFC850 (RFC1036) and asctime. + * ISO8601 Genus: ISO 8601 (:1988, :2000 and :2004. except for no-year format), + W3CDTF, RFC3339. + * Broken format: The above formats with little broken. + +Examples: + * (parse-date-time \"Thu, 23 Jul 2013 19:42:23 JST\") + => 3583564943, 0 + + * (parse-date-time \"2013-07-23T19:42:23+09:00\") + => 3583564943, 0 + + * (parse-date-time \"23 Jul 13 19:42:23 +0900\") + => 3583564943, 0 + + * (parse-date-time \"Thu Jul 23 19:42:23 JST 2013\") + => 3583564943, 0 + + * (parse-date-time \"2013-07-23T19:42:23.45Z\") + => 3583597343, 0.45 + + For more examples, see Eval-Test in date-time-parser.lisp" + (check-type date-time-string string) + (if (ppcre:scan "[a-zA-Z]{2}" date-time-string) + (parse-rfc822-genus date-time-string) + (parse-iso8601-genus date-time-string))) + + +#+et (flet ((parse (x) (parse-date-time x)) + (enc (&rest args) (apply #'encode-universal-time args))) + + ;; rfc822-genus + (=>? (parse "Sat, 01 Jan 2013 00:00:00 GMT") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (parse "Sat, 01 Jan 2013 00:00:00 gmt") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (parse "Sat, 01 Jan 2013 00:00:00 Z") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (parse "Sat, 01 Jan 2013 00:00:00Z") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (parse "Sat, 01 Jan 2013 00:00:00 z") + (:values (enc 0 0 0 1 1 2013 0) 0)) + (=>? (parse "Sat, 01 Jan 2013 00:00:00z") + (:values (enc 0 0 0 1 1 2013 0) 0)) + + (=>? (parse "Sat, 02 Mar 2013 01:23:45 EDT") + (:values (enc 45 23 1 2 3 2013 -4) 0)) + (=>? (parse "Sat, 02 Mar 2013 01:23:45 FOOBAZBAR") + (:values (enc 45 23 1 2 3 2013 0) 0)) + (=>? (parse "Sat, 01 Jan 2013 00:00:00 JST") + (:values (enc 0 0 0 1 1 2013 -9) 0)) + (=>? (parse "Sat, 01 Feb 2013 01:23:45 JST") + (:values (enc 45 23 1 1 2 2013 -9) 0)) + (=>? (parse "01 Dec 13 00:00 JST") + (:values (enc 0 0 0 1 12 2013 -9) 0)) + + (=>? (parse "24 Dec 49 12:00 EST") + (:values (enc 0 0 12 24 12 2049 -5) 0)) + (=>? (parse "24 Dec 50 12:00 EST") + (:values (enc 0 0 12 24 12 1950 -5) 0)) + + (=>? (parse "Sat, 01 Jan 2000 00:00:00.42 GMT") + (:values (enc 0 0 0 1 1 2000 0) 0.42)) + (=>? (parse "Sat, 01 Jan 2000 00:00:00:42 GMT") + (:values (enc 0 0 0 1 1 2000 0) 0.42)) + + (=>? (parse "Sat, 01 Jan 2013 00:00:00 +0700") + (:values (enc 0 0 0 1 1 2013 -7) 0)) + (=>? (parse "Sat, 01 Jan 2013 00:00:00+1300") + (:values (enc 0 0 0 1 1 2013 -13) 0)) + (=>? (parse "Sat, 01 Jan 2013 00:00:00 +07:00") + (:values (enc 0 0 0 1 1 2013 -7) 0)) + (=>? (parse "Sat, 01 Jan 2013 00:00:00+13:00") + (:values (enc 0 0 0 1 1 2013 -13) 0)) + + (=>? (parse "Thu, 01 Jan 2004") + (:values (enc 0 0 0 1 1 2004 0) 0)) + (=>? (parse "01 Jan 2004") + (:values (enc 0 0 0 1 1 2004 0) 0)) + (=>? (parse "1 Jan 04") + (:values (enc 0 0 0 1 1 2004 0) 0)) + + (=>? (parse "Sun Jan 4 16:29:06 PST 2004") + (:values (enc 6 29 16 4 1 2004 -8) 0)) + + ;; iso8601-genus + (=>? (parse "2000-01-01T00:00:00Z") + (:values (enc 0 0 0 1 1 2000 0) 0)) + + (=>? (parse "2003-12-31T10:14:55.7-08:00") + (:values (enc 55 14 10 31 12 2003 +8) 0.7)) + (=>? (parse "2003-12-31T10:14:55.7-0800") + (:values (enc 55 14 10 31 12 2003 +8) 0.7)) + + (=>? (parse "2003-12-31T10:14:55+08:00") + (:values (enc 55 14 10 31 12 2003 -8) 0)) + (=>? (parse "2003-12-31T10:14:55+0800") + (:values (enc 55 14 10 31 12 2003 -8) 0)) + + (=>? (parse "2003-12-31T10:14:55.7Z") + (:values (enc 55 14 10 31 12 2003 0) 0.7)) + (=>? (parse "2003-12-31T10:14:55Z") + (:values (enc 55 14 10 31 12 2003 0) 0)) + + (=>? (parse "2003-12-31T10:14Z") + (:values (enc 0 14 10 31 12 2003 0) 0)) + + (=>? (parse "2003-12-31T101455-08:00") + (:values (enc 55 14 10 31 12 2003 +8) 0)) + (=>? (parse "2003-12-31T101455-0800") + (:values (enc 55 14 10 31 12 2003 +8) 0)) + (=>? (parse "2003-12-31T1014-08:00") + (:values (enc 0 14 10 31 12 2003 +8) 0)) + (=>? (parse "2003-12-31T1014-0800") + (:values (enc 0 14 10 31 12 2003 +8) 0)) + (=>? (parse "2003-12-31T1014557Z") + (:values (enc 55 14 10 31 12 2003 0) 0.7)) + (=>? (parse "2003-12-31T101455Z") + (:values (enc 55 14 10 31 12 2003 0) 0)) + (=>? (parse "2003-12-31T1014Z") + (:values (enc 0 14 10 31 12 2003 0) 0)) + (=>? (parse "2003-12-31T10Z") + (:values (enc 0 0 10 31 12 2003 0) 0)) + + (=>? (parse "2003") + (:values (enc 0 0 0 1 1 2003 0) 0)) + (=>? (parse "2003-12") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (parse "2003-12-31") + (:values (enc 0 0 0 31 12 2003 0) 0)) + (=>? (parse "20031231") + (:values (enc 0 0 0 31 12 2003 0) 0)) + + (=>? (parse "-03-12") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (parse "-03") + (:values (enc 0 0 0 1 1 2003 0) 0)) + (=>? (parse "-0312") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (parse "-03-12-31") + (:values (enc 0 0 0 31 12 2003 0) 0)) + + (=>? (parse "03-12-31") + (:values (enc 0 0 0 31 12 2003 0) 0)) + + (=>? (parse "031231") + (:values (enc 0 0 0 31 12 2003 0) 0)) + + (=>? (parse "2003335") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (parse "2003-335") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (parse "03335") + (:values (enc 0 0 0 1 12 2003 0) 0)) + (=>? (parse "03-335") + (:values (enc 0 0 0 1 12 2003 0) 0)) + + ;; c.f. RFC 3339, 3. Two Digit Years, last item + (=>? (parse ":0-09-09") + (:values (enc 0 0 0 9 9 2000 0) 0)) + (=>? (parse ";0-09-09") + (:values (enc 0 0 0 9 9 2010 0) 0)) + + ;; supplemental this year + (let ((this-year (nth-value 5 (decode-universal-time + (get-universal-time) 0)))) + (=>? (parse "Thu, 01 Jan") + (:values (enc 0 0 0 1 1 this-year 0) 0)) + (=>? (parse "01 Jan") + (:values (enc 0 0 0 1 1 this-year 0) 0)) + (=>? (parse "1 Jan") + (:values (enc 0 0 0 1 1 this-year 0) 0))) + + ;; bogus W3CDTF (invalid hour) + (=>? (parse "2003-12-31T25:14:55Z") + (:values (enc 55 14 1 1 1 2004 0) 0)) + + ;; bogus W3CDTF (invalid minute) + (=>? (parse "2003-12-31T10:61:55Z") + (:values (enc 55 1 11 31 12 2003 0) 0)) + + ;; bogus W3CDTF (invalid second) + (=>? (parse "2003-12-31T10:14:61Z") + (:values (enc 1 15 10 31 12 2003 0) 0)) + + ;; MSSQL date time format + (=>? (parse "2004-07-08 23:56:58.7") + (:values (enc 58 56 23 8 7 2004 0) 0.7)) + + ;; MSSQL-ish date time format (without fractional second) + (=>? (parse "2004-07-08 23:56:58") + (:values (enc 58 56 23 8 7 2004 0) 0)) + + ;; above some examples from http://pythonhosted.org/feedparser/date-parsing.html + ) + + +;; Cleanup for Eval-Test +(eval-when (:compile-toplevel :load-toplevel :execute) + (setf *features* *features-tmp*)) + + +;;==================================================================== diff --git a/jd-time-utils-package.lisp b/jd-time-utils-package.lisp new file mode 100644 index 0000000..7b97b09 --- /dev/null +++ b/jd-time-utils-package.lisp @@ -0,0 +1,35 @@ + +(defpackage jd-time-utils + (:use #:cl) + (:export + ;; date-time object + #:date-time #:date-time-p + #:date-time-year #:date-time-month #:date-time-day + #:date-time-hour #:date-time-minute #:date-time-second + #:date-time-fractional-second #:date-time-day-of-week + #:date-time-ut #:date-time-fractional-year + #:julian-time #:julian-time-p + #:julian-time-day #:julian-time-second #:julian-time-nanosecond + ;; comparisons + #:date-time= #:date-time> #:date-time< #:date-time>= #:date-time<= + + ;; time-utils-utils.lisp + #:gregorian-date-to-jd + #:gregorian-date-to-jd-seconds + #:universal-time-from-calendar-date + #:get-local-timezone-at-ut + #:get-local-timezone-at-calendar-date + #:jd-to-jd-seconds ;; JD to JD-SECONDS from start of JD epoch + #:jd-to-universal-time ;; JD to UT-SECONDS + #:jd-to-gregorian-date + #:jd-seconds-to-gregorian-date + #:universal-time-to-julian-time + ;; the main CL-resembling functions - note that timezone defaults to 0 + ;; rather than local, and daylight savings is not returned + #:encode-universal-time/extended + #:decode-universal-time/extended + + #:change-date-time-timezone + #:parse-date-time-string + + )) diff --git a/jd-time-utils-parse.lisp b/jd-time-utils-parse.lisp new file mode 100644 index 0000000..dc7552e --- /dev/null +++ b/jd-time-utils-parse.lisp @@ -0,0 +1,120 @@ + +(in-package jd-time-utils) + + +(defun %compute-fractional-year (year ut-dbl) + (declare (type (integer 0 10000) year) + (type double-float ut-dbl)) + (let ((ut-yr-start (encode-universal-time/extended 0 0 0 1 1 year :timezone 0)) + ;; we define the year as ending as 1 second past YYYY-12-31:23:59:59 + ;; to avoid any trickery with the leap second resetting at the start of the + ;; next year. Not sure if this is right thing to do. + (ut-yr-end (+ 1 (encode-universal-time/extended 59 59 23 31 12 year :timezone 0)))) + (+ year + (/ (- ut-dbl ut-yr-start) + (- ut-yr-end ut-yr-start))))) + +(defun parse-date-time-string (string &key + (date-convention nil) + (century-change-year 50) + (try-standard-formats t) + (output-timezone 0)) + "Parse a STRING representating a date and time. + +If TRY-STANDARD-FORMATS first favoring standard conventions +in CL-DATE-TIME-PARSER. + +Then resort to DATE-FORMAT which is one of + :MM-DD-YYYY :DD-MM-YYYY :YYYY-MM-DD :MM-DD-YY :DD-MM-YY. +In cases of XX-XX-YY where the year has 2 digits, use CENTURY-CHANGE-YEAR +to decide whether it is 2000+YY or 1900+YY. + +The standard RFC formats are (from CL-DATE-TIME-PARSER) + + Thu, 23 Jul 2013 19:42:23 GMT (RFC1123), + Thu Jul 23 19:42:23 2013 (asctime), + Thursday, 23-Jul-13 19:42:23 GMT (RFC1036), + 2013-07-23T19:42:23Z (RFC3339), + 20130723T194223Z (ISO8601:2004), etc. + +The resultant DATE-TIME object is always returned with OUTPUT-TIMEZONE +which defaults to 0 (GMT/UT)" + (declare (type (member nil :mm-dd-yyyy :dd-mm-yyyy :yyyy-mm-dd + :mm-dd-yy :dd-mm-yy) + date-convention) + (type string string)) + (block retblock + (let ((ut nil) (frac nil) + (timezone 0) + year month day) + + ;; try our DATE-CONVENTION method first + (when date-convention + (let* ((s2 (substitute #\- #\/ string)) ;; replace / with - + (digits + (ignore-errors (mapcar 'parse-integer + (split-sequence:split-sequence #\- s2))))) + ;; all our date formats consist of 3 numbers + (when (= (length digits) 3) + (cond ((eq date-convention :mm-dd-yyyy) + (setf year (third digits)) + (setf month (first digits)) + (setf day (second digits))) + ;; + ((eq date-convention :mm-dd-yy) ;; 2 digit year - yuck + ;; YY<30 is 20YY else 19YY + (setf year (let ((y (third digits))) + (cond ((< y century-change-year) + (+ y 2000)) + (t + (+ y 1900))))) + (setf month (first digits)) + (setf day (second digits))) + ;; + ((eq date-convention :dd-mm-yyyy) + (setf year (third digits)) + (setf day (first digits)) + (setf month (second digits))) + ;; + ((eq date-convention :dd-mm-yy) ;; 2 digit year - yuck + ;; YY<30 is 20YY else 19YY + (setf year (let ((y (third digits))) + (cond ((< y century-change-year) + (+ y 2000)) + (t + (+ y 1900))))) + (setf day (first digits)) + (setf month (second digits))) + ;; + ((eq date-convention :yyyy-mm-dd) + (setf year (first digits)) + (setf day (third digits)) + (setf month (second digits))))))) + ;; now if it failed try the RFC ways in CL-DATE-TIME-PARSER + (if (or (not day) (not month) (not year) + (not (< 0 day 32)) + (not (< 0 month 13))) + ;; if our :YYYY-MM-DD etc parsing failed, do the fancy RFC ways + (if (not try-standard-formats) + (return-from retblock nil) ;; no more to do - can't parse + ;; else parse using cl-date-time-parser + (progn + (multiple-value-setq (ut frac) + (ignore-errors + (cl-date-time-parser/jd-time-utils:parse-date-time string))) + (if (numberp frac) (setf frac (float frac 1d0))) + (when (not ut) + (return-from retblock nil)))) + ;; + ;; else our way succeeded so convert it to a UT + (progn (setf frac 0d0) + (setf ut (ignore-errors + (encode-universal-time/extended + 0 0 0 day month year :timezone timezone))) + (when (not ut) (return-from retblock nil)))) + + (let ((nanoseconds (floor (* (or frac 0) 1d9)))) + (build-date-time-struct-from-ut + ut :timezone output-timezone :nanoseconds nanoseconds))))) + + diff --git a/jd-time-utils-struct.lisp b/jd-time-utils-struct.lisp new file mode 100644 index 0000000..e64e267 --- /dev/null +++ b/jd-time-utils-struct.lisp @@ -0,0 +1,71 @@ + +(in-package jd-time-utils) + +(defstruct julian-time + (day 0 :type (unsigned-byte 64)) + (second 0 :type (unsigned-byte 64)) + (nanosecond 0 :type (unsigned-byte 64))) + +(defstruct date-time + (year 0 :type (integer 0 10000)) + (month 0 :type (integer 0 12)) + (day 0 :type (integer 0 31)) + (hour 0 :type (integer 0 23)) + (minute 0 :type (integer 0 59)) + (second 0 :type (integer 0 59)) + ;; lisp universal time, and fractional seconds + (fractional-second 0d0 :type double-float) + (day-of-week 0 :type (integer 0 7)) + (ut 0 :type (signed-byte 60)) + (timezone 0.0 :type (real -24 24)) + (fractional-year 0d0 :type double-float) + (julian-time nil :type (or null julian-time))) + + +(defun date-time= (dt1 dt2) + (= (date-time-ut dt1) (date-time-ut dt2))) +(defun date-time> (dt1 dt2) + (> (date-time-ut dt1) (date-time-ut dt2))) +(defun date-time< (dt1 dt2) + (< (date-time-ut dt1) (date-time-ut dt2))) +(defun date-time>= (dt1 dt2) + (>= (date-time-ut dt1) (date-time-ut dt2))) +(defun date-time<= (dt1 dt2) + (<= (date-time-ut dt1) (date-time-ut dt2))) + + +(defun change-date-time-timezone (date-time timezone) + "Change the DATE-TIME structure to TIMEZONE, which must be in -24 to +24. Note that DATE-TIME-FRACTIONAL-YEAR is always in timezone 0." + (declare (type date-time date-time) + (type (real -24 24) timezone)) + (multiple-value-bind (second minute hour day month year dow) + (decode-universal-time (date-time-ut date-time) (rational timezone)) + (make-date-time + :year year :month month :day day :hour hour :minute minute :second second + :day-of-week dow + :fractional-second (date-time-fractional-second date-time) + :timezone (float timezone 1.0) + :ut (date-time-ut date-time) + :fractional-year (date-time-fractional-year date-time)))) + + + +(defun build-date-time-struct-from-ut (ut &key (timezone 0) + (nanoseconds 0)) + (declare (type (signed-byte 60) ut)) + (let ((frac (* nanoseconds 1d-9))) + (multiple-value-bind (jd jd-sec jd-nanosec) + (universal-time-to-julian-time ut nanoseconds) + (multiple-value-bind (sec min hr date mon yr dow) + (decode-universal-time/extended ut :timezone timezone) + (make-date-time + :year yr :month mon :day date :hour hr :minute min :second sec + :day-of-week dow + :fractional-year (%compute-fractional-year + yr + (+ ut (* 1d-9 frac))) + :fractional-second frac + :ut ut + :julian-time (make-julian-time :day jd :second jd-sec :nanosecond jd-nanosec) + :timezone timezone))))) diff --git a/jd-time-utils-test.lisp b/jd-time-utils-test.lisp new file mode 100644 index 0000000..73bc097 --- /dev/null +++ b/jd-time-utils-test.lisp @@ -0,0 +1,65 @@ + + + +(defpackage jd-time-utils/test + (:use #:cl #:jd-time-utils) + (:export + #:test-encode/decode-ut + #:test-encode/decode-random-dates + + )) + +(in-package jd-time-utils/test) + + +;; compare these JD-based routines to built-in universal-time functions + +(defun test-encode/decode-ut (second minute hour date month year &key (timezone 0)) + "Throw an error if result from our routines fails to match encode-universal-time +and decode-universal-time going from date to UT back to date." + (multiple-value-bind (ut-orig) + (encode-universal-time + second minute hour date month year timezone) + (multiple-value-bind (ut-new) + (jd-time-utils:encode-universal-time/extended + second minute hour date month year :timezone timezone) + (when (not (= ut-orig ut-new)) + (error "encode failure at ~A with UT-ORIG=~A UT-NEW=~A" + (list second minute hour date month year :timezone timezone) + ut-orig ut-new)) + (multiple-value-bind (sec0 min0 hr0 date0 mon0 year0 dow0 ignore0 tz0) + (decode-universal-time ut-new timezone) + (declare (ignore ignore0)) ;; daylight savings + (multiple-value-bind (sec1 min1 hr1 date1 mon1 year1 dow1 ignore1 tz1) + (decode-universal-time/extended ut-new :timezone timezone) + (declare (ignore ignore1)) ;; daylight savings + (when (not (and (= sec0 sec1) + (= min0 min1) + (= hr0 hr1) + (= date0 date1) + (= mon0 mon1) + (= year0 year1) + (= dow0 dow1) + (= tz0 tz1))) + (error "encode failure at orig: ~A new: ~A with UT-ORIG=~A UT-NEW=~A" + (list sec0 min0 hr0 date0 mon0 year0 dow0 tz0) + (list sec1 min1 hr1 date1 mon1 year1 dow1 tz1) + ut-orig ut-new))))))) + +(defun test-encode/decode-random-dates (&key (n-iter 1000000)) + "Run test-encode/decode-ut for n-iter iterations on random dates after 1900." + (loop for i below n-iter + for year = (+ 1900 (random 200)) + do + (test-encode/decode-ut + (random 60) ;; 1-59 + (random 60) + (random 24) + (1+ (random 31)) + (1+ (random 12)) + year + ;; time zone can't nudge it before 1900-01-01T00:00:00 + :timezone (if (> year 1900) + (+ -24 (random 49)) + 0)))) + diff --git a/jd-time-utils-utils.lisp b/jd-time-utils-utils.lisp new file mode 100644 index 0000000..f808eaa --- /dev/null +++ b/jd-time-utils-utils.lisp @@ -0,0 +1,307 @@ + +(in-package jd-time-utils) + +(defun gregorian-date-to-jd (second minute hour date month year + &key (gregorian-transition t)) + "Convert calendar to Julian Day. +Return (JD N-SECONDS N-NANO-SEC). + +If GREGORIAN-TRANSITION is set, then dates before Oct 15, 1582 are +treated according to Julian calendar, which is necessary, for example, +for getting year 1AD correct." + + (declare (type (integer -10000000000 10000000000) year) + (type (integer 1 12) month) + (type (integer 1 31) date) + (type (integer 0 23) hour) + (type (integer 0 60) minute) + (type (real 0 60) second) + (optimize speed)) + + + (let ((igreg #.(+ 15 (* 31 (+ 10 (* 12 1582))))) + (jy 0) (jm 0) (julday 0) (ja 0) + (nsec 0) (nnsec 0)) + (declare (type (signed-byte 60) igreg jm julday ja nsec nnsec) + (type (integer #.(- (expt 10 12)) + #.(+ (expt 10 12))) + jy)) + + (cond + ((> month 2) + (setf jy year) + (setf jm (1+ month))) + (t + (setf jy (1- year)) + (setf jm (+ month 13)))) + + (setf julday (+ (+ (+ (floor (* 365.25d0 jy)) + (floor (* 30.6001d0 jm))) + date) + 1720995)) + + (when gregorian-transition + (when (>= (+ date (* 31 (+ month (* 12 year)))) igreg) + (setf ja (floor (* 0.01d0 jy))) + (setf julday (+ (- (+ julday 2) ja) (floor (* 0.25d0 ja)))))) + + (cond ((integerp second) + (setf nsec (+ (* 3600 hour) (* 60 minute) second))) + ((floatp second) + (multiple-value-bind (fullsec fracsec) + (floor (if (typep second 'single-float) + (float second 1d0) + second)) + (setf nsec (+ (* 3600 hour) (* 60 minute) fullsec)) + (setf nnsec (floor (* #.(expt 10 9) fracsec))))) + (t ;; the math at this point can involve rationals + (locally + (declare (optimize (speed 1))) + (multiple-value-bind (fullsec fracsec) + (floor second) + (setf nsec (+ (* 3600 hour) (* 60 minute) fullsec)) + (setf nnsec (floor (* #.(expt 10 9) fracsec))))))) + + (values julday nsec nnsec))) + +(defun gregorian-date-to-jd-seconds (second minute hour date month year + &key (gregorian-transition t)) + "Return Julian seconds as (values nseconds n-nanonseconds)." + (multiple-value-bind (jd nsec nnsec) + (gregorian-date-to-jd second minute hour date month year + :gregorian-transition gregorian-transition) + (values (+ (* jd #.(* 24 3600)) + nsec) + nnsec))) + + +(defconstant +jd-1900+ 2415021) ;; JD of start of Lisp epoch 1900-00-00T00:00:00 +(defconstant +jd-1900-sec+ (* +jd-1900+ 24 3600)) ;; in seconds + +(defun universal-time-from-calendar-date + (second minute hour date month year + &key (gregorian-transition t)) + "Use JD calculation to compute a Lisp 1900-based universal time +integer, which will be negative before 1900. After 1900, it should match +(encode-universal-time ..) for time zone zero. + +Returns (VALUES SECONDS NANOSECONDS)" + (multiple-value-bind (jul-sec jul-nanosec) + (gregorian-date-to-jd-seconds second minute hour date month year + :gregorian-transition gregorian-transition) + + (values (- jul-sec +jd-1900-sec+) + jul-nanosec))) + + +(defun get-local-timezone-at-ut (lisp-ut) + "Get this location's time zone at a particular lisp UT, using 1900 AD for +LISP-UT<0. Uses builtin time functions." + (if (not (minusp lisp-ut)) + (nth-value 8 (decode-universal-time (get-universal-time))) + ;; for UT<0, get the timezone at UT=0 + (nth-value 8 (decode-universal-time 0)))) + +(defun get-local-timezone-at-calendar-date (second minute hour date month year) + "Get this location's time zone at a particular date, using 1900 AD for earlier +times. Uses builtin time functions." + (let ((ut (if (>= year 1900) + (encode-universal-time second minute hour date month year) + ;; for Year<1900, get the timezone at 1900-01-01 + (encode-universal-time 0 0 0 1 1 1900)))) + (get-local-timezone-at-ut ut))) + + + + + + + + +(defun jd-to-jd-seconds (jd jd-seconds-of-day jd-nanoseconds) + "Convert JD JD-SECONDS-OF-DAY JD-NANOSECONDS to Julian Day seconds +with 0 at January 1, 4713 BC in proleptic Julian calendar. + +Return (VALUES JD-SECONDS JD-NANOSECONDS) where JD-NANOSECONDS is +appropriately truncated." + (declare (type (signed-byte 60) jd jd-seconds-of-day jd-nanoseconds)) + (let ((%sec 0) + (%nanosec 0)) + (declare (type (unsigned-byte 60) %sec %nanosec) + (optimize speed)) + + (multiple-value-bind (sec2 nanosec2) + (floor jd-nanoseconds #.(expt 10 9)) + (setf %sec (+ jd-seconds-of-day sec2)) + (setf %nanosec nanosec2)) + + (values + (+ (* jd 24 3600) %sec) + %nanosec))) + + +(defun jd-to-universal-time (jd jd-seconds jd-nanoseconds) + "Convert JD, JD-SECONDS and JD-NANOSECONDS to Lisp universal time +seconds as (VALUES SECONDS NANOSECONDS)." + (multiple-value-bind (jds jdns) + (jd-to-jd-seconds jd jd-seconds jd-nanoseconds) + (values + (- jds +jd-1900-sec+) + jdns))) + + + +(defun jd-to-gregorian-date (jday seconds nanoseconds &key (gregorian-transition t)) + "convert a Julian day back into a calendar day, returning + + (VALUES + SECONDS MINUTES HOURS DATE MONTH YEAR DAY-OF-WEEK NANOSECONDS) + +If GREGORIAN-TRANSITION is set, then dates before Oct 15, 1582 are +treated according to Julian calendar, which is necessary, for example, +for getting year 1AD correct." + + + (declare (type (signed-byte 60) jday seconds nanoseconds)) + + (let ((igreg 2299161) + (julian 0) (id 0) (iyyy 0) (jb 0) (jc 0) + (ja 0) (jd 0) (je 0) (jalpha 0) (mm 0) + (hr 0) (min 0) (sec 0) + (day-of-week 0) + (%jday 0) (%secs 0) (%nanosec 0)) + (declare (type (signed-byte 60) igreg mm id iyyy jb jc ja jalpha day-of-week) + (type (signed-byte 60) %jday %secs %nanosec) + (optimize speed)) + + ;; normalize nanoseconds to 0 to 10^9-1 + (multiple-value-bind (sec2 nanosec2) + (floor nanoseconds #.(expt 10 9)) + (setf %secs (+ seconds sec2)) + (setf %nanosec nanosec2)) + ;; Normalize seconds to 0 to 24*3600-1 + (multiple-value-bind (day2 sec2) + (floor %secs #.(* 24 3600)) + (setf %jday (+ jday day2)) + (setf %secs sec2)) + + (setf julian %jday) ;; the true JD + ;; handle the gregorian transition date + (cond + ((and gregorian-transition + (>= julian igreg) ) + (setf jalpha (floor + (* (- (- julian 1867216) 0.25d0) #.(/ 36524.25d0)))) + (setf ja (- (+ (+ julian 1) jalpha) (floor (* 0.25d0 jalpha))))) + ;; + (t + (setf ja julian))) + + (setf sec %secs) + (setf jb (+ ja 1524)) + (setf jc (floor + (+ 6680 + (* (- (- jb 2439870) 122.0999d0) #.(/ 365.25d0)))) ) + (setf jd (+ (* 365 jc) (floor (* 0.25d0 jc)))) + (setf je (floor (* (- jb jd) #.(/ 30.6001d0)))) + (setf id (- (- jb jd) (floor (* 30.6001d0 je)))) + (setf mm (1- je)) + (if (> mm 12) (setf mm (- mm 12))) + (setf iyyy (- jc 4715)) + (if (> mm 2) (setf iyyy (1- iyyy))) + (if (<= iyyy 0) (setf iyyy (1- iyyy))) + + (setf hr (truncate sec 3600)) + (decf sec (* hr 3600)) + (setf min (truncate (the unsigned-byte sec) 60)) + (decf sec (* min 60)) + + (assert (<= 0 hr 23)) + (assert (<= 0 min 59)) + (assert (<= 0 sec 59)) + (assert (<= 0 %nanosec #.(1- (expt 10 9)))) + (setf day-of-week (mod julian 7)) + (values sec min hr id mm iyyy day-of-week %nanosec))) + +(defun jd-seconds-to-gregorian-date (jd-sec jd-nanosec &key (gregorian-transition t)) + "Convert JD-SECONDS and JD-NANOSECONDS to a date" + (jd-to-gregorian-date 0 jd-sec jd-nanosec :gregorian-transition t)) + +(defun universal-time-to-julian-time (ut-sec nanoseconds) + (let* ((jd-sec (+ ut-sec +jd-1900-sec+)) ;; seconds in jd epoch + (%jday 0) (%secs 0) (%nanosec 0)) + + ;; normalize nanoseconds to 0 to 10^9-1 + (multiple-value-bind (sec2 nanosec2) + (floor nanoseconds #.(expt 10 9)) + (setf %secs (+ jd-sec sec2)) + (setf %nanosec nanosec2)) + ;; Normalize seconds to 0 to 24*3600-1 + (multiple-value-bind (day2 sec2) + (floor %secs #.(* 24 3600)) + (setf %jday day2) + (setf %secs sec2)) + ;; + (values %jday %secs %nanosec))) + + + + + +(defun encode-universal-time/extended (second minute hour date month year + &key (timezone 0) + (gregorian-transition t)) + "Extended version of ENCODE-UNIVERSAL-TIME using JD to perform computations. + +Differences relative to standard function: + + - TIMEZONE is 0 by default, and NIL does not mean use local time zone. + - GREGORIAN-TRANSITION means switch from Gregorian to Julian calendar + on Oct 15, 1582. + - NANOSECONDS keyword gives nanosecond resolution. + - Returns (VALUES SECONDS NANOSECONDS)." + + + (declare (type (rational -24 24) timezone)) + (let ((timezone-sec (floor (* timezone 3600)))) + (multiple-value-bind (jul-sec jul-nsec) + (gregorian-date-to-jd-seconds second minute hour date month year + :gregorian-transition gregorian-transition) + + (values (- (+ jul-sec timezone-sec) +jd-1900-sec+) + jul-nsec)))) + + +(defun decode-universal-time/extended (lisp-ut &key (timezone 0) + (nanoseconds 0) + (gregorian-transition t)) + "Extended version of DECODE-UNIVERSAL-TIME using JD to perform computations +returning + + (VALUES + SECOND MINUTE HOUR DATE MONTH YEAR DAY-OF-WEEK NANOSECONDS) + +Differences relative to standard function: + + - TIMEZONE is 0 by default, and NIL does not mean use local time zone. + Time zones increase to West in Lisp convention + - GREGORIAN-TRANSITION means switch from Gregorian to Julian calendar + on Oct 15, 1582. + - NANOSECONDS keyword gives nanosecond resolution. + - Returns (VALUES SECOND MINUTE HOUR DATE MONTH YEAR DAY-OF-WEEK + NANOSECONDS ;; instead of daylight savings T or NIL + TIMEZONE) + so that " + + (let* ((timezone-sec (floor (* timezone 3600))) + (jd-sec (+ lisp-ut (- timezone-sec) +jd-1900-sec+))) + (multiple-value-bind (second minute hour date month year dow nanoseconds) + (jd-seconds-to-gregorian-date jd-sec nanoseconds + :gregorian-transition gregorian-transition) + (values + second minute hour date month year dow + ;; NB: no daylight savings information + nanoseconds timezone)))) + + + diff --git a/jd-time-utils.asd b/jd-time-utils.asd new file mode 100644 index 0000000..3fc9ab4 --- /dev/null +++ b/jd-time-utils.asd @@ -0,0 +1,33 @@ + +(asdf:defsystem jd-time-utils + :depends-on (#:split-sequence + ;; for borrowed version of cl-date-time-parser + #:bordeaux-threads ;; for locking of timezones + #:alexandria #:split-sequence + #:anaphora + #:cl-ppcre + ;; local-time uses encode-universal-time + ;; only at load time, so OK for times before 1900 + #:local-time + ;; any version of parse-float will work if it has + ;; (parse-float:parse-float string) + #:parse-float) + :components + ((:file "jd-time-utils-package" :depends-on ()) + (:file "jd-time-utils-utils" :depends-on ("jd-time-utils-package")) + (:file "jd-time-utils-struct" :depends-on ("jd-time-utils-utils")) + ;; borrowed cl-date-time-parser, modified to use our version of + ;; encode-universal-time + (:file "jd-time-utils-cl-date-time-parser" + :depends-on ("jd-time-utils-utils")) + (:file "jd-time-utils-parse" + :depends-on ("jd-time-utils-cl-date-time-parser" + "jd-time-utils-utils")))) + + + + +(asdf:defsystem jd-time-utils/test + :depends-on (jd-time-utils) + :components + ((:file "jd-time-utils-test")))