;; ------------------------------------------------------------
;; time classes: wall-time, duration
-(eval-when (:compile-toplevel :load-toplevel)
+(eval-when (:compile-toplevel :load-toplevel)
(defstruct (wall-time (:conc-name time-)
(:constructor %make-wall-time)
(:print-function %print-wall-time))
(mjd 0 :type fixnum)
(second 0 :type fixnum)
- (usec 0 :type fixnum))
+ (usec 0 :type fixnum)
+ (is-utc? nil :type boolean))
(defun %print-wall-time (time stream depth)
(declare (ignore depth))
;; ------------------------------------------------------------
;; Constructors
+(defun %localtime-timestamp-offset (time)
+ (when (time-is-utc? time)
+ (return-from %localtime-timestamp-offset 0))
+ (multiple-value-bind (tusec tsec tmin thour tday tmonth tyear)
+ (decode-time time)
+ (multiple-value-bind (_nsec _sec _min _hour _day _month _year
+ _day-of-week _daylight-saving-time-p
+ offset)
+ (local-time:decode-timestamp
+ (local-time:encode-timestamp
+ (* 1000 (or tusec 0)) tsec tmin thour tday tmonth tyear))
+ (declare (ignore _nsec _sec _min _hour _day _month _year
+ _day-of-week _daylight-saving-time-p))
+ offset)))
+
+(defun time-to-utc (in)
+ "Ensures that if we have a time thats not in UTC, treat it as a localtime,
+ and convert to UTC"
+ (if (time-is-utc? in)
+ in
+ (let ((newt
+ (time+ in (make-duration :second (%localtime-timestamp-offset in)))))
+ (setf (time-is-utc? newt) T)
+ newt)))
+
(defun make-time (&key (year 0) (month 1) (day 1) (hour 0) (minute 0)
- (second 0) (usec 0) (offset 0))
- (let ((mjd (gregorian-to-mjd month day year))
- (sec (+ (* hour 60 60)
- (* minute 60)
- second (- offset))))
- (multiple-value-bind (day-add raw-sec)
- (floor sec (* 60 60 24))
- (%make-wall-time :mjd (+ mjd day-add) :second raw-sec :usec usec))))
+ (second 0) (usec 0) (offset nil))
+ (let* ((mjd (gregorian-to-mjd month day year))
+ (sec (+ (* hour 60 60)
+ (* minute 60)
+ second (or offset 0)))
+ (time (multiple-value-bind (day-add raw-sec)
+ (floor sec (* 60 60 24))
+ (%make-wall-time :mjd (+ mjd day-add)
+ :second raw-sec :usec (or usec 0)
+ :is-utc? (if offset t nil)))))
+ time))
(defun make-date (&key (year 0) (month 1) (day 1) (hour 0) (minute 0)
- (second 0) (usec 0) (offset 0))
+ (second 0) (usec 0) (offset nil))
(time->date (make-time :year year :month month :day day :hour hour
- :minute minute :second second :usec usec :offset offset)))
+ :minute minute :second second :usec usec
+ :offset offset)))
(defun copy-time (time)
(%make-wall-time :mjd (time-mjd time)
- :second (time-second time)))
+ :second (time-second time)
+ :usec (time-usec time)
+ :is-utc? (time-is-utc? time)))
(defun utime->time (utime)
"Return a pair: (GREGORIAN DAY . TIME-OF-DAY)"
(time-ymd time)
(multiple-value-bind (hour minute second)
(time-hms time)
- (values (time-usec time) second minute hour day month year (mod (+ (time-mjd time) 3) 7)))))
+ (values (time-usec time) second minute hour day month year
+ (mod (+ (time-mjd time) 3) 7)
+ (time-is-utc? time)))))
(defun date-ymd (date)
(time-ymd (date->time date)))
(duration< y x))
(defun %time< (x y)
+ (setf x (time-to-utc x)
+ y (time-to-utc y))
(let ((mjd-x (time-mjd x))
(mjd-y (time-mjd y)))
(if (/= mjd-x mjd-y)
(< (time-usec x) (time-usec y))))))
(defun %time>= (x y)
+ (setf x (time-to-utc x)
+ y (time-to-utc y))
(if (/= (time-mjd x) (time-mjd y))
(>= (time-mjd x) (time-mjd y))
(if (/= (time-second x) (time-second y))
(>= (time-usec x) (time-usec y)))))
(defun %time<= (x y)
+ (setf x (time-to-utc x)
+ y (time-to-utc y))
(if (/= (time-mjd x) (time-mjd y))
(<= (time-mjd x) (time-mjd y))
(if (/= (time-second x) (time-second y))
(<= (time-usec x) (time-usec y)))))
(defun %time> (x y)
+ (setf x (time-to-utc x)
+ y (time-to-utc y))
(if (/= (time-mjd x) (time-mjd y))
(> (time-mjd x) (time-mjd y))
(if (/= (time-second x) (time-second y))
(> (time-usec x) (time-usec y)))))
(defun %time= (x y)
+ (setf x (time-to-utc x)
+ y (time-to-utc y))
(and (= (time-mjd x) (time-mjd y))
(= (time-second x) (time-second y))
(= (time-usec x) (time-usec y))))
;; ------------------------------------------------------------
;; Formatting and output
-(defun db-timestring (time &key stream)
+(defun db-timestring (time &key stream )
"return the string to store the given time in the database"
(if stream
(progn (write-char #\' stream) (iso-timestring time :stream stream) (write-char #\' stream))
(concatenate 'string "'" (iso-timestring time) "'")))
(defun iso-timestring (time &key stream)
- (multiple-value-bind (usec sec min hour day month year dow)
+ (multiple-value-bind (usec sec min hour day month year dow is-utc?)
(decode-time time)
(declare (ignore dow))
(flet ((fmt (stream)
(setf usec (- usec (* quo x10)))
(princ quo stream)
(when (= rem 0) (return)))))
+ (when is-utc? (princ #\Z stream))
nil))
(if stream
(fmt stream)
"produces on stream the timestring corresponding to the wall-time
with the given options"
(let ((*print-circle* nil))
- (multiple-value-bind (usec second minute hour day month year dow)
+ (multiple-value-bind (usec second minute hour day month year dow is-utc?)
(decode-time time)
(case format
(:pretty
(pretty-time hour minute)
month day year))
((:iso :iso8601) (iso-timestring time :stream stream))
- (t (format stream "~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D.~6,'0D"
+ (t (format stream "~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D.~6,'0D~A"
year date-separator month date-separator day
internal-separator hour time-separator minute time-separator
- second usec)
- )))))
+ second usec
+ (if is-utc? "Z" ""))
+ )))))
(defun pretty-time (hour minute)
(cond
;; Parsing iso-8601 timestrings
(define-condition iso-8601-syntax-error (sql-user-error)
- ((bad-component;; year, month whatever
+ ((input :initarg :input :reader input)
+ (bad-component;; year, month whatever
:initarg :bad-component
:reader bad-component))
(:report (lambda (c stream)
- (format stream "Bad component: ~A " (bad-component c)))))
+ (format stream "Bad component: ~A of input: ~A "
+ (bad-component c) (input c)))))
(defun parse-timestring (timestring &key (start 0) end junk-allowed)
"parse a timestring and return the corresponding wall-time. If the
:usec usec
:offset offset)))
+(defun %frac-string-to-usec (frac-str)
+ (when frac-str
+ (let* ((frac (parse-integer frac-str))
+ (frac-len (length frac-str))
+ (frac-exp (- 6 frac-len)))
+ (floor (* frac (expt 10 frac-exp))))))
+
+(defun %parse-offset-string (offset-str input &aux (len (length offset-str)))
+ (when (zerop len)
+ (return-from %parse-offset-string nil))
+ (when (and (= len 1) (char= #\Z (char offset-str 0)))
+ (return-from %parse-offset-string 0))
+ (let ((pos? (char= #\+ (char offset-str 0)))
+ (colon? (position #\: offset-str)))
+ (unless (or (member len '(3 5)) ;; +05 or -0530
+ (and colon? (= 6 len))) ;; +05:30
+ (error 'iso-8601-syntax-error
+ :input input
+ :bad-component `(timezone . ,offset-str)))
+ (handler-bind ((error (lambda (c) (declare (ignore c))
+ (error 'iso-8601-syntax-error
+ :input input
+ :bad-component `(timezone . ,offset-str))
+ )))
+ (let* ((hours (parse-integer offset-str :start 1 :end 3))
+ (hsec (* 60 60 hours))
+ (sec (* 60 (cond
+ (colon?
+ (parse-integer offset-str :start 4))
+ ((> len 3)
+ (parse-integer offset-str :start 3))
+ (t 0))))
+ (total (+ hsec sec)))
+ (if pos? (- total) total)))))
(defun syntax-parse-iso-8601 (string)
;; use strlen to determine if fractional seconds are present in timestamp
second (if (<= 19 strlen)
(parse-integer string :start 17 :end 19)
0))
- (cond
- ((and (> strlen 19)
- (or (char= #\, (char string 19))
- (char= #\. (char string 19))))
- (multiple-value-bind (parsed-usec usec-end)
- (parse-integer string :start 20 :junk-allowed t)
- (let ((parsed-usec (and parsed-usec
- (floor (* parsed-usec (expt 10 (+ 6 (- usec-end) 20)))))))
- (setf usec (or parsed-usec 0)
- gmt-sec-offset (if (<= (+ 3 usec-end) strlen)
- (let ((skip-to (or (position #\+ string :start 19)
- (position #\- string :start 19))))
- (if skip-to
- (* 60 60
- (parse-integer string :start skip-to
- :end (+ skip-to 3)))
- 0))
- 0)))))
- (t
- (setf usec 0
- gmt-sec-offset (if (<= 22 strlen)
- (let ((skip-to (or (position #\+ string :start 19)
- (position #\- string :start 19))))
- (if skip-to
- (* 60 60
- (parse-integer string :start skip-to
- :end (+ skip-to 3)))
- 0))
- 0))))
- (unless (< 0 year)
- (error 'iso-8601-syntax-error
- :bad-component '(year . 0)))
- (unless (< 0 month)
- (error 'iso-8601-syntax-error
- :bad-component '(month . 0)))
- (unless (< 0 day)
- (error 'iso-8601-syntax-error
- :bad-component '(month . 0)))
- (values year month day hour minute second usec gmt-sec-offset))
+ (when (> strlen 19)
+ ;; fractional second
+ (let* ((has-frac? (or (char= #\, (char string 19))
+ (char= #\. (char string 19))))
+ (z-idx (position #\Z string :start 19))
+ (offset-start (or (position #\+ string :start 19)
+ (position #\- string :start 19)))
+ (frac-end (or z-idx offset-start strlen ))
+ (frac-string (when has-frac? (subseq string 20 frac-end)))
+ (offset-string (when offset-start
+ (subseq string offset-start))))
+ (setf usec (or (%frac-string-to-usec frac-string)
+ 0)
+ gmt-sec-offset
+ (cond
+ (z-idx 0)
+ (offset-string
+ (%parse-offset-string offset-string string))))))
+
+ (unless (< 0 year)
+ (error 'iso-8601-syntax-error
+ :input string
+ :bad-component '(year . 0)))
+ (unless (< 0 month)
+ (error 'iso-8601-syntax-error
+ :bad-component '(month . 0)))
+ (unless (< 0 day)
+ (error 'iso-8601-syntax-error
+ :bad-component '(month . 0)))
+ (values year month day hour minute second usec gmt-sec-offset))
(simple-error ()
(error 'iso-8601-syntax-error
:bad-component
`((year . ,year) (month . ,month)
(day . ,day) (hour . ,hour)
(minute . ,minute) (second . ,second)
- (usec . ,usec)
- (timezone . ,gmt-sec-offset)))))))))
+ (usec . ,usec)))))))))
(deftest :time/iso-parse/0
(let* ((time1 (parse-timestring "2010-01-23")))
(decode-time time1))
- 0 0 0 0 23 1 2010 6)
+ 0 0 0 0 23 1 2010 6 nil)
(deftest :time/iso-parse/1
(let* ((time1 (parse-timestring "2010-01-23T14:56:32Z")))
(decode-time time1))
- 0 32 56 14 23 1 2010 6)
+ 0 32 56 14 23 1 2010 6 T)
(deftest :time/iso-parse/2
(let* ((time1 (parse-timestring "2008-02-29 12:46:32")))
(decode-time time1))
- 0 32 46 12 29 2 2008 5)
+ 0 32 46 12 29 2 2008 5 nil)
(deftest :time/iso-parse/3
(let* ((time1 (parse-timestring "2010-01-23 14:56:32.44")))
(decode-time time1))
- 440000 32 56 14 23 1 2010 6)
+ 440000 32 56 14 23 1 2010 6 nil)
(deftest :time/iso-parse/4
(let* ((time1 (parse-timestring "2010-01-23 14:56:32.0044")))
(decode-time time1))
- 4400 32 56 14 23 1 2010 6)
+ 4400 32 56 14 23 1 2010 6 nil)
(deftest :time/iso-parse/5
(let* ((time1 (parse-timestring "2010-01-23 14:56:32.000003")))
(decode-time time1))
- 3 32 56 14 23 1 2010 6)
+ 3 32 56 14 23 1 2010 6 nil)
+
+(deftest :time/iso-parse/6
+ (let* ((time1 (parse-timestring "2010-01-23T14:56:32-05")))
+ (decode-time time1))
+ 0 32 56 19 23 1 2010 6 t)
+
+(deftest :time/iso-parse/7
+ (let* ((time1 (parse-timestring "2010-01-23T14:56:32-05")))
+ (decode-time time1))
+ 0 32 56 19 23 1 2010 6 t)
+
+(deftest :time/iso-parse/8
+ (let* ((time1 (parse-timestring "2010-01-23T14:56:32-05:30")))
+ (decode-time time1))
+ 0 32 26 20 23 1 2010 6 t)
(deftest :time/print-parse/1
;;make sure when we print and parse we get the same time.
(string-time (iso-timestring time))
(time2 (parse-timestring string-time)))
(decode-time time2))
- 0 44 15 14 4 1 2010 1)
+ 0 44 15 14 4 1 2010 1 nil)
(deftest :time/print-parse/2
;;make sure when we print and parse we get the same time.
(string-time (iso-timestring time))
(time2 (parse-timestring string-time)))
(decode-time time2))
- 3 44 15 14 4 1 2010 1)
+ 3 44 15 14 4 1 2010 1 nil)
;; relations of intervals
;;; The cross platform dataset uses the 'timestamp' column type which is
;;; in sql-92, for all that means.
-
(deftest :time/cross-platform/no-usec/no-tz
(with-dataset *cross-platform-datetest*
(let ((time (parse-timestring "2008-09-09T14:37:29")))
)))
#.(format-time nil (parse-timestring "2008-09-09T14:37:29") :format :iso))
+ ;; I think the reasonable thing is that timezones be stripped and dates be
+ ;; converted to UTC, as the DB should be returning a zoneless stamp
(deftest :time/cross-platform/no-usec/tz
(with-dataset *cross-platform-datetest*
(let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
:where [= [testtime] time] ))))
(format-time nil (parse-timestring testtime) :format :iso)
)))
- #.(format-time nil (parse-timestring "2008-09-09T14:37:29-04:00") :format :iso))
+ ;; I think the reasonable thing is that timezones be stripped, as the DB should
+ ;; be returning a zoneless stamp
+ #.(format-time nil (parse-timestring "2008-09-09T18:37:29") :format :iso))
;;;This test gets at the databases that only support miliseconds,
;;; not microseconds.
:where [= [testtime] time] ))))
(format-time nil (parse-timestring testtime) :format :iso)
)))
- #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213-04:00") :format :iso))
+ #.(format-time nil (parse-timestring "2008-09-09T18:37:29.000213") :format :iso))
;;; All odbc databases use local times exclusively (they do not send timezone info)
;;; Postgresql can use timezones, except when being used over odbc. This test when
;;; run through both postgres socket and postgres odbc should test a fairly
-;;; broad swath of available problem space
+;;; broad swath of available problem space, Timestamptz should return UTC times,
+;;; timestamps should return zoneless local times
;;;
;;; Things the following tests try to prove correct
;;; * Reading and writing usec and usec-less times
:where [= [testtime] time] ))
(values (iso-timestring (parse-timestring testtime))
(iso-timestring (parse-timestring testtimetz))))))
- #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000213-04:00"))
+ #.(iso-timestring (parse-timestring "2008-09-09T18:37:29.000213"))
#.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
(deftest :time/pg/oodml/no-usec
(update-instance-from-records o)
(values (iso-timestring (testtime o))
(iso-timestring (testtimetz o))))))
- #.(iso-timestring (parse-timestring "2008-09-09T14:37:29-04:00"))
+ #.(iso-timestring (parse-timestring "2008-09-09T18:37:29"))
#.(iso-timestring (parse-timestring "2008-09-09T14:37:29-04:00")))
(deftest :time/pg/oodml/usec
(values (iso-timestring (testtime o))
(iso-timestring (testtimetz o)))
)))
- #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000278-04:00"))
+ #.(iso-timestring (parse-timestring "2008-09-09T18:37:29.000278"))
#.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000278-04:00")))
(deftest :time/historic-datetimes