3. Dates and Times

Introduction

;;; Despite  standard Common Lisp  date &  time related  functions used  in this
;;; chapter,  there are  also these  date &  time libraries  which you  might be
;;; interested  in: local-time, net-telent-date,  and date-calc.   (Packages are
;;; available      via      ASDF-INSTALL.)       There      is      also      <a
;;; href="http://cybertiggyr.com/gene/pdl/">Parsing  Dates  in Lisp</a>  webpage
;;; written by G. M. Stover containing some utility scripts.

;;; As a shortcut,  below is a small  list of available Common Lisp  date & time
;;; builtins.

;;; Constant Variable <a href="http://l1sp.org/cl/internal-time-units-per-second">INTERNAL-TIME-UNITS-PER-SECOND</a>
;;; Function <a href="http://l1sp.org/cl/decode-universal-time">DECODE-UNIVERSAL-TIME</a>
;;; Function <a href="http://l1sp.org/cl/encode-universal-time">ENCODE-UNIVERSAL-TIME</a>
;;; Function <a href="http://l1sp.org/cl/get-universal-time">GET-UNIVERSAL-TIME</a>
;;; Function <a href="http://l1sp.org/cl/get-decoded-time">GET-DECODED-TIME</a>
;;; Function <a href="http://l1sp.org/cl/sleep">SLEEP</a>
;;; Function <a href="http://l1sp.org/cl/get-internal-real-time">GET-INTERNAL-REAL-TIME</a>
;;; Function <a href="http://l1sp.org/cl/get-internal-run-time">GET-INTERNAL-RUN-TIME</a>

;;; A "decoded time" is an ordered  series of nine values (second, minute, hour,
;;; day,  month, year,  dow,  daylight-p, and  timezone)  that, taken  together,
;;; represent a point in calendar time (ignoring leap seconds).

;;; "Universal time"  is an absolute  time represented as a  single non-negative
;;; integer  --- the  number  of seconds  since  midnight, January  1, 1900  GMT
;;; (ignoring leap seconds).

(get-universal-time)
; => 3445946614

(multiple-value-list (get-decoded-time))
; => (45 23 17 13 3 2009 4 NIL -2)

;;; Current  Common   Lisp  specification   is  lacking  of   a  day-of-the-year
;;; concept.   But  we   can  easily   implement   it  using   a  decoded   time
;;; specification.     (For     hairy    details     you     can    check     <a
;;; href="http://en.wikipedia.org/wiki/Calculating_the_day_of_the_week">related
;;; wikipedia page</a> out.)

(defun day-of-the-year (&optional universal-time)
  (let* ((decoded-time (multiple-value-list
                           (decode-universal-time
                            (or universal-time
                                (get-universal-time)))))
         (day          (elt decoded-time 3))
         (month        (elt decoded-time 4))
         (year         (elt decoded-time 5)))
    (loop for m from 2 to month
          do (incf day
                   (elt
                     (multiple-value-list
                         (decode-universal-time
                          (- (encode-universal-time 0 0 0 1 m year)
                             (* 60 60 24))))
                     3)))
    day))

(format t "Today is day ~A of the current year.~%" (day-of-the-year))
; => Today is day 72 of the current year.

(day-of-the-year (encode-universal-time 59 59 23 31 12 2009))
; => 365

(format t "Today is day ~A of the current year.~%" (day-of-the-year))

