October 2003 - clhp-cvs@common-lisp.net - mailman3.common-lisp.net

[clhp-cvs] CVS update: clhp/cgi.lisp clhp/ChangeLog
by Anthony Ventimiglia 03 Oct '03

03 Oct '03

Update of /project/clhp/cvsroot/clhp In directory common-lisp.net:/tmp/cvs-serv24566 Modified Files: cgi.lisp ChangeLog Log Message: * 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. Date: Thu Oct 2 20:38:18 2003 Author: aventimiglia Index: clhp/cgi.lisp diff -u clhp/cgi.lisp:1.4 clhp/cgi.lisp:1.5 --- clhp/cgi.lisp:1.4 Thu Oct 2 13:43:06 2003 +++ clhp/cgi.lisp Thu Oct 2 20:38:18 2003 @@ -1,5 +1,4 @@ -(ext:file-comment - "$Id: cgi.lisp,v 1.4 2003/10/02 17:43:06 aventimiglia Exp $") +#+cmu (ext:file-comment "$Id: cgi.lisp,v 1.5 2003/10/03 00:38:18 aventimiglia Exp $") ;; ;; CLHP the Common Lisp Hypertext Preprocessor ;; (C) 2003 Anthony J Ventimiglia @@ -137,7 +136,7 @@ ;; !!!!!!!!! This should most likely be tested and improved , because ;; if the CGI program is given a bogus Content-Length header, this -;; will choke +;; will choke -- In other words, it's prone to attacks (defun read-n-chars (count &optional (stream *standard-input*)) "Reads N chars from STREAM, returning a list of chars. Be careful, there is no check for EOF. This is specifically designed for POST @@ -170,7 +169,8 @@ post-char-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." + "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 Index: clhp/ChangeLog diff -u clhp/ChangeLog:1.6 clhp/ChangeLog:1.7 --- clhp/ChangeLog:1.6 Thu Oct 2 13:43:06 2003 +++ clhp/ChangeLog Thu Oct 2 20:38:18 2003 @@ -1,5 +1,10 @@ 2003-10-02 <ant(a)afghan.dogpound> + * 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 values of a-lists

1 0

[clhp-cvs] CVS update: clhp/tests/cgi-test.lisp
by Anthony Ventimiglia 03 Oct '03

03 Oct '03

