[bknr-cvs] hans changed trunk/
BKNR Commits
bknr at bknr.net
Tue Jul 15 12:16:38 UTC 2008
Revision: 3447
Author: hans
URL: http://bknr.net/trac/changeset/3447
Add statistics handler to measure handler execution speed.
U trunk/bknr/web/src/bknr.web.asd
A trunk/bknr/web/src/web/handler-statistics-handler.lisp
U trunk/bknr/web/src/web/handlers.lisp
U trunk/projects/bos/web/webserver.lisp
U trunk/projects/lisp-ecoop/src/webserver.lisp
U trunk/thirdparty/closure-common/closure-common.asd
Modified: trunk/bknr/web/src/bknr.web.asd
===================================================================
--- trunk/bknr/web/src/bknr.web.asd 2008-07-15 12:08:19 UTC (rev 3446)
+++ trunk/bknr/web/src/bknr.web.asd 2008-07-15 12:16:38 UTC (rev 3447)
@@ -79,6 +79,9 @@
"sessions"
"site"))
+ (:file "handler-statistics-handler"
+ :depends-on ("handlers"))
+
(:file "template-handler"
:depends-on ("handlers"))
Added: trunk/bknr/web/src/web/handler-statistics-handler.lisp
===================================================================
--- trunk/bknr/web/src/web/handler-statistics-handler.lisp (rev 0)
+++ trunk/bknr/web/src/web/handler-statistics-handler.lisp 2008-07-15 12:16:38 UTC (rev 3447)
@@ -0,0 +1,34 @@
+(in-package :bknr.web)
+
+(defclass handler-statistics-handler (page-handler)
+ ())
+
+(defun format-elapsed (internal-time-units)
+ (format nil "~8,1F" (* 1000 (/ internal-time-units internal-time-units-per-second))))
+
+(defmethod handle ((handler handler-statistics-handler))
+ (with-bknr-page (:title "BKNR handler statistics")
+ (:div "All times reported in milliseconds")
+ (:table
+ (:thead
+ (:tr (:th "Prefix") (:th "Type") (:th "Pages") (:th "Average") (:th "Max") (:th "Min")))
+ (:tbody
+ (dolist (handler (website-handlers *website*))
+ (let ((statistics (page-handler-statistics handler)))
+ (when (and (hs-count statistics)
+ (plusp (hs-count statistics)))
+ (html
+ (:tr (:td (:princ (page-handler-prefix handler)))
+ (:td (:princ (class-name (class-of handler))))
+ ((:td :align "right") (:princ (hs-count statistics)))
+ ((:td :align "right") (:princ (format-elapsed (hs-average statistics))))
+ ((:td :align "right") (let* ((slowest-array (hs-slowest statistics))
+ (slowest-entry (aref slowest-array (1- (array-dimension slowest-array 0)))))
+ (when slowest-entry
+ (html
+ (:princ (format-elapsed (car slowest-entry)))))))
+ ((:td :align "right") (let* ((fastest-array (hs-fastest statistics))
+ (fastest-entry (aref fastest-array (1- (array-dimension fastest-array 0)))))
+ (when fastest-entry
+ (html
+ (:princ (format-elapsed (car fastest-entry))))))))))))))))
\ No newline at end of file
Modified: trunk/bknr/web/src/web/handlers.lisp
===================================================================
--- trunk/bknr/web/src/web/handlers.lisp 2008-07-15 12:08:19 UTC (rev 3446)
+++ trunk/bknr/web/src/web/handlers.lisp 2008-07-15 12:16:38 UTC (rev 3447)
@@ -210,7 +210,9 @@
:reader page-handler-content-type
:initform "text/html")
(site :initarg :site
- :reader page-handler-site))
+ :reader page-handler-site)
+ (statistics :initform (make-handler-statistics)
+ :accessor page-handler-statistics))
(:documentation "Simple page handler publishing a serve request under a simple URL"))
(defmethod initialize-instance :after ((handler page-handler) &key name prefix &allow-other-keys)
@@ -224,6 +226,50 @@
(print-unreadable-object (handler stream :type t)
(format stream "~A" (page-handler-prefix handler))))
+;; Each handler has a statistics record that keeps track of the
+;; slowest and fastest URLs on this handler and the average time that
+;; processing on this handler takes.
+
+(defconstant +statistics-keep-atypical-count+ 10)
+
+(defstruct (handler-statistics (:conc-name hs-))
+ (slowest (make-array +statistics-keep-atypical-count+ :initial-element nil))
+ (fastest (make-array +statistics-keep-atypical-count+ :initial-element nil))
+ (count 0)
+ average)
+
+(defun slowest-time (statistics)
+ (or (car (aref (hs-slowest statistics) 0))
+ 0))
+
+(defun fastest-time (statistics)
+ (or (car (aref (hs-fastest statistics) 0))
+ most-positive-fixnum))
+
+(defun note-run-time-for-statistics (handler run-time)
+ (let ((statistics (page-handler-statistics handler)))
+ (when (< run-time (fastest-time statistics))
+ (setf (aref (hs-fastest statistics) 0) (cons run-time (tbnl:script-name*))
+ (hs-fastest statistics) (sort (hs-fastest statistics) #'>
+ :key (lambda (entry)
+ (or (car entry)
+ most-positive-fixnum)))))
+ (when (> run-time (slowest-time statistics))
+ (setf (aref (hs-slowest statistics) 0) (cons run-time (tbnl:script-name*))
+ (hs-slowest statistics) (sort (hs-slowest statistics) #'<
+ :key (lambda (entry)
+ (or (car entry)
+ 0)))))
+ (cond
+ ((plusp (hs-count statistics))
+ (setf (hs-average statistics) (/ (+ (* (hs-count statistics) (hs-average statistics))
+ run-time)
+ (1+ (hs-count statistics))))
+ (incf (hs-count statistics)))
+ (t
+ (setf (hs-average statistics) run-time
+ (hs-count statistics) 1)))))
+
(defgeneric handle (page-handler)
(:documentation "Handle an incoming HTTP request, returning either a
string or an (array (unsigned-byte 8) (*)) with the response
@@ -279,8 +325,13 @@
(with-http-body ()
(website-show-error-page *website* e))
(do-error-log-request e)))))))
- (handle handler))))
+ (let ((start (get-internal-real-time)))
+ (prog1
+ (handle handler)
+ (let ((duration (- (get-internal-real-time) start)))
+ (note-run-time-for-statistics handler duration)))))))
+
(defmethod handle ((page-handler page-handler))
(funcall (page-handler-function page-handler)))
Modified: trunk/projects/bos/web/webserver.lisp
===================================================================
--- trunk/projects/bos/web/webserver.lisp 2008-07-15 12:08:19 UTC (rev 3446)
+++ trunk/projects/bos/web/webserver.lisp 2008-07-15 12:16:38 UTC (rev 3447)
@@ -238,6 +238,7 @@
("/cancel-contract" cancel-contract-handler)
("/statistics" statistics-handler)
("/rss" rss-handler)
+ ("/handler-statistics" bknr.web::handler-statistics-handler)
("/favicon.ico"
file-handler
:destination ,(merge-pathnames #p"static/favicon.ico" website-directory)
Modified: trunk/projects/lisp-ecoop/src/webserver.lisp
===================================================================
--- trunk/projects/lisp-ecoop/src/webserver.lisp 2008-07-15 12:08:19 UTC (rev 3446)
+++ trunk/projects/lisp-ecoop/src/webserver.lisp 2008-07-15 12:16:38 UTC (rev 3447)
@@ -25,6 +25,7 @@
:handler-definitions `(user
images
stats
+ ("/handler-statistics" bknr.web::handler-statistics-handler)
mailinglist
mailinglist-registration
participants schedule
Modified: trunk/thirdparty/closure-common/closure-common.asd
===================================================================
--- trunk/thirdparty/closure-common/closure-common.asd 2008-07-15 12:08:19 UTC (rev 3446)
+++ trunk/thirdparty/closure-common/closure-common.asd 2008-07-15 12:16:38 UTC (rev 3447)
@@ -26,7 +26,8 @@
#+rune-is-character
(error "conflicting unicode configuration. Please recompile.")
(pushnew :rune-is-integer *features*))
- ((ignore-errors (code-char 70000))
+ (#+cmu (ignore-errors (code-char 70000))
+ #-cmu (code-char 70000)
(when (test #xD800)
(format t " WARNING: Lisp implementation doesn't use UTF-16, ~
but accepts surrogate code points.~%"))
More information about the Bknr-cvs
mailing list