X-Git-Url: http://git.kpe.io/?p=cl-modlisp.git;a=blobdiff_plain;f=demo.lisp;h=d91d1e3a3d5bedf84d5e40d2fb16695ea4f0a223;hp=cbe5fa61d78dc54fa531aac1aefb6700557db7ba;hb=HEAD;hpb=fa641fe08adb5cede535a6dd79a79047c78ecf8a diff --git a/demo.lisp b/demo.lisp index cbe5fa6..d91d1e3 100644 --- a/demo.lisp +++ b/demo.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; -;;;; $Id: demo.lisp,v 1.3 2003/07/10 18:58:29 kevin Exp $ +;;;; $Id$ ;;;; ************************************************************************* (in-package #:modlisp) @@ -15,16 +15,16 @@ (defun demo-modlisp-command-processor (command) "Sample function to process an modlisp command" - (let ((url (header-value command "url"))) + (let ((url (header-value command :url))) (cond ((equal url "/fixed.lsp") (output-html-page (fixed-html-string))) ((equal url "/precompute.lsp") (with-ml-page (:precompute t) - (write-precomputed-page))) + (write-precomputed-page))) (t (with-ml-page (:precompute nil) - (write-debug-table command)))))) + (write-debug-table command)))))) (defun write-debug-table (command) (write-string " @@ -36,7 +36,7 @@ KeyValue " *modlisp-socket*) (loop for (key . value) in command do - (format *modlisp-socket* "~a~a" key value)) + (format *modlisp-socket* "~a~a" key value)) (write-string "" *modlisp-socket*)) @@ -59,43 +59,43 @@ (defun write-request-counts (s) (format s "

Number of server requests: ~D

" - *number-server-requests*) + *number-server-requests*) (format s "

Number of worker requests for this socket: ~D

" - *number-worker-requests*)) + *number-worker-requests*)) - -;;; A small test bench used to test and time the client/server protocol + +;;; A small test bench used to test and time the client/server protocol ;;; From Marc Battyani (defun fetch-mod-lisp-url (server url &key (num-fetch 1) (port 20123) - close-socket) + close-socket) (loop with server-socket and reply - repeat num-fetch - do (unless server-socket - (setf server-socket (make-active-socket server port))) - (write-string "url" server-socket) + repeat num-fetch + do (unless server-socket + (setf server-socket (make-active-socket server port))) + (write-string "url" server-socket) + (write-char #\NewLine server-socket) + (write-string url server-socket) + (write-char #\NewLine server-socket) + (write-string "end" server-socket) (write-char #\NewLine server-socket) - (write-string url server-socket) - (write-char #\NewLine server-socket) - (write-string "end" server-socket) - (write-char #\NewLine server-socket) - (force-output server-socket) - (setf reply (read-reply server-socket)) - (when close-socket - (close server-socket) - (setf server-socket nil)) - finally - (unless close-socket (close server-socket)) - (return reply))) + (force-output server-socket) + (setf reply (read-reply server-socket)) + (when close-socket + (close server-socket) + (setf server-socket nil)) + finally + (unless close-socket (close server-socket)) + (return reply))) (defun read-reply (socket) (let* ((header (loop for key = (read-line socket nil nil) - while (and key (string-not-equal key "end")) - for value = (read-line socket nil nil) - collect (cons key value))) - (content-length (cdr (assoc "Content-Length" header :test #'string=))) - (content (when content-length (make-string (parse-integer content-length :junk-allowed t))))) + while (and key (string-not-equal key "end")) + for value = (read-line socket nil nil) + collect (cons key value))) + (content-length (cdr (assoc "Content-Length" header :test #'string=))) + (content (when content-length (make-string (parse-integer content-length :junk-allowed t))))) (when content (read-sequence content socket) (push (cons "reply-content" content) header))