r10376: 03 Apr 2005 Kevin Rosenberg <kevin@rosenberg.net>

[clsql.git] / sql / time.lisp

diff --git a/sql/time.lisp b/sql/time.lisp
index 8d0684658825b56e5ba37a316b36624fbcdb8e46..e5281d6b74720d353aef9c46bd2372d5ef267840 100644 (file)
--- a/sql/time.lisp
+++ b/sql/time.lisp
@@ -1013,20 +1013,22 @@ rules"
 ;; ------------------------------------------------------------
 ;; Parsing iso-8601 timestrings 
 
-(define-condition iso-8601-syntax-error (error)
+(define-condition iso-8601-syntax-error (sql-user-error)
   ((bad-component;; year, month whatever
     :initarg :bad-component
-    :reader bad-component)))
+    :reader bad-component))
+  (:report (lambda (c stream)
+            (format stream "Bad component: ~A " (bad-component c)))))
 
 (defun parse-timestring (timestring &key (start 0) end junk-allowed)
   "parse a timestring and return the corresponding wall-time.  If the
 timestring starts with P, read a duration; otherwise read an ISO 8601
 formatted date string."
-  (declare (ignore junk-allowed))  ;; FIXME
+  (declare (ignore junk-allowed))  
   (let ((string (subseq timestring start end)))
     (if (char= (aref string 0) #\P)
-        (parse-iso-8601-duration string)
-        (parse-iso-8601-time string))))
+       (parse-iso-8601-duration string)
+      (parse-iso-8601-time string))))
 
 (defvar *iso-8601-duration-delimiters*
   '((#\D . :days)
@@ -1083,25 +1085,32 @@ formatted date string."
 
 
 (defun syntax-parse-iso-8601 (string)
-  (let (year month day hour minute second gmt-sec-offset)
+  ;; use strlen to determine if fractional seconds are present in timestamp
+  (let ((strlen (length string))
+       year month day hour minute second gmt-sec-offset)
     (handler-case
         (progn
-          (setf year   (parse-integer (subseq string 0 4))
-                month  (parse-integer (subseq string 5 7))
-                day    (parse-integer (subseq string 8 10))
-                hour   (if (<= 13 (length string))
-                           (parse-integer (subseq string 11 13))
-                           0)
-                minute (if (<= 16 (length string))
-                           (parse-integer (subseq string 14 16))
-                           0)
-                second (if (<= 19 (length string))
-                           (parse-integer (subseq string 17 19))
-                           0)
-                gmt-sec-offset (if (<= 22 (length string))
-                                   (* 60 60
-                                      (parse-integer (subseq string 19 22)))
-                                   0))
+         (setf year           (parse-integer string :start 0 :end 4)
+                month          (parse-integer string :start 5 :end 7)
+                day            (parse-integer string :start 8 :end 10)
+                hour           (if (<= 13 strlen)
+                                   (parse-integer string :start 11 :end 13)
+                                  0)
+                minute         (if (<= 16 strlen)
+                                   (parse-integer string :start 14 :end 16)
+                                  0)
+                second         (if (<= 19 strlen)
+                                   (parse-integer string :start 17 :end 19)
+                                  0)
+                gmt-sec-offset (if (<= 20 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)))