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))))