Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2
Modified Files: web-server.lisp Log Message: Stats page
Date: Fri May 21 12:42:39 2004 Author: bmastenbrook
Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.45 lisppaste2/web-server.lisp:1.46 --- lisppaste2/web-server.lisp:1.45 Mon Apr 26 12:45:02 2004 +++ lisppaste2/web-server.lisp Fri May 21 12:42:38 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.45 2004/04/26 16:45:02 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.46 2004/05/21 16:42:38 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -30,6 +30,8 @@
(defclass syndication-handler (araneida:handler) ())
+(defclass stats-handler (araneida:handler) ()) + (defmethod araneida:handle-request-response ((handler new-paste-handler) method request) (let* ((annotate-string (araneida:body-param "annotate" (araneida:request-body request))) (annotate-number (if annotate-string (parse-integer annotate-string :junk-allowed t))) @@ -75,12 +77,12 @@ " | " ((a :href "http://common-lisp.net/project/lisppaste/xml-rpc.html") "XML-RPC") " | " - ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page") + ((a :href ,(araneida:urlstring *stats-url*)) "Stats") " | " - "Uptime: " ,(time-delta *boot-time* :ago-p nil))) + ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page")))
-(defun time-delta (time &key (level 2) (ago-p t)) - (let ((delta (- (get-universal-time) time))) +(defun time-delta (time &key (level 2) (ago-p t) (origin (get-universal-time))) + (let ((delta (- origin time))) (cond ((< delta 1) "<Doc Brown>From the <i>future</i>...</Doc Brown>") ((< delta (* 60 60)) (format nil "~A~A" (time-delta-primitive delta 1) (if ago-p " ago" ""))) @@ -160,6 +162,85 @@ *channels*)) ,@(bottom-links)))))
+(defmethod araneida:handle-request-response ((handler stats-handler) method request) + (araneida:request-send-headers request :expires 0) + (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Statistics") + ,(rss-link-header)) + (body + (h2 "Statistics") + (b "Uptime: ") ,(time-delta *boot-time* :ago-p nil :level 3) + (p) + (b "Most popular channels:") (br) + ((table :border 2) + ,@(mapcar #'(lambda (pair) + `(tr + ((td :valign top) + (tt ,(car pair))) + ((td :valign top) + (tt ,(cdr pair))))) + (sort + (loop for i in *channels* + collect (cons i (count i *pastes* + :key #'paste-channel + :test #'string=))) + #'> :key #'cdr))) + (p) + (b "Average rates of pasting:") (br) + ((table :border 2) + ,@(mapcar #'(lambda (pair) + `(tr + #+(or) (td ,(length (second pair))) + ((td :valign top) + (tt ,(first pair))) + ((td :valign top) + (tt ,(time-delta + 0 :origin + (truncate (/ + (third pair) + (length (second pair)))) :ago-p nil) + " between pastes")))) + (list* + (list "Overall" *pastes* (- (paste-universal-time (first *pastes*)) + (paste-universal-time (car (last *pastes*))))) + (list "Last 30 days" + (remove-if #'(lambda (e) + (< (paste-universal-time e) + (- (get-universal-time) + (* 60 60 24 30)))) + *pastes*) + (* 60 60 24 30)) + (list "Last week" + (remove-if #'(lambda (e) + (< (paste-universal-time e) + (- (get-universal-time) + (* 60 60 24 7)))) + *pastes*) + (* 60 60 24 7)) + (list "Last day" + (remove-if #'(lambda (e) + (< (paste-universal-time e) + (- (get-universal-time) + (* 60 60 24)))) + *pastes*) + (* 60 60 24)) + (sort + (loop for i in *channels* + if (find i *pastes* :key #'paste-channel + :test #'string=) + collect (let ((p (remove i *pastes* + :key #'paste-channel + :test-not #'string=))) + (list (format nil "In ~A" i) + p + (- (paste-universal-time (first p)) + (paste-universal-time (car (last p))))))) + #'> :key #'(lambda (e) (length (second e))))))) + ,@(bottom-links))))) + (defmethod araneida:handle-request-response ((handler list-paste-handler) method request) (araneida:request-send-headers request :expires 0) (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") @@ -512,3 +593,8 @@ (araneida:http-listener-handler *paste-listener*) (make-instance 'syndication-handler) (araneida:urlstring *syndication-url*) nil) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'stats-handler) + (araneida:urlstring *stats-url*) nil)