;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: demo.lisp ;;;; Purpose: Demonstration command processor ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id$ ;;;; ************************************************************************* (in-package #:modlisp) (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))) (t (with-ml-page (:precompute nil) (write-debug-table command)))))) (defun write-debug-table (command) (write-string "

mod_lisp debug page

" *modlisp-socket*) (write-request-counts *modlisp-socket*) (write-string "" *modlisp-socket*) (loop for (key . value) in command do (format *modlisp-socket* "" key value)) (write-string "
KeyValue
~a~a
" *modlisp-socket*)) (defun fixed-html-string () (with-output-to-string (s) (write-string "

mod_lisp fixed page

This is a fixed string sent by mod_lisp

" s) (write-request-counts s) (write-string "" s))) (defun write-precomputed-page () (write-string "

mod_lisp precomputed page

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

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

Number of worker requests for this socket: ~D

" *number-worker-requests*)) ;;; 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) (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) (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))) (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))))) (when content (read-sequence content socket) (push (cons "reply-content" content) header)) header))