Patches for local-time package

Edi Weitz <[email protected]> 30 Dec 2002 03:01:38 +0100
Newsgroups gmane.lisp.uncommon-sql
Message-ID <[email protected]>
Hi!

Sorry to write to all of you but it isn't clear to me where to send
patches.

I've just begun using local-time together with uncommonsql because I
wanted to use the type (LOCAL-TIME:LOCAL-TIME) in a
DEF-VIEW-CLASS. Below are some patches I had to make to make it work
for me. They address the following issues:

  1. The ISO-8601-functions didn't parse fractional seconds.

  2. There seems to be a bug in GMT-OFFSET.

  3. Some of my PostgreSQL timestamps can be NULL.

Happy New Year from Hamburg and thanks for your work on this,
Edi.



edi@bird:/usr/local/lisp/source/local-time > diff -u iso-8601.lisp.orig iso-8601.lisp
--- iso-8601.lisp.orig  Mon Dec 30 02:46:45 2002
+++ iso-8601.lisp       Mon Dec 30 02:46:53 2002
@@ -53,23 +53,40 @@
          (setq index next-index))))))

 (defun syntax-parse-iso-8601 (string)
-  (let (year month day hour minute second gmt-sec-offset)
+  (let (year month day hour minute (second 0) (msec 0) 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))
+          (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 (length string))
-                           (parse-integer (subseq string 11 13))
+                           (parse-integer string :start 11 :end 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 (when (<= 22 (length string))
-                                 (* +seconds/hour+ (parse-integer (subseq string 19 22)))))
+                           (parse-integer string :start 14 :end 16)
+                           0))
+          (when (<= 19 (length string))
+            (setf second
+                    (parse-integer string :start 17 :end 19))
+            (cond ((char= #\. (char string 19))
+                    (multiple-value-bind (int pos)
+                        (parse-integer string :start 20 :junk-allowed t)
+                      (setf msec (round (* 1000
+                                           (if (and int (plusp int))
+                                             (/ int (expt 10 (- pos 20)))
+                                             0))))
+                      (when (<= pos (length string))
+                        (setf gmt-sec-offset
+                                (* +seconds/hour+
+                                   (parse-integer string
+                                                  :start pos
+                                                  :end (+ pos 2)))))))
+                  ((<= 22 (length string))
+                    (setf gmt-sec-offset
+                            (* +seconds/hour+
+                               (parse-integer string
+                                              :start 19
+                                              :end 22))))))
           (unless (< 0 year)
             (error 'iso-8601-syntax-error
                    :bad-component '(year . 0)))
@@ -79,7 +96,7 @@
           (unless (< 0 day)
             (error 'iso-8601-syntax-error
                    :bad-component '(month . 0)))
-          (values year month day hour minute second gmt-sec-offset))
+          (values year month day hour minute second msec gmt-sec-offset))
       (simple-error ()
         (error 'iso-8601-syntax-error
                :bad-component
@@ -97,10 +114,11 @@
   "return the local-time corresponding to the given ISO 8601 datestring"
   (apply #'construct-local-time (multiple-value-list (syntax-parse-iso-8601 string))))

-(defun construct-local-time (year month day &optional (hour 0) (minute 0) (seconds 0) seconds-to-utc)
+(defun construct-local-time (year month day &optional (hour 0) (minute 0) (seconds 0) (msec 0) seconds-to-utc)
   (when (null seconds-to-utc)
     (setq seconds-to-utc (utc-offset)))
   (make-local-time :day (%lt-date year month day)
                    :sec (+ (* hour +seconds/hour+)
                            (* minute +seconds/minute+)
-                           seconds (- seconds-to-utc))))
+                           seconds (- seconds-to-utc))
+                   :msec msec))



edi@bird:/usr/local/lisp/source/local-time > diff -u unix.lisp.orig unix.lisp
--- unix.lisp.orig      Mon Dec 30 02:46:16 2002
+++ unix.lisp   Mon Dec 30 02:45:23 2002
@@ -59,7 +59,7 @@
          (loc (multiple-value-list (libc-localtime time)))
          (delta (mapcar #'- gmt loc)))
     (* -3600 (if (not (= 0 (nth 7 delta)))
-                (+ 24 (nth 2 delta))
+                (- (nth 2 delta) 24)
                 (nth 2 delta)))))

 (defun utc-offset ()



edi@bird:/usr/local/lisp/source/uncommonsql/sql > diff -u objects.lisp.orig objects.lisp
--- objects.lisp.orig   Mon Dec 30 02:47:34 2002
+++ objects.lisp        Mon Dec 30 01:45:21 2002
@@ -622,6 +622,8 @@
      ((subtypep type 'boolean) nil)
      ((subtypep type 'symbol) nil)
      ((subtypep type 'keyword) nil)
+     #+local-time
+     ((subtypep type 'local-time:local-time) nil)
      (t
       (error "Unable to handle null for type ~A" type))))