;;; And here is a quick & dirty `STRFTIME' utility.

(defmacro define-time-formatters (&body formatter-specs)
  `(list
    ,@(mapcar
       (lambda (formatter-spec)
         `(cons
           ,(first formatter-spec)
           (lambda (second minute hour day month year dow daylight-p zone)
             (declare (ignorable second minute hour day month year dow daylight-p zone))
             ,@(rest formatter-spec))))
       formatter-specs)))

(defvar *time-formatters*
  (define-time-formatters
    (#\a (elt #("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") dow))
    (#\b (elt #("Jan" "Feb" "Mar"
                "Apr" "May" "Jun"
                "Jul" "Aug" "Sep"
                "Oct" "Nov" "Dec")
              month))
    (#\d (format nil "~2,'0D" day))
    (#\H (format nil "~2,'0D" hour))
    (#j  (day-of-the-year
          (encode-universal-time
           second minute hour day month year dow zone)))
    (#\m (format nil "~2,'0D" month))
    (#\M (format nil "~2,'0D" minute))
    (#\S (format nil "~2,'0D" second))
    (#\w dow)
    (#\Y year)
    (#\z zone)))

(defun strftime (format &optional universal-time)
  (with-output-to-string (out)
    (loop for curr-index from 0
          for prev-special-p = nil then curr-special-p
          for curr-char across format
          for curr-special-p = (char-equal #\% curr-char)
          do (cond
               ((or (and prev-special-p curr-special-p)
                    (not (or prev-special-p curr-special-p)))
                (format out "~C" curr-char))
               (prev-special-p
                (format
                 out "~A"
                 (if (not (< curr-index (length format)))
                     (error "Missing directive at position ~D." curr-index)
                     (or (alexandria:when-let
                             (formatter
                              (find curr-char *time-formatters*
                                    :test #'char-equal :key #'car))
                           (apply
                            (cdr formatter)
                            (multiple-value-list
                                (decode-universal-time
                                 (or universal-time (get-universal-time))))))
                         (error "Invalid directive ~S at position ~D."
                                curr-char curr-index)))))))))

(strftime "%d %b, %Y, %a")
; => "12 Apr, 2009, Thu"

(let* ((today     (get-universal-time))
       (yesterday (- today (* 60 60 24))))
  (format t "Today    : ~A (~A)~%Yesterday: ~A (~A)~%"
          (strftime "%Y-%m-%d %H:%M:%S" today) today
          (strftime "%Y-%m-%d %H:%M:%S" yesterday) yesterday))
; => Today    : 2009-22-13 17:22:09 (3445946529)
;    Yesterday: 2009-22-12 17:22:09 (3445860129)

Finding Today's Date

;;;-----------------------------
;; use GET-DECODED-TIME to fetch the time
(multiple-value-bind
      (second minute hour date month year day-of-week dst-p tz)
    (get-decoded-time)
  year) ; prints out year using standard library

;; alternatively date-calc provides overlapping functionality
(multiple-value-bind (year month day h m s)
    (today-and-now)                     ; imported from date-calc
  year)                                 ; date-calc approach 

;; how to print out current date as "YYYY-MM-DD" (in approved ISO 8601 fashion)
(multiple-value-bind (year month day) 
    (today)                             ;imported from date-calc
  (format t "The current date is ~A-~2,'0d-~2,'0d" year month day))

;; Alternatively, you could use the format-time function from the
;; CyberTiggyr-Time package:
(format-time t "%Y-%m-%d" (get-universal-time))

;; As you can see, format-time operates on epoch time

Converting DMYHMS to Epoch Seconds

;;;-----------------------------
;; to encode time into universal time using date-calc
(multiple-value-bind
      (second minute hour date month year day-of-week dst-p tz)
    (get-decoded-time)
  (encode-universal-time second minute hour date month year))

;; The last two return values for get-decoded-time correspond to
;; daylight savings and the timezone.  Both are useful for
;; timezone-related arithmetic.

;;; @@INCOMPLETE@@
;; An example of a GMT computation with and without daylight savings
;; is appropriate here since the built-in perl functions handle this.

Converting Epoch Seconds to DMYHMS

;;;-----------------------------
(let ((time (get-universal-time))) ; get epoch seconds
  (multiple-value-bind
      (second minute hour day month year day-of-week dst-p tz)
      (decode-universal-time time) ; decode and...
    (list day month year hour minute second))) ; return

Adding to or Subtracting from a Date

;;;-----------------------------

;; when using universal time you add or subtract seconds
;; here we add one hour
(let ((firstdate 
       (encode-universal-time 0 12 6 23 11 2006))
      (onehour (* 60 60 1)))
  (+ onehour firstdate))

;; or you could use date-calc function
;; here we'll add one day
(add-delta-ymdhms 2006 11 24 18 12 0  0 0 1 0 0 0)

Difference of Two Dates

;;;-----------------------------
;; We'll use the epoch seconds to perform subtraction, 
;; then divide by seconds per day
(let ((first (encode-universal-time 52 45 20 13 12 1901))
      (second (encode-universal-time 7 14 3 19 1 2038)))
  (float (/ (- second first) (* 60 60 24))))

;; method two uses delta-days from the date-calc package:
(delta-days 1901 12 13 2038 1 19)

;; delta-days does not yet have the granularity of seconds, minutes or hours. 

Day in a Week/Month/Year or Week Number

;;;-----------------------------
;; The week of the year is computed as follows:
(week-number 2006 12 1)      ; week-of-year is imported from date-calc

;; similar functions exist for day of week, day of year, etc.

Parsing Dates and Times from Strings

;;;-----------------------------
(parse-time "2006-08-20")

;; PARSE-TIME can recognize many of the commonly found date formats

; format-time comes with several ways to format...
(format-time t *format-time-date* (get-universal-time))

; results in: 25 Nov 2006

(format-time t *format-time-iso8601-short* (get-universal-time))

; results in: 20061125T172917 -5

(format-time t "%Y-%m-%d" (get-universal-time))

; results in: 2006-11-25

Printing a Date

High-Resolution Timers

Short Sleeps

Program: hopdelta