Hi Folks,
This is my first post here and hopefully this will be helpful to someone. I
use it to get data
from forms on a POST method. I've used Clisp.
Take Care
~sp
-----code begin -----
;;; ==================================================================
;;; CGI Post Form module
;;;
;;; Copyright (C) 2003 Sanjay Pande
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; http://www.gnu.org/copyleft/gpl.html
;;;
;;; ===================================================================
;;; Basic Usage
;;;
;;; The following lines are required in the cgi script
;;;
;;; path-to-lisp
;;; (let ((env "Content-type: text/html"))
;;; (format t "~A~%" env)
;;; (format t "~%"))
;;; (load "cgi.lisp")
;;;
;;; On the form use "POST" in the following way
;;; <form name="input" action="cgi-bin/cgi-script.lisp" method="post">
;;;
;;; All form data will automatically get stored in a hash table called
;;; FieldStorage (like Python) and you can access it by the Get-Value
;;; function.
;;; (get-value "FieldName")
;;; This is a very lightweight package and is intended to be kept that
;;; way. For cgi 'GET' queries, consider getting the Le-Sursis package
;;; from http://sursis.sourceforge.net
;;; ===================================================================
(defpackage cgi
(:use COMMON-LISP)
(:nicknames cgi)
(:export get-value))
;; Just maps A-F for 11-16
(defun cmap (c)
(cdr (assoc (string c) '(("A" . 10)("B" . 11)("C" . 12)
("D" . 13)("E" . 14)("F" . 15))
:test #'string-equal)))
;; Returns ascii character of a hex string
(defun hex2ascii (hex-char)
(let ((l (aref hex-char 0))
(r (aref hex-char 1)))
(if (char<= l #\9)
(setq ln (parse-integer (string l)))
(setq ln (cmap l)))
(if (char<= r #\9)
(setq rn (parse-integer (string r)))
(setq rn (cmap r)))
(if (or ln rn)
(character (+ (* 16 ln) rn)))))
;; Get the Left Part of a string from a character separator
(defun str-left (str sep)
(let ((p (position sep str)))
(if p
(subseq str 0 p)
str)))
;; Get the Right Part of a string from a character seperator
(defun str-right (str sep)
(let ((p (position sep str)))
(if p
(subseq str (1+ p))
NIL)))
;; Replace character in string "string or char"
(defun rpl-str-char (str chr sc)
(let ((p (position chr str)))
(if p
(progn
(let ((l (str-left str chr))
(r (str-right str chr)))
(setf str (concatenate 'string l sc r))
(rpl-str-char str chr sc)))
str)))
;; Destructive function xlate, decodes hex characters in string.
(defun xlate (str)
(let ((p (position #\% str)))
(if p
(progn
(let ((l (subseq str 0 p))
(c (subseq str (+ p 1) (+ p 3)))
(r (subseq str (+ p 3))))
(cond ((string-equal c "0D")
(setq str (concatenate 'string l "<br>" r)))
((string-equal c "0A")
(setq str (concatenate 'string l r)))
(t (setq str (concatenate 'string l (string (hex2ascii c)) r)))))
(xlate str))
str)))
;; Create a hash table to store fields . values
(setq FieldStorage (make-hash-table :test #'equalp))
;; Parse string and put in hash table
(defun str2hash (str)
(let ((l1 (str-left str #\&))
(r1 (str-right str #\&)))
(if l1
(progn
(let ((l2 (str-left l1 #\=))
(r2 (str-right l1 #\=)))
(if (and l2 r2)
(setf (gethash l2 FieldStorage) r2)))))
(if r1
(str2hash r1))))
(setq cgi-string (read-line))
(setq cgi-string (rpl-str-char cgi-string #\+ " "))
(str2hash cgi-string)
(maphash #'(lambda (k v)
(setf (gethash k FieldStorage) (xlate v))) FieldStorage)
;; Hash table accessor
(defun get-value (fld)
(gethash fld FieldStorage))