Update of /project/clhp/cvsroot/clhp In directory common-lisp.net:/tmp/cvs-serv6192
Modified Files: clhp.lisp cgi.lisp ChangeLog Log Message: * cgi.lisp, clhp.lisp (LIST-TO-A-LIST): Moved LIST-TO-A-LIST from clhp.lisp into cgi.lisp, because I need it there as part of the rewrite for QUERY-TO-A-LIST. Sooner or later I'll have to merge all this into a single package so things like this do not have to happen.
* cgi.lisp (QUERY-TO-A-LIST): Rewrote this mostly to simplify it, and make it prettier (*SERVER-ENV*,*QUERY-VARS*) : Converted them to list type a-lists ((A B)(C D)) from the Cons type they had been ((A . B) (C . D)). This is quite temporary, since I plan on making them hashes soon. I basically did this because the TAG mechanism needs List type a-lists, and I wanted to reuese list-to-a-list in cgi.lisp. So as part of the rewrite to QUERY-TO-A-LIST, this ended up as a result.
Date: Thu Oct 2 22:40:39 2003 Author: aventimiglia
Index: clhp/clhp.lisp diff -u clhp/clhp.lisp:1.9 clhp/clhp.lisp:1.10 --- clhp/clhp.lisp:1.9 Wed Oct 1 10:32:45 2003 +++ clhp/clhp.lisp Thu Oct 2 22:40:39 2003 @@ -1,5 +1,5 @@ (ext:file-comment - "$Id: clhp.lisp,v 1.9 2003/10/01 14:32:45 aventimiglia Exp $") + "$Id: clhp.lisp,v 1.10 2003/10/03 02:40:39 aventimiglia Exp $") ;; ;; CLHP the Common Lisp Hypertext Preprocessor ;; (C) 2003 Anthony J Ventimiglia @@ -38,7 +38,7 @@ ;; will override the CVS keyword (defconstant *CLHP-VERSION* #.(or nil ; Set this for releases - (let* ((trimmed (string-trim "$ Date:" "$Date: 2003/10/01 14:32:45 $")) + (let* ((trimmed (string-trim "$ Date:" "$Date: 2003/10/03 02:40:39 $")) (date (subseq trimmed 0 (search " " trimmed)))) (concatenate 'string (subseq date 0 4) @@ -185,19 +185,6 @@ contents name)))
-(defun list-to-a-list (list &optional a-list) - "Converts a list to an a-list, pairing odd and even elements. If an -odd number of elements are in LIST, the last element is returnes as -the second value. -ex: (LIST-TO-A-LIST '(a b c d) --> '((a b)(c d)) NIL -ex: (LIST-TO-A-LIST '(1 2 3 4 5) --> '((1 2)(3 4)) 5" - (cond - ((null list) (nreverse a-list)) - ((= 1 (length list)) (values (nreverse a-list) (car list))) - (t (list-to-a-list (cddr list) - (cons (list (car list) (cadr list)) - a-list))))) - ;; This is a convenience function for MAKE-XML-ELEMENT (defun tag (&rest args) "Creates an XML-ELEMENT, where (CAR ARGS) fills the :NAME slot. If @@ -211,7 +198,7 @@ --> <IMG SRC="pic.png"></IMG>" (multiple-value-bind (att-list contents) - (list-to-a-list (cdr args)) + (cgi::list-to-a-list (cdr args)) (make-xml-element :name (car args) :attributes att-list :contents contents)))
Index: clhp/cgi.lisp diff -u clhp/cgi.lisp:1.5 clhp/cgi.lisp:1.6 --- clhp/cgi.lisp:1.5 Thu Oct 2 20:38:18 2003 +++ clhp/cgi.lisp Thu Oct 2 22:40:39 2003 @@ -1,4 +1,4 @@ -#+cmu (ext:file-comment "$Id: cgi.lisp,v 1.5 2003/10/03 00:38:18 aventimiglia Exp $") +#+cmu (ext:file-comment "$Id: cgi.lisp,v 1.6 2003/10/03 02:40:39 aventimiglia Exp $") ;; ;; CLHP the Common Lisp Hypertext Preprocessor ;; (C) 2003 Anthony J Ventimiglia @@ -43,7 +43,7 @@
(defmacro a-list-value (key a-list) "returns the value from a (KEY . VALUE) A-LIST" - `(cdr (assoc ,key ,a-list))) + `(cadr (assoc ,key ,a-list)))
;; External Symbol section
@@ -65,8 +65,7 @@ ;; is set up so it will only work the first time it is called, any ;; furthur calls will not do a thing (let ((done nil)) - (defun header (&key (content-type 'text/plain) - extra) + (defun header (&key (content-type 'text/plain) extra) "This is the first output function that should be called by a CGI program, it print the proper CGI header. The :CONTENT-TYPE field can be a symbol, or a string, if whitespace is required. @@ -83,13 +82,17 @@ (format t "Content-type: ~a~%~%" content-type) (setf done t))))
+(defun ca-list-to-a-list (list) + "Converts a CONS type a-list '((A . 3)(B . 4)) to a list type '((A 3)(B 4))" + (mapcar #'(lambda (cons) (list (car cons)(cdr cons))) list)) + ;; This sets the main variables, since the library is already part of the lisp ;; core, we can't use an eval-when, I may eventually make a cgi:init that also ;; prints the header. (defun init () "Initialize CGI, this should be called before any globals are accessed" - (setf *server-env* ext:*environment-list* + (setf *server-env* (ca-list-to-a-list ext:*environment-list*) *query-vars* (let ((request-method (make-keyword (a-list-value :REQUEST_METHOD @@ -168,16 +171,25 @@ post-char-list) post-char-list)))
+(defun list-to-a-list (list &optional a-list) + "Converts a list to an a-list, pairing odd and even elements. If an +odd number of elements are in LIST, the last element is returnes as +the second value. +ex: (LIST-TO-A-LIST '(a b c d) --> '((a b)(c d)) NIL +ex: (LIST-TO-A-LIST '(1 2 3 4 5) --> '((1 2)(3 4)) 5" + (cond + ((null list) (nreverse a-list)) + ((= 1 (length list)) (values (nreverse a-list) (car list))) + (t (list-to-a-list (cddr list) + (cons (list (car list) (cadr list)) + a-list))))) + (defun query-to-a-list (get/post-data) - "Translates the char list from GET-DATA or POST-DATA into a (:KEYWORD -. "Value" ) a-list." - (mapcar #'(lambda (key/val-list) - (let ((key/val-strings - (mapcar #'implode-string - (split-char-list #= key/val-list)))) - (cons (make-keyword (car key/val-strings)) - (cadr key/val-strings)))) - (split-char-list #& (url-decode-char-list get/post-data)))) + (list-to-a-list + (mapcar #'implode-string + (mapcan #'(lambda (c) (split-char-list #= c)) + (split-char-list + #& (url-decode-char-list get/post-data))))))
(defun url-decode-char-list (char-list) "Decodes encoded URL chars as per RFC 1738"
Index: clhp/ChangeLog diff -u clhp/ChangeLog:1.7 clhp/ChangeLog:1.8 --- clhp/ChangeLog:1.7 Thu Oct 2 20:38:18 2003 +++ clhp/ChangeLog Thu Oct 2 22:40:39 2003 @@ -1,11 +1,27 @@ 2003-10-02 ant@afghan.dogpound
- * tests/cgi-test.lisp (output-function-test-data): Designed a - class to test functions which print to *standard-output*. These + * cgi.lisp, clhp.lisp (LIST-TO-A-LIST): Moved LIST-TO-A-LIST from + clhp.lisp into cgi.lisp, because I need it there as part of the + rewrite for QUERY-TO-A-LIST. Sooner or later I'll have to merge + all this into a single package so things like this do not have to + happen. + + * cgi.lisp (QUERY-TO-A-LIST): Rewrote this mostly to + simplify it, and make it prettier + (*SERVER-ENV*,*QUERY-VARS*) : Converted them to list type a-lists + ((A B)(C D)) from the Cons type they had been ((A . B) (C + . D)). This is quite temporary, since I plan on making them hashes + soon. I basically did this because the TAG mechanism needs List + type a-lists, and I wanted to reuese list-to-a-list in + cgi.lisp. So as part of the rewrite to QUERY-TO-A-LIST, this ended + up as a result. + + * tests/cgi-test.lisp (OUTPUT-FUNCTION-TEST-DATA): Designed a + class to test functions which print to *STANDARD-OUTPUT*. These test classes will be reused for clhp.lisp, and eventually moved into their own package.
- * cgi.lisp (a-list-value): Convenience macro for getting the + * cgi.lisp (A-LIST-VALUE): Convenience macro for getting the values of a-lists
2003-10-01 ant@afghan.dogpound @@ -23,7 +39,7 @@ PPRINT-XML-ELEMENT, which outputs the structure as an xml tag. I also wrote TAG, which is a convenience function that makes xml-element creation a breeze. - (evaluate-code-block): Enhanced error handling facility, now + (EVALUATE-CODE-BLOCK): Enhanced error handling facility, now errors are reported and processing continues.
* examples/index.clhp: Placed some examples of using TAG @@ -31,4 +47,4 @@ used to create tables from (CONS . TYPE) a-lists. Also added some comments.
- +$Id: ChangeLog,v 1.8 2003/10/03 02:40:39 aventimiglia Exp $ \ No newline at end of file