Update of /project/clhp/cvsroot/clhp/tests In directory common-lisp.net:/tmp/cvs-serv24566/tests Modified Files: cgi-test.lisp Log Message: * 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. Date: Thu Oct 2 20:38:18 2003 Author: aventimiglia Index: clhp/tests/cgi-test.lisp diff -u clhp/tests/cgi-test.lisp:1.2 clhp/tests/cgi-test.lisp:1.3 --- clhp/tests/cgi-test.lisp:1.2 Thu Oct 2 13:43:05 2003 +++ clhp/tests/cgi-test.lisp Thu Oct 2 20:38:17 2003 @@ -1,4 +1,4 @@ -(ext:file-comment "$Id") +#+cmu (ext:file-comment "$Id") ;; ;; CLHP the Common Lisp Hypertext Preprocessor ;; (C) 2003 Anthony J Ventimiglia @@ -25,9 +25,19 @@ ;; These classes and methods should be a separate package +(eval-when (:load-toplevel :compile-toplevel) + (unless (find-package :cgi) + (load "library:cgi"))) + (defmacro call-if-function (form) `(when (functionp ,form) (funcall ,form))) +(defmacro test-result (result) + "Used to return results of tests for run-test methods" + ;; This will work as long as all RUN-TEST methods use DATA for their + ;; TEST-DATA object. + `(cons (test-data-symbol data) ,result)) + (defclass test-data () ((symbol :initform NIL :type symbol @@ -50,7 +60,7 @@ (defmethod run-test ((data test-data) &optional stream) "Since TEST-DATA is an abstract test class, we cannot actually use it." (declare (ignore stream)) - 'error) + (test-result :error)) (defclass function-test-data (test-data) ((test-args :initform NIL @@ -70,19 +80,56 @@ (defmethod run-test ((data function-test-data) &optional (stream *standard-output*)) - (call-if-function (test-data-pre-function data)) - (let* ((test-form (cons (test-data-symbol data) - (function-test-data-test-args data))) - (result (eval test-form))) - (format stream "~S --> ~S : " test-form result) - (if (equal result (function-test-data-result-form data)) - (format stream "OK~%") - (format stream "FAILED ~S expected~%" - (function-test-data-result-form data))) - (prog1 - result - (call-if-function (test-data-post-function data))))) + (unwind-protect + (progn + (call-if-function (test-data-pre-function data)) + (let* ((test-form (cons (test-data-symbol data) + (function-test-data-test-args data))) + (result (eval test-form))) + (format stream "~S --> ~S : " test-form result) + (test-result + (let ((test-result (function-test-data-result-form data))) + (if (equal result test-result) + (progn + (format stream "OK~%") :OK) + (progn + (format stream "FAILED ~S expected~%" test-result) :error)))))) + (call-if-function (test-data-post-function data)))) +(defclass output-function-test-data (function-test-data) + ((output :initform NIL + :type string + :reader output-function-test-data-output + :initarg :output + :documentation "A string which should be equal to the output")) + (:documentation "A subclass of function-test-data for testing macros +or functions, but this is used when thye output to *STANDARD-OUTPUT* +must be tested as well.")) + +(defmethod run-test ((data output-function-test-data) + &optional (stream *standard-output*)) + (call-if-function (test-data-pre-function data)) + (unwind-protect + (progn + (call-if-function (test-data-pre-function data)) + (let* ((test-form (cons (test-data-symbol data) + (function-test-data-test-args data))) + (output (make-array 0 :element-type 'base-char + :fill-pointer 0 :adjustable t)) + (result (with-output-to-string + (*standard-output* output) + (eval test-form)))) + (format stream "~S --> ~S ~S : " test-form output result) + (test-result + (let ((test-output (output-function-test-data-output data)) + (test-result (function-test-data-result-form data))) + (if (and (equal result test-result) + (string= output test-output)) + (progn (format stream "OK~%") :OK) + (progn (format stream "FAILED ~S ~S expected~%" test-output + test-result) :ERROR)))))) + (call-if-function (test-data-post-function data)))) + ;; Example ;(defvar list-test (make-instance 'function-test-data ; :symbol 'list @@ -95,10 +142,6 @@ (defvar *cgi-tests*) -(eval-when (:load-toplevel :compile-toplevel) - (unless (find-package :cgi) - (load "library:cgi"))) - ;; Still to be tested ;; All functions which print to stdout, I'll have to devise a test for them: ;; DEBUG HEADER @@ -110,7 +153,7 @@ ;; POST-DATA QUERY-TO-A-LIST HANDLE-GENERAL-ERROR ;; Use the following to run-tests -;; (mapcar #'run-tests *cgi-tests*) +;; (mapcar #'run-test *cgi-tests*) (setf *cgi-tests* (list (make-instance 'function-test-data @@ -152,4 +195,34 @@ :test-args nil :result-form '(#\i #\n #\d #\e #\x #\= #\f #\o #\o #\& #\t #\y #\p #\e #\= #\b #\a #\r #\% #\2 #\0 #\b - #\a #\z)))) + #\a #\z)) + (make-instance 'function-test-data + :symbol 'cgi::a-list-value + :test-args '(2 '((1 . f) (3 . g) (6 . h) (2 . y))) + :result-form 'y) + (make-instance 'output-function-test-data + :symbol 'cgi:debug + :test-args '('(list 1 2 3)) + :output (format nil + "(CGI:DEBUG: (LIST 1 2 3) --> (1 2 3))~%")) + (make-instance 'output-function-test-data + :symbol 'cgi:header + :output (format nil + "Content-type: TEXT/PLAIN~%~%") + :result-form t) + ;; We test header twice to make sure it only outputs the first + ;; time. The post-function should reset the internals of the header + ;; function so successive tests will pass, but by reloading the + ;; package, all the symbols in this list get uninterned, however + ;; they are still bound to the functions. so in order to run the + ;; tests again, you have to re evaluate this setq. This is only a + ;; problem in interactive env. if these tests are being run as a + ;; one time deal (which is the eventual goal) none of this will be + ;; a problem. + (make-instance 'output-function-test-data + :post-function #'(lambda () + (delete-package :cgi) + (fmakunbound 'cgi:header) + (load "library:cgi")) + :symbol 'cgi:header + :output "")))

1 0

[clhp-cvs] CVS update: clhp/tests/cgi-test.lisp
by Anthony Ventimiglia 02 Oct '03

02 Oct '03

