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.~%"))