1 files changed, 54 insertions, 0 deletions

diff --git a/prototypes/c3b2/web/decode.scm b/prototypes/c3b2/web/decode.scm
new file mode 100644
index 0000000..abf200a
--- /dev/null
+++ b/prototypes/c3b2/web/decode.scm
@@ -0,0 +1,54 @@
+;;; Copyright © 2017  Amirouche Boubekki <amirouche@hypermove.net>
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+(define-module (web decode))
+
+(use-modules (ice-9 match))
+(use-modules (rnrs bytevectors))
+(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-26))
+(use-modules (web uri))
+
+;;;
+;;; decode
+;;;
+
+(define (acons-list k v alist)
+  "Add V to K to alist as list"
+  (let ((value (assoc-ref alist k)))
+    (if value
+        (let ((alist (alist-delete k alist)))
+          (acons k (cons v value) alist))
+        (acons k (list v) alist))))
+
+(define (list->alist lst)
+  "Build a alist of list based on a list of key and values.
+
+   Multiple values can be associated with the same key"
+  (let next ((lst lst)
+             (out '()))
+    (if (null? lst)
+        out
+        (next (cdr lst) (acons-list (caar lst) (cdar lst) out)))))
+
+(define-public (decode bv)
+  "Convert BV querystring or form data to an alist"
+  (define string (utf8->string bv))
+  (define pairs (map (cut string-split <> #\=)
+                     ;; semi-colon and amp can be used as pair separator
+                     (append-map (cut string-split <> #\;)
+                                 (string-split string #\&))))
+  (list->alist (map (match-lambda
+                      ((key value)
+                       (cons (uri-decode key) (uri-decode value)))) pairs)))