- Add SERVER-TIME-UNIVERSAL to convert a Unix timestamp to universal-time
authorMatthew Mondor <mmondor@pulsar-zone.net>
Thu, 1 Sep 2011 07:05:04 +0000 (07:05 +0000)
committerMatthew Mondor <mmondor@pulsar-zone.net>
Thu, 1 Sep 2011 07:05:04 +0000 (07:05 +0000)
- Make SERVER-TIME-RFC's optional UT be an universal-time, not Unix
  timestamp
- Fix Month offset bug in SERVER-TIME-RFC-PARSE

mmsoftware/cl/server/ecl-mp-server.lisp

index 9a6e869..2e0fa8e 100644 (file)
@@ -1,4 +1,4 @@
-;;; $Id: ecl-mp-server.lisp,v 1.18 2011/09/01 03:30:18 mmondor Exp $
+;;; $Id: ecl-mp-server.lisp,v 1.19 2011/09/01 07:05:04 mmondor Exp $
 
 #|
 
@@ -64,6 +64,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
           #:server-time
           #:server-time-posix
           #:server-time-unix
+          #:server-time-universal
           #:server-time-rfc
           #:server-time-rfc-parse
           #:string-split
@@ -81,7 +82,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (in-package :server)
 
 (defparameter *rcsid*
-  "$Id: ecl-mp-server.lisp,v 1.18 2011/09/01 03:30:18 mmondor Exp $")
+  "$Id: ecl-mp-server.lisp,v 1.19 2011/09/01 07:05:04 mmondor Exp $")
 
 
 (defun noop (&rest args)
@@ -179,10 +180,13 @@ UT may optionally be supplied if the current time is already known."
 UT may optionally be supplied if the current time is already known."
   (- ut 2208988800))
 
-(defun server-time-rfc (&optional (unix-time nil))
+(defun server-time-universal (unixt)
+  "Returns universal/server time for the Unix timestamp UNIXT."
+  (+ unixt 2208988800))
+
+(defun server-time-rfc (&optional (ut (server-time)))
   "Returns RFC UTC time stamp.
-UNIX-TIME may optionally be supplied if the current Unix timestamp is
-already known."
+UT may optionally be supplied if the current time is already known."
 ; (declare (type (or null integer) unix-time))
   (let ((days #("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))
        (months #("Jan" "Feb" "Mar" "Apr" "May" "Jun"
@@ -191,10 +195,7 @@ already known."
             (type (simple-array string (12)) months))
     (multiple-value-bind
          (second minute hour date month year day)
-       (decode-universal-time (if unix-time
-                                  (+ 2208988800 unix-time)
-                                  (server-time))
-                              0)
+       (decode-universal-time ut 0)
       (format nil "~A, ~2,'0D ~A ~4,'0D ~2,'0D:~2,'0D:~2,'0D GMT"
              (svref days day)
              date (svref months (1- month)) year
@@ -225,8 +226,8 @@ SERVER-TIME-UNIX may optionally be used to convert to a Unix timestamp."
            (cond ((= 8 (length parts))
                   ;; RFC 822/1123, RFC 850/1036
                   (setf date (parse-integer (svref parts 1))
-                        month (position (svref parts 2) months
-                                        :test #'string-equal)
+                        month (1+ (position (svref parts 2) months
+                                            :test #'string-equal))
                         year (parse-integer (svref parts 3))
                         hour (parse-integer (svref parts 4))
                         minute (parse-integer (svref parts 5))
@@ -235,8 +236,8 @@ SERVER-TIME-UNIX may optionally be used to convert to a Unix timestamp."
                  ;; ANSI C asctime()
                  ((= 7 (length parts))
                   (setf date (parse-integer (svref parts 2))
-                        month (position (svref parts 1) months
-                                        :test #'string-equal)
+                        month (1+ (position (svref parts 1) months
+                                            :test #'string-equal))
                         year (parse-integer (svref parts 6))
                         hour (parse-integer (svref parts 3))
                         minute (parse-integer (svref parts 4))