[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp

[Brian Mastenbrook]

Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/tmp/cvs-serv14643

Modified Files:
	web-server.lisp 
Log Message:
Better time-delta function

Date: Tue Nov 11 23:38:12 2003
Author: bmastenbrook

Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.9 lisppaste2/web-server.lisp:1.10
--- lisppaste2/web-server.lisp:1.9	Tue Nov 11 23:19:38 2003
+++ lisppaste2/web-server.lisp	Tue Nov 11 23:38:11 2003
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.9 2003/11/12 04:19:38 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.10 2003/11/12 04:38:11 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -42,13 +42,35 @@
   (let ((delta (- (get-universal-time) time)))
     (cond
      ((< delta 1) "<Doc Brown>From the <i>future</i>...</Doc Brown>")
-     ((< delta 60) (format nil "~D seconds ago" delta))
-     ((< delta (* 60 60)) (format nil "~D minutes ago" (floor delta 60)))
-     ((< delta (* 60 60 24)) (format nil "~D hours ago" (floor delta (* 60 60))))
-     ((< delta (* 60 60 24 7)) (format nil "~D days ago" (floor delta (* 60 60 24))))
-     ((< delta (* 60 60 24 7 487/16)) (format nil "~D weeks ago" (floor delta (* 60 60 24 7))))
-     ((< delta (* 60 60 24 7 487/16 12)) (format nil "~D months ago" (floor delta (* 60 60 24 7 487/16))))
-     (t (format nil "~D years ago" (floor delta (* 60 60 24 7 (+ 365 1/4))))))))
+     ((< delta (* 60 60)) (format nil "~A ago" (time-delta-primitive delta 1)))
+     (t (format nil "~A ago" (time-delta-primitive delta))))))
+
+(defun first-<-mod (n &rest nums)
+  (some #'(lambda (n2)
+	    (if (< n2 n) (mod n n2) nil)) nums))
+
+(defun time-delta-primitive (delta &optional (level 2))
+  (let* ((seconds 60)
+	 (minutes (* seconds 60))
+	 (hours (* minutes 24))
+	 (days (* hours 7))
+	 (weeks (* days 487/16))
+	 (months (* weeks 12))
+	 (years (* hours (+ 365 1/4))))
+    (let ((primitive
+	   (cond
+	    ((< delta seconds) (format nil "~D second~:P" delta))
+	    ((< delta minutes) (format nil "~D minute~:P" (floor delta seconds)))
+	    ((< delta hours) (format nil "~D hour~:P" (floor delta minutes)))
+	    ((< delta days) (format nil "~D day~:P" (floor delta hours)))
+	    ((< delta weeks) (format nil "~D week~:P" (floor delta days)))
+	    ((< delta months) (format nil "~D month~:P" (floor delta weeks)))
+	    (t (format nil "~D years" (floor delta years))))))
+      (if (eql level 1) primitive
+	(format nil "~A, ~A" primitive
+		(time-delta-primitive
+		 (first-<-mod delta years months weeks days hours minutes seconds)
+		 (1- level)))))))
 
 (defmethod araneida:handle-request-response ((handler list-paste-handler) method request)
   (araneida:request-send-headers request :expires 0)