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)