/[iso8601-date]/iso8601-date/iso8601.lisp
ViewVC logotype

Contents of /iso8601-date/iso8601.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Thu Sep 28 18:38:18 2006 UTC (7 years, 6 months ago) by mkennedy
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +50 -45 lines
Patch from Andrew Philpot <philpot@isi.edu> to handle fractional seconds (by discarding them).
1 ;;;; -*- mode: lisp; package: iso8601-date -*-
2
3 ;; Author: Thomas Russ
4 ;; Date: October 29, 2004
5 ;; Copyright: This code is placed in the public domain
6 ;;
7 ;; Modified: September 8, 2006 by Andrew Philpot
8 ;; Recognize and discard any fractional seconds
9
10 (in-package #:iso8601-date)
11
12 (defun format-iso8601-time (time-value &optional include-timezone-p)
13 "Formats a universal time TIME-VALUE in ISO 8601 format, with the time zone
14 included if INCLUDE-TIMEZONE-P is non-NIL"
15 (flet ((format-iso8601-timezone (zone dst)
16 (when dst (decf zone))
17 (if (zerop zone)
18 "Z"
19 (multiple-value-bind (h m) (truncate (abs zone) 1.0)
20 ;; Tricky. Sign of time zone is reversed in ISO 8601
21 ;; relative to Common Lisp convention!
22 (format nil "~:[+~;-~]~2,'0D:~2,'0D"
23 (> zone 0) h (round m))))))
24 (multiple-value-bind (second minute hour day month year dow dst zone)
25 (decode-universal-time time-value)
26 (declare (ignore dow))
27 (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D~:[~*~;~A~]"
28 year month day hour minute second
29 include-timezone-p (format-iso8601-timezone zone dst)))))
30
31 (defun parse-iso8601-time (time-string)
32 "Parses an ISO 8601 format string and returns the universal time"
33 (flet ((parse-delimited-string (string delimiters n)
34 ;; Parses a delimited string and returns a list of n integers found in that string.
35 (let ((answer (make-list n :initial-element 0)))
36 (when (> (length string) 0)
37 (loop for i upfrom 0 below n
38 for start = 0 then (1+ end)
39 for end = (position-if #'(lambda (delim)
40 (member delim delimiters))
41 string :start (1+ start))
42 do (setf (nth i answer)
43 (parse-integer (subseq string start end)
44 :junk-allowed t))
45 when (null end) return t))
46 (values-list answer)))
47 (parse-fixed-field-string (string field-sizes)
48 ;; Parses a string with fixed length fields and returns a list of integers found in that string.
49 (let ((answer (make-list (length field-sizes) :initial-element 0)))
50 (loop with len = (length string)
51 for start = 0 then (+ start field-size)
52 for field-size in field-sizes
53 for i upfrom 0
54 while (< start len)
55 do (setf (nth i answer)
56 (zparse-integer (subseq string start (+ start field-size)))))
57 (values-list answer))))
58 (flet ((parse-iso8601-date (date-string)
59 (let ((hyphen-pos (position #\- date-string)))
60 (if hyphen-pos
61 (parse-delimited-string date-string '(#\-) 3)
62 (parse-fixed-field-string date-string '(4 2 2)))))
63 (parse-iso8601-timeonly (time-string)
64 (let* ((colon-pos (position #\: time-string))
65 (zone-pos (or (position #\- time-string)
66 (position #\+ time-string)
67 (position #\Z time-string)))
68 (timeonly-string (subseq time-string 0 zone-pos))
69 (zone-string (when zone-pos (subseq time-string (1+ zone-pos))))
70 (time-zone nil))
71 (when zone-pos
72 (multiple-value-bind (zone-h zone-m)
73 (parse-delimited-string zone-string '(#\: #\.) 2)
74 (setq time-zone (+ zone-h (/ zone-m 60)))
75 (when (char= (char time-string zone-pos) #\-)
76 (setq time-zone (- time-zone)))))
77 (multiple-value-bind (hh mm ss)
78 (if colon-pos
79 (parse-delimited-string timeonly-string '(#\: #\.) 3)
80 (parse-fixed-field-string timeonly-string '(2 2 2)))
81 (values hh mm ss time-zone)))))
82 (let ((time-separator (position #\T time-string)))
83 (multiple-value-bind (year month date)
84 (parse-iso8601-date
85 (subseq time-string 0 time-separator))
86 (if time-separator
87 (multiple-value-bind (hh mm ss zone)
88 (parse-iso8601-timeonly
89 (subseq time-string (1+ time-separator)))
90 (if zone
91 ;; Tricky: Sign of time zone is reversed in ISO 8601
92 ;; relative to Common Lisp convention!
93 (encode-universal-time ss mm hh date month year (- zone))
94 (encode-universal-time ss mm hh date month year)))
95 (encode-universal-time 0 0 0 date month year)))))))
96
97 ;;;; iso8601.asd ends here

  ViewVC Help
Powered by ViewVC 1.1.5