Update of /project/clhp/cvsroot/clhp/tests In directory common-lisp.net:/tmp/cvs-serv18549/tests Modified Files: cgi-test.lisp Log Message: (a-list-value): Convenience macro for getting the values of a-lists Date: Thu Oct 2 13:43:06 2003 Author: aventimiglia Index: clhp/tests/cgi-test.lisp diff -u clhp/tests/cgi-test.lisp:1.1 clhp/tests/cgi-test.lisp:1.2 --- clhp/tests/cgi-test.lisp:1.1 Wed Oct 1 15:11:33 2003 +++ clhp/tests/cgi-test.lisp Thu Oct 2 13:43:05 2003 @@ -109,6 +109,8 @@ ;; And ;; POST-DATA QUERY-TO-A-LIST HANDLE-GENERAL-ERROR +;; Use the following to run-tests +;; (mapcar #'run-tests *cgi-tests*) (setf *cgi-tests* (list (make-instance 'function-test-data

1 0

[clhp-cvs] CVS update: clhp/cgi.lisp clhp/ChangeLog
by Anthony Ventimiglia 02 Oct '03

02 Oct '03

Update of /project/clhp/cvsroot/clhp In directory common-lisp.net:/tmp/cvs-serv18549 Modified Files: cgi.lisp ChangeLog Log Message: (a-list-value): Convenience macro for getting the values of a-lists Date: Thu Oct 2 13:43:06 2003 Author: aventimiglia Index: clhp/cgi.lisp diff -u clhp/cgi.lisp:1.3 clhp/cgi.lisp:1.4 --- clhp/cgi.lisp:1.3 Wed Oct 1 10:32:45 2003 +++ clhp/cgi.lisp Thu Oct 2 13:43:06 2003 @@ -1,5 +1,5 @@ (ext:file-comment - "$Id: cgi.lisp,v 1.3 2003/10/01 14:32:45 aventimiglia Exp $") + "$Id: cgi.lisp,v 1.4 2003/10/02 17:43:06 aventimiglia Exp $") ;; ;; CLHP the Common Lisp Hypertext Preprocessor ;; (C) 2003 Anthony J Ventimiglia @@ -42,6 +42,10 @@ ex: (EXPLODE-STRING (\"Hello\") --> (#\H #\e #\l #\l #\o)" `(concatenate 'list ,string)) +(defmacro a-list-value (key a-list) + "returns the value from a (KEY . VALUE) A-LIST" + `(cdr (assoc ,key ,a-list))) + ;; External Symbol section (defvar *server-env* nil @@ -89,7 +93,8 @@ (setf *server-env* ext:*environment-list* *query-vars* (let ((request-method (make-keyword - (cdr (assoc :REQUEST_METHOD *server-env*))))) + (a-list-value :REQUEST_METHOD + *server-env*)))) (cond ((eql request-method :POST) (query-to-a-list (post-data))) @@ -147,8 +152,7 @@ (defun get-data () "Returns GET data (QUERY_STRING) as an exploded string" - (explode-string - (cdr (assoc :QUERY_STRING *server-env*)))) + (explode-string (a-list-value :QUERY_STRING *server-env*))) ;; The closure makes sure we don't try to read from stdin twice (let ((get-switch nil) @@ -161,7 +165,7 @@ get-switch t post-char-list (read-n-chars (read-from-string - (cdr (assoc :CONTENT_LENGTH *server-env*))))) + (a-list-value :CONTENT_LENGTH *server-env*)))) post-char-list) post-char-list))) Index: clhp/ChangeLog diff -u clhp/ChangeLog:1.5 clhp/ChangeLog:1.6 --- clhp/ChangeLog:1.5 Wed Oct 1 15:12:21 2003 +++ clhp/ChangeLog Thu Oct 2 13:43:06 2003 @@ -1,3 +1,8 @@ +2003-10-02 <ant(a)afghan.dogpound> + + * cgi.lisp (a-list-value): Convenience macro for getting the + values of a-lists + 2003-10-01 <ant(a)afghan.dogpound> * tests/cgi-test.lisp: Beginning tests for CGI package, right now

1 0

[clhp-cvs] CVS update: clhp/ChangeLog
by Anthony Ventimiglia 01 Oct '03

01 Oct '03

Update of /project/clhp/cvsroot/clhp In directory common-lisp.net:/tmp/cvs-serv12708 Modified Files: ChangeLog Log Message: Date: Wed Oct 1 15:12:21 2003 Author: aventimiglia Index: clhp/ChangeLog diff -u clhp/ChangeLog:1.4 clhp/ChangeLog:1.5 --- clhp/ChangeLog:1.4 Wed Oct 1 10:34:10 2003 +++ clhp/ChangeLog Wed Oct 1 15:12:21 2003 @@ -1,5 +1,9 @@ 2003-10-01 <ant(a)afghan.dogpound> + * tests/cgi-test.lisp: Beginning tests for CGI package, right now + the code in tests/cgi-test.lisp has to be called interactively, + but it does do some of the job + * clhp.lisp, cgi.lisp: converted to easier defpackage construct. 2003-09-23 <ant(a)afghan.dogpound>

1 0

[clhp-cvs] CVS update: clhp/tests/cgi-test.lisp
by Anthony Ventimiglia 01 Oct '03

01 Oct '03

Update of /project/clhp/cvsroot/clhp/tests In directory common-lisp.net:/tmp/cvs-serv12285/tests Added Files: cgi-test.lisp Log Message: Beginning tests for CGI package, right now the code in tests/cgi-test.lisp has to be called interactively, but it does do some of the job Date: Wed Oct 1 15:11:33 2003 Author: aventimiglia

1 0

[clhp-cvs] CVS update: clhp/TODO
by Anthony Ventimiglia 01 Oct '03

01 Oct '03

Update of /project/clhp/cvsroot/clhp In directory common-lisp.net:/tmp/cvs-serv12285 Modified Files: TODO Log Message: Beginning tests for CGI package, right now the code in tests/cgi-test.lisp has to be called interactively, but it does do some of the job Date: Wed Oct 1 15:11:33 2003 Author: aventimiglia Index: clhp/TODO diff -u clhp/TODO:1.5 clhp/TODO:1.6 --- clhp/TODO:1.5 Wed Oct 1 10:01:47 2003 +++ clhp/TODO Wed Oct 1 15:11:33 2003 @@ -1,10 +1,14 @@ -$Id: TODO,v 1.5 2003/10/01 14:01:47 aventimiglia Exp $ -*- outline -*- +$Id: TODO,v 1.6 2003/10/01 19:11:33 aventimiglia Exp $ -*- outline -*- * Test suite Write a test suite, in lisp that will run test on clhp components, this will be used during development, to make sure everything is working properly. + This is in thw works is tests/, I think I'll refine it a bit and + make it it's own package. There is still more work to be done, and + that's a whole different can of beans + * COMPILE-CGI This is just a convenience function that will compile and save fasl files with the .clcgi extension. @@ -18,7 +22,10 @@ the HTTP headers generated by CLHP. * TAG - This has to be done with a macro. + This is pretty nice right now, but I would like to implement it + possibly as a reader macro, where something like #<a href="/" #<b + "Click Me">> yields <a href="/"><b>Click Me</b></a>. The problem is + getting embedded reader macros to work properly. * Error handling This will be the biggest ongoing project, lets try to create every @@ -38,10 +45,13 @@ to be done in CLHP, at least not right away. * Pre-release check list -** version numbering +** version numbering VERSION in Makefile and *CLHP-VERSION* in clhp.lisp should be set. Eventually I'd like to set up a nice way to have this all happen automatically. I think the best way to do this is to make the whole build process more lisp dependent. The other option is - to go automake with it. + to go automake with it. + + The way it works now is very nice, in fact, I don't think Automake + could do it so well.

1 0

[clhp-cvs] CVS update: clhp/ChangeLog
by Anthony Ventimiglia 01 Oct '03

01 Oct '03

Update of /project/clhp/cvsroot/clhp In directory common-lisp.net:/tmp/cvs-serv13933 Modified Files: ChangeLog Log Message: Finally got defpackage to work properly. Date: Wed Oct 1 10:34:10 2003 Author: aventimiglia Index: clhp/ChangeLog diff -u clhp/ChangeLog:1.3 clhp/ChangeLog:1.4 --- clhp/ChangeLog:1.3 Tue Sep 23 22:11:16 2003 +++ clhp/ChangeLog Wed Oct 1 10:34:10 2003 @@ -1,3 +1,7 @@ +2003-10-01 <ant(a)afghan.dogpound> + + * clhp.lisp, cgi.lisp: converted to easier defpackage construct. + 2003-09-23 <ant(a)afghan.dogpound> * clhp.lisp: Created XML-ELEMENT structure and exported all it's

1 0

[clhp-cvs] CVS update: clhp/clhp.lisp clhp/cgi.lisp
by Anthony Ventimiglia 01 Oct '03

01 Oct '03

Update of /project/clhp/cvsroot/clhp In directory common-lisp.net:/tmp/cvs-serv12354 Modified Files: clhp.lisp cgi.lisp Log Message: Finally got defpackage to work properly. Date: Wed Oct 1 10:32:45 2003 Author: aventimiglia Index: clhp/clhp.lisp diff -u clhp/clhp.lisp:1.8 clhp/clhp.lisp:1.9 --- clhp/clhp.lisp:1.8 Tue Sep 23 22:11:16 2003 +++ clhp/clhp.lisp Wed Oct 1 10:32:45 2003 @@ -1,5 +1,5 @@ (ext:file-comment - "$Id: clhp.lisp,v 1.8 2003/09/24 02:11:16 aventimiglia Exp $") + "$Id: clhp.lisp,v 1.9 2003/10/01 14:32:45 aventimiglia Exp $") ;; ;; CLHP the Common Lisp Hypertext Preprocessor ;; (C) 2003 Anthony J Ventimiglia @@ -21,21 +21,16 @@ ;; email: aventimigli(a)common-lisp.net ;; HomePage: http://common-lisp.net/project/clhp/ -;; This is here to make clean compilation (eval-when (:compile-toplevel) - (when (find-package :clhp) - (delete-package :clhp)) - ;; Since CGU us used and we may be building this before it's installed, - ;; We'll need to load it. (unless (find-package :cgi) (load "cgi"))) -(make-package :CLHP) - -(in-package :CLHP) -(export '(PARSE *CLHP-VERSION* ECHO INCLUDE XML-ELEMENT MAKE-XML-ELEMENT - COPY-XML-ELEMENT XML-ELEMENT-ATTRIBUTES XML-ELEMENT-NAME - XML-ELEMENT-CONTENTS XML-ELEMENT-P TAG)) +(defpackage :clhp + (:use :cgi :cl) + (:export #:parse #:*clhp-version* #:echo #:include #:xml-element + #:make-xml-element #:copy-xml-element #:xml-element-attributes + #:xml-element-name #:xml-element-contents #:xml-element-p #:tag)) +(in-package :clhp) ;; This elaborate reader macro converts the cvs Date keywords and ;; translates it into a 8 digit date code for marking the cvs version. @@ -43,7 +38,7 @@ ;; will override the CVS keyword (defconstant *CLHP-VERSION* #.(or nil ; Set this for releases - (let* ((trimmed (string-trim "$ Date:" "$Date: 2003/09/24 02:11:16 $")) + (let* ((trimmed (string-trim "$ Date:" "$Date: 2003/10/01 14:32:45 $")) (date (subseq trimmed 0 (search " " trimmed)))) (concatenate 'string (subseq date 0 4) Index: clhp/cgi.lisp diff -u clhp/cgi.lisp:1.2 clhp/cgi.lisp:1.3 --- clhp/cgi.lisp:1.2 Fri Sep 19 01:57:19 2003 +++ clhp/cgi.lisp Wed Oct 1 10:32:45 2003 @@ -1,5 +1,5 @@ (ext:file-comment - "$Id: cgi.lisp,v 1.2 2003/09/19 05:57:19 aventimiglia Exp $") + "$Id: cgi.lisp,v 1.3 2003/10/01 14:32:45 aventimiglia Exp $") ;; ;; CLHP the Common Lisp Hypertext Preprocessor ;; (C) 2003 Anthony J Ventimiglia @@ -21,14 +21,11 @@ ;; email: aventimigli(a)common-lisp.net ;; HomePage: http://common-lisp.net/project/clhp/ -;; This is here to make clean compilation -(eval-when (:compile-toplevel) - (when (find-package :cgi) - (delete-package :cgi))) +(defpackage :cgi + (:use :cl) + (:export #:*server-env* #:*query-vars* #:header #:debug #:init)) -(make-package "CGI") (in-package :cgi) -(export '(*SERVER-ENV* *QUERY-VARS* HEADER DEBUG INIT)) (defmacro make-keyword (name) "Translates a string into a keyword: (MAKE-KEYWORD \"foo\") -->

1 0

[clhp-cvs] CVS update: Directory change: clhp/tests
by Anthony Ventimiglia 01 Oct '03

01 Oct '03

Update of /project/clhp/cvsroot/clhp/tests In directory common-lisp.net:/tmp/cvs-serv8903/tests Log Message: Directory /project/clhp/cvsroot/clhp/tests added to the repository Date: Wed Oct 1 10:26:44 2003 Author: aventimiglia New directory clhp/tests added

1 0