X-Git-Url: http://git.kpe.io/?p=cl-modlisp.git;a=blobdiff_plain;f=demo.lisp;h=d91d1e3a3d5bedf84d5e40d2fb16695ea4f0a223;hp=c9e7e0f9125a67e69c4060758a4ee24558af3225;hb=HEAD;hpb=cb60460c044d8e4c1270b30acd43853ef4ef8f94 diff --git a/demo.lisp b/demo.lisp index c9e7e0f..d91d1e3 100644 --- a/demo.lisp +++ b/demo.lisp @@ -7,37 +7,37 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; -;;;; $Id: demo.lisp,v 1.2 2003/07/08 06:40:00 kevin Exp $ +;;;; $Id$ ;;;; ************************************************************************* (in-package #:modlisp) -(defun demo-apache-command-processor (command) - "Sample function to process an apache command" - (let ((url (header-value command "url"))) +(defun demo-modlisp-command-processor (command) + "Sample function to process an modlisp command" + (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 " -

mod_lisp debug page

" *apache-socket*) - (write-request-counts *apache-socket*) +

mod_lisp debug page

" *modlisp-socket*) + (write-request-counts *modlisp-socket*) (write-string " -" *apache-socket*) +" *modlisp-socket*) (loop for (key . value) in command do - (format *apache-socket* "" key value)) - (write-string "
KeyValue
~a~a
" *apache-socket*)) + (format *modlisp-socket* "~a~a" key value)) + (write-string "" *modlisp-socket*)) (defun fixed-html-string () @@ -53,49 +53,49 @@ (write-string "

mod_lisp precomputed page

-

This is a precomputed string sent by mod_lisp

" *apache-socket*) - (write-request-counts *apache-socket*) - (write-string "" *apache-socket*)) +

This is a precomputed string sent by mod_lisp

" *modlisp-socket*) + (write-request-counts *modlisp-socket*) + (write-string "" *modlisp-socket*)) (defun write-request-counts (s) (format s "

Number of server requests: ~D

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

Number of worker requests for this socket: ~D

" - (get-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))