;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; wwwlisp.lisp
;;
;; Code for running Allegro Common Lisp programs as from web pages,
;; in conjunction with wwwlisp.cpp.
;;
;; c) 1999, Lee Spector
;; version history
;; Feb 15, 2000: added URL-decoding for #\( and #\)
(defun extract-field (name-string formdata &optional (default ""))
"Returns the data associated with the given name-string in the
given data (which should be a string of data coming from an html form)."
(let ((start-position
(search (concatenate 'string name-string "=")
formdata)))
(if (not start-position)
default
(let ((field-and-tail
(subseq formdata
(+ start-position
(+ 1 (length name-string))))))
(subseq field-and-tail 0 (position #\& field-and-tail))))))
;; some simple tests
;; (extract-field "textfield" "shmoo=99&textfield=hi+there&Submit=Submit")
;; (extract-field "textfield" "shmoo=99&Submit=Submit" "different default")
(defun string-substitute (new-string old-string string-to-process)
"Returns a copy of of string-to-process with all instances of
old-string replaced with copies of new-string."
(let ((old-string-length (length old-string)))
(do ((next-match (search old-string string-to-process)
(search old-string string-to-process)))
((not next-match) string-to-process)
(setq string-to-process
(concatenate 'string
(subseq string-to-process 0 next-match)
new-string
(subseq string-to-process
(+ next-match old-string-length)))))))
;; a test
;; (string-substitute "ABC" "12" "12one12two12three12")
(defun clean-up-form-data (text)
"Cleans up text coming from html forms, undoing the URL-encoding.
Do not run this before extracting field data, as new & characters
may be introduced. This is probably incomplete and should be improved."
(setq text (substitute #\space #\+ text))
(setq text (string-substitute "," "%2C" text))
(setq text (string-substitute (princ-to-string #\tab) "%09" text))
(setq text (string-substitute (princ-to-string #\return) "%0A" text))
(setq text (string-substitute (princ-to-string #\return) "%0D" text))
(setq text (string-substitute "/" "%2F" text))
(setq text (string-substitute "~" "%7E" text))
(setq text (string-substitute ":" "%3A" text))
(setq text (string-substitute ";" "%3B" text))
(setq text (string-substitute "@" "%40" text))
(setq text (string-substitute "&" "%26" text))
(setq text (string-substitute "!" "%21" text))
(setq text (string-substitute "?" "%3F" text))
(setq text (string-substitute "(" "%28" text))
(setq text (string-substitute ")" "%29" text))
text)
(defun add-BR-html-tags (text)
"Returns a copy of text with all return characters replaced with a
sequence of 'return
return', which is useful for making HTML
text that has line breaks in the appropriate places."
(let ((return-string (make-string 1 :initial-element #\return)))
(setq text (string-substitute "#!#
#!#"
return-string
text))
(string-substitute return-string "#!#" text)))
(defun wwwlisp (formdata)
"The top-level function for responding to WWW queries."
(format t "close the comment -->") ;; THIS IS NECESSARY, DO NOT REMOVE
;; the rest is just an example -- substitute your code for this
(format t "
Hi!
") (format t "
Raw data: ~A~%
~%" formdata) (format t "
The contents of 'textfield', slightly cleaned up:~%
~A~%
" (clean-up-form-data (extract-field "textfield" formdata))) (format t "
The same thing, but with BR tags:~%
~A~%
" (add-BR-html-tags (clean-up-form-data (extract-field "textfield" formdata)))) ;; THE FOLLOWING LINE IS ALSO NECESSARY -- DO NOT REMOVE IT (excl:exit nil :quiet t))