X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=web-utils.lisp;h=cc8f52aa0c6327c9522731bbd1218d767d5a1b3f;hp=35611eb0b9739bdd5c0c4b28d376ee84e0f1e008;hb=c42a864dc07721a3e9504094b5b8095cb5f3d03f;hpb=d11d6cc43fd9227a8aeed28dc2cfecdbc587ec4a diff --git a/web-utils.lisp b/web-utils.lisp index 35611eb..cc8f52a 100644 --- a/web-utils.lisp +++ b/web-utils.lisp @@ -56,34 +56,15 @@ (if vars (let ((first-var (first vars))) (concatenate 'string - "?" (car first-var) "=" (cadr first-var) + "?" (car first-var) "=" (cdr first-var) (mapcar-append-string #'(lambda (var) - (when (and (car var) (cadr var)) + (when (and (car var) (cdr var)) (concatenate 'string - amp (car var) "=" (cadr var)))) + amp (car var) "=" (cdr var)))) (rest vars)))) "")))) -(defun make-url-new (page-name &key (base-dir *base-url*) (format :html) - (vars nil)) - (let ((amp (ecase format - (:html "&") - ((:xml :ie-xml) "&")))) - (concatenate 'string - base-dir page-name - (if vars - (let ((first-var (first vars))) - (concatenate 'string - "?" (car first-var) "=" (cadr first-var) - (mapcar-append-string - #'(lambda (var) - (when (and (car var) (cadr var)) - (concatenate 'string - amp (car var) "=" (cadr var)))) - (rest vars)))) - "")))) - (defun decode-uri-query-string (s) "Decode a URI query string field" (declare (simple-string s) @@ -111,3 +92,13 @@ (t (setf (schar new p-new) c) (incf p-old)))))) + +(defun split-uri-query-string (s) + (mapcar + (lambda (pair) + (let ((pos (position #\= pair))) + (when pos + (cons (subseq pair 0 pos) + (when (> (length pair) pos) + (decode-uri-query-string (subseq pair (1+ pos)))))))) + (delimited-string-to-list s #\&)))