Add *default-timezone* special variable.

Add timezone optional argument to to-universal-time.
Add timezone keyword argument to from-string.

ChangeLog

@@ -1,5 +1,11 @@
+2013-07-26  Yoshinori Tahara  <read.eval.print@gmail.com>
+
+	* Add *default-timezone* special variable.
+	* Add timezone optional argument to to-universal-time.
+	* Add timezone keyword argument to from-string.
+
 2011-11-03  Jeffrey Cunningham <jeffrey@jkcunningham.com>
-	
+
 	* added doc strings to most exported functions.
 
 2011-10-11  Yoshinori Tahara  <read.eval.print@gmail.com>

date-time-test.lisp

@@ -50,11 +50,25 @@
   (is (date= (make-date 2011 12 1) (month+ (make-date 2012  1 1) -1)))
   (is (date= (make-date 2012  1 1) (month+ (make-date 2012  2 1) -1))))
 
+(deftest test-to-universal-time ()
+  (is (= (encode-universal-time 0 0 0 1 1 2000 0)
+         (to-universal-time (make-date-time 2000 1 1 0 0 0) 0)))
+  (is (= (encode-universal-time 0 0 0 1 1 2000 -9)
+         (to-universal-time (make-date-time 2000 1 1 0 0 0) 9)))
+  (let ((*default-timezone* 9))
+    (is (= (encode-universal-time 0 0 0 1 1 2000 -9)
+           (to-universal-time (make-date-time 2000 1 1 0 0 0))))))
+
 (deftest test-from-string ()
   (is (date-time= (make-date-time 2011 9 8 23 36 1)
-                  (from-string "Mon, 08 Sep 2011 23:36:01 GMT")))
+                  (from-string "Mon, 08 Sep 2011 23:36:01 GMT" :timezone 0)))
   (is (date-time= (make-date-time 2011 9 8 23 36 1)
-                  (from-string "Mon, 08 Sep 2011 23:36:01 +0000"))))
+                  (from-string "Mon, 08 Sep 2011 23:36:01 +0000" :timezone 0)))
+  (is (date-time= (make-date-time 2011 9 9 8 36 1)
+                  (from-string "Mon, 08 Sep 2011 23:36:01 GMT" :timezone 9)))
+  (let ((*default-timezone* 9))
+    (is (date-time= (make-date-time 2011 9 9 8 36 1)
+                    (from-string "Mon, 08 Sep 2011 23:36:01 GMT")))))
 
 
 

date-time.lisp

@@ -1,5 +1,9 @@
 (in-package #:simple-date-time)
 
+(defparameter *default-timezone*
+  (- (car (last (multiple-value-list (decode-universal-time (get-universal-time))))))
+  "Default timezone. GMT is 0. JST is 9. EST is -5.")
+
 (defclass date-time ()
   ((year
     :initarg :year
@@ -308,15 +312,16 @@ arguments."
       (decode-universal-time universal-time)
     (make-date-time ye mo da ho mi se millisecond)))
 
-(defun to-universal-time (date-time)
+(defun to-universal-time (date-time &optional (timezone *default-timezone*))
   "Returns the universal time for DATE-TIME object (truncating
 milliseconds). "
   (encode-universal-time (second-of date-time)
                          (minute-of date-time)
                          (hour-of date-time)
                          (day-of date-time)
                          (month-of date-time)
-                         (year-of date-time)))
+                         (year-of date-time)
+                         (- timezone)))
 
 
 
@@ -359,7 +364,7 @@ current day."
   ;; TODO
   )
 
-(defun from-string (string &optional format)
+(defun from-string (string &key format (timezone *default-timezone*))
   "Returns a DATE-TIME object set from parsing STRING. "
   (if format
       (from-string-with-format string format)
@@ -370,14 +375,17 @@ current day."
                              (parse-integer string :start 8 :end 10)
                              (parse-integer string :start 10 :end 12)
                              (parse-integer string :start 12 :end 14)))
-            ((ppcre:register-groups-bind ((#'parse-integer day) (#'from-short-month-name month)
-                                          (#'parse-integer year hour minute second))
-                    ("\\S+, (\\d{2}) (.*) (\\d{4}) (\\d{2}):(\\d{2}):(\\d{2}) (GMT|[+-]\\d{4})" string)
-              ;; TODO TIMEZONE
-              ;; Mon, 09 Sep 2011 23:36:00 GMT
-              (make-date-time year month day hour minute second)))
+            ((ppcre:register-groups-bind
+                 ((#'parse-integer day) (#'from-short-month-name month)
+                  (#'parse-integer year hour minute second)
+                  ((lambda (x) (or (parse-integer x :junk-allowed t) 0)) tz))
+                 ("\\S+, (\\d{2}) (.*) (\\d{4}) (\\d{2}):(\\d{2}):(\\d{2}) (GMT|[+-]\\d{4})" string)
+               ;; Mon, 09 Sep 2011 23:36:00 GMT
+               (hour+ (minute+ (make-date-time year month day hour minute second)
+                               (- (+ (* (truncate tz 100) 60) (mod tz 100))))
+                      timezone)))
             (t ;; TODO
-              nil))))
+             nil))))
 
 (defun yyyy/mm/dd (date-time)
   "Write string for  DATE-TIME object in format: yyyy/mm/dd"
@@ -432,12 +440,9 @@ current day."
           (year-of date-time) (month-of date-time) (day-of date-time)
           (hour-of date-time) (minute-of date-time) (second-of date-time)))
 
-(defun http-date (date-time &optional timezone)
+(defun http-date (date-time &optional (timezone *default-timezone*))
   "Write string for HTTP-Date"
-  (let* ((tz (or timezone (car (last (multiple-value-list
-                                      (decode-universal-time
-                                       (to-universal-time date-time)))))))
-	 (date-tz (hour+ date-time tz)))
+  (let ((date-tz (hour+ date-time (- timezone))))
     (format nil "~a, ~02,'0d ~a ~04,'0d ~02,'0d:~02,'0d:~02,'0d GMT"
 	    (day-name-of date-tz)
 	    (day-of date-tz)

package.lisp

@@ -64,5 +64,6 @@
            #:|yyyymmddThhmmssZ|
            #:http-date
 	   #:rfc-2822
+           #:*default-timezone*
            ))