[hunchentoot-devel] multiple POST/GET values

[Jaap de Heer]

Howdy,

I ran into trouble with Hunchentoot trying to process the result
of a form containing a select multiple:
<select multiple name="foo-or-bar">
  <option value="foo">Foo
  <option value="bar">Bar
</select>

The user can select both foo and bar, which results in both being
submitted.
In the POST request, this looks something like:
"other-field-1=x&foo-or-bar=foo&foo-or-bar=bar&other-field-2=x"

Hunchentoot will pick up on only one of them, i.e.
(get-post-parameter "foo-or-bar") will be either "foo" or
"bar" but not both; it should be both.

I've baked a patch for this that will make (get-post-parameter)
et al return a list containing all submitted values for this
field, if there is more than 1 value; otherwise, it just returns
the string as usual.
My Lisp fu is limited, and this is only one of a few possible
solutions, so feel free to write a better one ;-)

BTW. I suppose the same problem and fix applies for multiple
checkboxes with the same names, and (though this may be invalid)
even multiple <input> fields with the same name.

Cheers,

Jaap


--- util.lisp.org       2008-07-21 20:29:31.000000000 +0200
+++ util.lisp   2008-07-21 20:29:57.000000000 +0200
@@ -168,6 +168,25 @@
     (loop for code across (md5:md5sum-sequence string)
          do (format s "~2,'0x" code))))

+(defun group-by (lst &key (key #'identity) (test #'eq))
+   "Transform a sorted list into a list of lists, grouping together elements with equal key."
+   (labels ((lp (lst result current-group)
+              (cond ((null lst) (nreverse (if (null current-group)
+                                              result
+                                              (cons (nreverse current-group) result))))
+                    ((or (null current-group)
+                         (funcall test
+                                  (funcall key (first lst))
+                                  (funcall key (first current-group))))
+                     (lp (rest lst)
+                         result
+                         (cons (first lst) current-group)))
+                    (t
+                     (lp (rest lst)
+                         (cons (nreverse current-group) result)
+                         (list (first lst)))))))
+     (lp lst nil nil)))
+
 (defun escape-for-html (string)
   "Escapes the characters #\\<, #\\>, #\\', #\\\", and #\\& for HTML output."
   (with-output-to-string (out)
@@ -281,12 +300,18 @@
                                        &optional (external-format *hunchentoot-default-external-format*))
   "Converts a list FORM-URL-ENCODED-LIST of name/value pairs into an
 alist.  Both names and values are url-decoded while doing this."
-  (mapcar #'(lambda (entry)
-              (destructuring-bind (name &optional value)
-                  (split "=" entry :limit 2)
-                (cons (string-trim " " (url-decode name external-format))
-                      (url-decode (or value "") external-format))))
-          form-url-encoded-list))
+  (mapcar (lambda (x) (cons (caar x)
+                            (if (> (length x) 1)
+                                (mapcar #'cdr x)
+                                (cdar x))))
+          (group-by (sort (mapcar #'(lambda (entry)
+                                      (destructuring-bind (name &optional value)
+                                          (split "=" entry :limit 2)
+                                        (cons (string-trim " " (url-decode name external-format))
+                                              (url-decode (or value "") external-format))))
+                                  form-url-encoded-list)
+                          #'string< :key #'car)
+                    :key #'car :test #'equal)))

 (defun url-encode (string &optional (external-format *hunchentoot-default-external-format*))
   "URL-encodes a string using the external format EXTERNAL-FORMAT."