From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Alan Grover Newsgroups: gmane.lisp.guile.bugs Subject: guile-www-2.9 (www cgi) Tests for query-string parsing Date: Mon, 11 Apr 2005 21:16:26 -0400 Message-ID: <425B216A.7090406@mail.msen.com> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii; format=flowed Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1113269503 16635 80.91.229.2 (12 Apr 2005 01:31:43 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 12 Apr 2005 01:31:43 +0000 (UTC) Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Tue Apr 12 03:31:41 2005 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1DLAFN-0002hj-PD for guile-bugs@m.gmane.org; Tue, 12 Apr 2005 03:31:22 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1DL9pb-0003kD-DV for guile-bugs@m.gmane.org; Mon, 11 Apr 2005 21:04:43 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1DL9pY-0003jq-0q for bug-guile@gnu.org; Mon, 11 Apr 2005 21:04:40 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1DL9pX-0003jW-Bg for bug-guile@gnu.org; Mon, 11 Apr 2005 21:04:39 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1DL9nW-0002mo-Bf for bug-guile@gnu.org; Mon, 11 Apr 2005 21:02:34 -0400 Original-Received: from [148.59.19.5] (helo=conch.msen.com) by monty-python.gnu.org with esmtp (Exim 4.34) id 1DLA10-0006F6-Dn for bug-guile@gnu.org; Mon, 11 Apr 2005 21:16:30 -0400 Original-Received: from [127.0.0.1] (awgrover@msen.com [148.59.19.5]) by conch.msen.com (8.12.10/8.12.10) with ESMTP id j3C1GRsd016676 for ; Mon, 11 Apr 2005 21:16:27 -0400 (EDT) User-Agent: Mozilla Thunderbird 0.7 (X11/20040615) X-Accept-Language: en-us, en Original-To: bug-guile@gnu.org X-BeenThere: bug-guile@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.bugs:2732 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.bugs:2732 This script tests several interesting cases of query-strings. Add more tests to the obvious list (either a string, or a cons pair of the string and the expected result). There is a bunch of my debug messages in the file, which are turned off. Works under guile 1.6.4. Line wrapping mangled! --- #!/bin/sh #guile --debug -s $0 guile --debug -c "(set! %load-path (cons \".\" %load-path)) (load \"$0\")" exit; !# (use-modules (www cgi)) (use-modules (srfi srfi-1)) (use-modules (www url)) (define kDebug #f) (if kDebug (use-modules (awg debug)) (define (debug . x) #f)) ; Various query-string test values ; After parsing, the test will reassemble the query-string and see if it matches ; Does not round-trip a "+" correctly: comes back as a %20 encoded value (define test-values (list "" "noval" (cons "noval2=" "noval2") "val=1" (cons "noval&" "noval") (cons "val=a&val=" "val=a&val") (cons "val=1&" "val=1") (cons "val=a=b" "val=a%3db") (cons "val=a&=b" "val=a&=b") "noval&noval2" "val=1&noval2" "val=1&val2=2" "val=a&val" (cons "val=a+b" "val=a%20b") (cons "=bad-term" "=bad-term") (cons "noval1&&noval2" "noval1&noval2") "val=a&val=b" "val&val" "with%26amper=with%3dequal" "with%3damper" (cons "val=a&val2=c&val=b" "val=a&val=b&val2=c") "a=1&b=2&c=3" )) (define (join binder str-list) "join binder list => appends the list together with binder between" (fold-right (lambda (head done) (if (eq? done '()) head (string-append head binder done))) '() str-list)) (define (do-test) (letrec ( (print-if (lambda (bool test-results) "print if bool eq t-or-f" ; could have been a foreach (define (_print-if aResult) (let* ( (status (car aResult))) (if (eq? status bool) (begin (display aResult ) (newline))))) (for-each _print-if test-results))) (comparer (lambda (qstring-or-pair) "parse via cgi:init, reassemble, test for equal?" (let* ( (qstring (if (pair? qstring-or-pair) (car qstring-or-pair) qstring-or-pair)) (explicit-wanted (if (pair? qstring-or-pair) (cdr qstring-or-pair) #f)) (qstring-names (begin (environ (list (string-append "QUERY_STRING=" qstring))) (debug "qstring '" qstring "'") (cgi:init) (cgi:names) )) (other-url-encode-bad (string->list "+%=&")) (assemble-key-value (lambda (name) (if (not name) "" (let* ( (enc-key (if name (url:encode name other-url-encode-bad) "")) (raw-values (if name (cgi:values name) "")) (assemble-one (lambda (raw-value) (debug "\t\traw " enc-key " => '" raw-value "'") (string-append enc-key (if (or (not raw-value) (equal? raw-value "")) "" (string-append "=" (url:encode raw-value other-url-encode-bad)))))) ) (if (not raw-values ) enc-key ; no "=" (join "&" (map assemble-one raw-values))) )))) (rebuilt-key-values (begin (debug "cgi:names " qstring-names "\n") (if (or (not qstring-names) (eq? qstring-names '()) ) (list "") (map assemble-key-value qstring-names) ))) (rebuilt-qstring (join "&" rebuilt-key-values)) ; + and %20 are the same, so normalize (normalized-qstring (or explicit-wanted qstring)) ) (list (equal? normalized-qstring rebuilt-qstring) (list (list 'qstring qstring) (list 'wanted normalized-qstring) (list 'rebuilt rebuilt-qstring) cgi:names-values))))) ) ; collect results ; why can't I put this in the letrec? (define results (map comparer test-values)) ; Print 'em (print-if #t results) (display " ---Fails:") (newline) (print-if #f results) )) (do-test) -- Alan Grover awgrover@mail.msen.com +1.734.476.0969 _______________________________________________ Bug-guile mailing list Bug-guile@gnu.org http://lists.gnu.org/mailman/listinfo/bug-guile