source: trunk/source/examples/code-cover-test/code-cover-server.lisp @ 15178

Last change on this file since 15178 was 15178, checked in by kmcorbett, 9 years ago

example: code coverage test with Hunchentoot handler to view results

File size: 2.6 KB
Line 
1;; -*- Mode:Lisp; tab-width:2; indent-tabs-mode:nil -*-
2
3(require ':hunchentoot)
4
5(in-package :code-cover-test)
6
7(defvar *server-port* 9090.)
8(defvar *server-host* "localhost")
9
10(defun server-files-path (&optional filename)
11  (merge-pathnames (or filename (make-pathname)) *output-directory-path*))
12
13(defvar *server-message-log* #P"message.log")
14(defvar *server-access-log* #P"access.log")
15
16(defvar *results-uri* "/code-cover-test/")
17(defvar *results-partial-uri* "/code-cover-test")
18(defvar *results-full-uri* "/code-cover-test/index.html")
19
20(defvar _acceptor)                      ;one acceptor listening for this server
21(defvar _request)                       ;debugging
22
23(let* ((report-folder-handler
24        (hunchentoot:create-folder-dispatcher-and-handler
25         *results-uri* (make-pathname :defaults (index-file-path) :name nil :type nil)))
26       (report-folder-verbose-handler
27        (lambda (request)
28          (let (script result)
29            (setq script (hunchentoot::script-name request))
30            (hunchentoot::log-message :debug "Folder handler called for ~a" script)
31            (setq result (funcall report-folder-handler request))
32            (hunchentoot::log-message :debug "Folder handler result for ~a - ~s" script result)
33            ;; Returns
34            result)))
35       (report-special-handler
36        (lambda (request)
37          (let ((script (hunchentoot::script-name request)))
38            (hunchentoot::log-message :debug "Special handler called for ~A" script)
39            (when (member script (list *results-partial-uri* *results-uri*) :test #'equal)
40              (hunchentoot::redirect *results-full-uri*)))))
41       (handlers (list report-special-handler report-folder-verbose-handler)))
42  (defun report-dispatch-handler (request)
43    (let ((hunchentoot:*dispatch-table* handlers))
44      (hunchentoot::list-request-dispatcher request))))
45
46(defun init-code-coverage-test-server ()
47  (unless hunchentoot:*message-log-pathname*
48    (setf hunchentoot:*message-log-pathname* (server-files-path *server-message-log*)))
49  (unless hunchentoot:*access-log-pathname*
50    (setf hunchentoot:*access-log-pathname* (server-files-path *server-access-log*)))
51  ;; Returns
52  (setq _acceptor (make-instance 'hunchentoot:acceptor :port *server-port* :address *server-host*)))
53
54(defun start-code-coverage-test-server (&key (initialize-p t))
55  (and initialize-p (init-code-coverage-test-server))
56  (pushnew 'report-dispatch-handler hunchentoot:*dispatch-table*)
57  (hunchentoot:start _acceptor))
58
59(defun stop-code-coverage-test-server ()
60  (setf hunchentoot:*dispatch-table*
61        (remove 'report-dispatch-handler hunchentoot:*dispatch-table*))
62  (hunchentoot:stop _acceptor))
Note: See TracBrowser for help on using the repository browser.