Hash table implementation of parse-form-urlencoded

2 files changed, 106 insertions, 26 deletions

diff --git a/tests/request.scm b/tests/request.scm
index 0b68ea1..27ea2eb 100644
--- a/tests/request.scm
+++ b/tests/request.scm
@@ -16,7 +16,8 @@
 ;;; You should have received a copy of the GNU Affero General Public
 ;;; License along with Weeb. If not, see <https://www.gnu.org/licenses/>.
 
-(use-modules (srfi srfi-64)
+(use-modules (srfi srfi-1)
+             (srfi srfi-64)
              (weeb request))
 
 (test-runner-current (test-runner-simple))
@@ -36,25 +37,93 @@
   (test-equal "100%" (urldecode "100%25")))
 
 (test-group "parse-form-urlencoded"
-  (test-equal '(("key" . "value"))
-              (parse-form-urlencoded "key=value"))
-  (test-equal '(("a" . "1") ("b" . "2"))
-              (parse-form-urlencoded "a=1&b=2"))
-  (test-equal '(("name" . "John Doe"))
-              (parse-form-urlencoded "name=John+Doe"))
-  (test-equal '(("query" . "foo bar"))
-              (parse-form-urlencoded "query=foo%20bar"))
-  (test-equal '(("user_id" . "42") ("role" . "admin"))
-              (parse-form-urlencoded "user_id=42&role=admin"))
-  (test-equal '(("empty" . ""))
-              (parse-form-urlencoded "empty="))
-  (test-equal '(("foo-bar" . "baz"))
-              (parse-form-urlencoded "foo-bar=baz"))
-  (test-equal '(("a" . "1") ("b" . "2") ("c" . "3"))
-              (parse-form-urlencoded "a=1&b=2&c=3"))
-  (test-equal '(("foo" . "bar"))
-              (parse-form-urlencoded "foo=bar")) ; Verifies (string->symbol key)
-  (test-equal '()
-              (parse-form-urlencoded "")))
+  (test-assert
+      (lset= equal?
+             '(("key" . "value"))
+             (parse-form-urlencoded "key=value")))
+  (test-assert
+      (lset= equal?
+             '(("a" . "1") ("b" . "2"))
+             (parse-form-urlencoded "a=1&b=2")))
+  (test-assert
+      (lset= equal?
+             '(("name" . "John Doe"))
+             (parse-form-urlencoded "name=John+Doe")))
+  (test-assert
+      (lset= equal?
+             '(("query" . "foo bar"))
+             (parse-form-urlencoded "query=foo%20bar")))
+  (test-assert
+      (lset= equal?
+             '(("user_id" . "42") ("role" . "admin"))
+             (parse-form-urlencoded "user_id=42&role=admin")))
+  (test-assert
+      (lset= equal?
+             '(("empty" . ""))
+             (parse-form-urlencoded "empty=")))
+  (test-assert
+      (lset= equal?
+             '(("foo-bar" . "baz"))
+             (parse-form-urlencoded "foo-bar=baz")))
+  (test-assert
+      (lset= equal?
+             '(("a" . "1") ("b" . "2") ("c" . "3"))
+             (parse-form-urlencoded "a=1&b=2&c=3")))
+  (test-assert
+      (lset= equal?
+             '(("foo" . "bar"))
+             (parse-form-urlencoded "foo=bar"))) ; Verifies (string->symbol key)
+  (test-assert
+      (lset= equal?
+             '()
+             (parse-form-urlencoded ""))))
+
+(test-group "parse-form-urlencoded arrays"
+  (test-assert
+      (lset= equal?
+             '(("tag" . ("scheme" "guile" "emacs")))
+             (parse-form-urlencoded "tag=scheme&tag=guile&tag=emacs")))
+  (test-assert
+      (lset= equal?
+             '(("id" . "123") ("items" . ("apple" "orange")))
+             (parse-form-urlencoded "id=123&items=apple&items=orange")))
+  (test-assert
+      (lset= equal?
+             '(("a" . ("1" "2")) ("b" . ("3" "4")))
+             (parse-form-urlencoded "a=1&a=2&b=3&b=4")))
+  (test-assert
+      (lset= equal?
+             '(("invitation_code" . "#f")
+               ("edit_code" . "editcode")
+               ("name" . "Test")
+               ("email" . "test")
+               ("rsvp_status" . "attending")
+               ("guest_names" . ("Test" "Also test")))
+             (parse-form-urlencoded "invitation_code=%23f&edit_code=editcode&name=Test&email=test&rsvp_status=attending&guest_names=Test&guest_names=Also+test")))
+  (test-assert
+      (lset= equal?
+             '(("empty" . ("" "")))
+             (parse-form-urlencoded "empty=&empty=")))
+  (test-assert
+      (lset= equal?
+             '(("path" . ("/usr/bin" "/bin/bash")))
+             (parse-form-urlencoded "path=%2Fusr%2Fbin&path=%2Fbin%2Fbash")))
+  (test-assert
+      (lset= equal?
+             '(("x" . ("1" "1" "1" "1")))
+             (parse-form-urlencoded "x=1&x=1&x=1&x=1")))
+  (test-assert
+      (lset= equal?
+             '(("key" . ""))
+             (parse-form-urlencoded "key=")))
+  (test-assert
+      (lset= equal?
+             '(("a" . ("1" "2" "3")))
+             (parse-form-urlencoded "a=1&a=2&a=3")))
+  (test-assert
+      (lset= equal?
+             '(("user" . "admin") ("perms" . ("read" "write" "exec")) ("session" . "active"))
+             (parse-form-urlencoded "user=admin&perms=read&perms=write&perms=exec&session=active"))))
+
 
 (test-end)
diff --git a/weeb/request.scm b/weeb/request.scm
index 3d18b0a..3704ba2 100644
--- a/weeb/request.scm
+++ b/weeb/request.scm
@@ -18,6 +18,7 @@
 
 (define-module (weeb request)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-69)
   #:use-module (weeb struct)
   #:export (<request>
             urldecode
@@ -43,8 +44,18 @@
       (loop (+ i 1) (string-append acc (string (string-ref str i))))))))
 
 (define (parse-form-urlencoded encoded)
-  (map (lambda (encoded-pair)
-         (match (map urldecode (string-split encoded-pair #\=))
-           ((key value) `(,key . ,value))))
-       (filter (lambda (x) (not (zero? (string-length x))))
-               (string-split encoded #\&))))
+  (let ((result (make-hash-table)))
+    (for-each
+     (lambda (encoded-pair)
+       (match (map urldecode (string-split encoded-pair #\=))
+         ((key value)
+          (let ((possible-duplicate (hash-table-ref/default result key #f)))
+            (cond ((list? possible-duplicate)
+                   (hash-table-set! result key (append possible-duplicate (list value))))
+                  (possible-duplicate
+                   (hash-table-set! result key (list possible-duplicate value)))
+                  (else
+                   (hash-table-set! result key value)))))))
+              (filter (lambda (x) (not (zero? (string-length x))))
+                      (string-split encoded #\&)))
+    (hash-table->alist result)))