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

Fri May 21 16:42:40 UTC 2004

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)



