From 0daf9cce6d045366ff7f1518490642b9c08ac379 Mon Sep 17 00:00:00 2001
From: David Botton <david@botton.com>
Date: Wed, 9 Feb 2022 18:57:39 -0500
Subject: [PATCH] file upload example added to tutorial 17

---
 source/clog-form.lisp     | 29 +++++++++++++++++------------
 tutorial/17-tutorial.lisp | 28 ++++++++++++++++++++++++++++
 2 files changed, 45 insertions(+), 12 deletions(-)

diff --git a/source/clog-form.lisp b/source/clog-form.lisp
index f1fce34..61d0e2b 100644
--- a/source/clog-form.lisp
+++ b/source/clog-form.lisp
@@ -61,7 +61,8 @@ never be GC'd. File upload items will be a four part list
 (deftype form-method-type () '(members :get :post :none))
 
 (defgeneric create-form (clog-obj
-			 &key action method target class html-id auto-place)
+			 &key action method target encoding
+			   class html-id auto-place)
   (:documentation "Create a new CLOG-Form as child of CLOG-OBJ that organizes
 a collection of form elements in to a single form if :AUTO-PLACE (default t)
 place-inside-bottom-of CLOG-OBJ. In CLOG a form's on-submit handler should be
@@ -69,25 +70,29 @@ set and the form element values handled in that handler as opposed to the
 HTML model of submitting to a new \"page\". If though one wishes to submit to
 another page can use the :ACTION :METHOD and :TARGET keys and either do not
 set an on-submit handler or call (submit CLOG-FORM) to perform the form
-action."))
+action. The default :ENCODING is application/x-www-form-urlencoded if
+doing file upload use multipart/form-data"))
 
 (defmethod create-form ((obj clog-obj)
 			&key (action "#")
 			  (method :none)
 			  (target "_self")
+			  (encoding "application/x-www-form-urlencoded")
 			  (class nil)
 			  (html-id nil)
 			  (auto-place t))
-  (create-child obj (format nil "<form action='~A' ~A target='~A'~A/>"
-			    action
-			    (if (eq method :none)
-				"onSubmit='return false;'"
-				(format nil "method='~A'" method))
-			    target
-			    (if class
-				(format nil " class='~A'"
-					(escape-string class))
-				""))
+  (create-child obj
+		(format nil "<form action='~A' ~A enctype='~A' target='~A'~A/>"
+			action
+			(if (eq method :none)
+			    "onSubmit='return false;'"
+			    (format nil "method='~A'" method))
+			encoding
+			target
+			(if class
+			    (format nil " class='~A'"
+				    (escape-string class))
+			    ""))
 		:clog-type 'clog-form :html-id html-id :auto-place auto-place))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/tutorial/17-tutorial.lisp b/tutorial/17-tutorial.lisp
index 38bcf7f..1e01af2 100644
--- a/tutorial/17-tutorial.lisp
+++ b/tutorial/17-tutorial.lisp
@@ -41,6 +41,18 @@
 	 (fsubmit    (create-form-element form2 :submit))
 	 (tmp        (create-br fcontainer))
 	 (tmp (create-hr data-area))
+	 ;; This is a file upload form that will submit data and files
+	 ;; to a server.
+	 (fcontainer (create-div data-area :class "w3-container"))
+	 (tmp        (create-section fcontainer :h2 :content "File Upload Form"))
+	 (tmp        (create-br fcontainer))
+	 (form4      (create-form fcontainer :method :post
+					     :encoding "multipart/form-data"
+					     :action "/page4"))
+	 (finput     (create-form-element form4 :file :name "filename"))
+	 (fsubmit    (create-form-element form4 :submit))
+	 (tmp        (create-br fcontainer))
+	 (tmp (create-hr data-area))
 	 ;; This is a CLOG style form, instead of submitting data
 	 ;; to another page it is dealt with in place.
 	 (fcontainer (create-div data-area :class "w3-container"))
@@ -81,9 +93,25 @@
 				      (form-data-item params "yourname"))))
   (run body))
 
+(defun on-page4 (body)
+  (let ((params (form-multipart-data body)))
+    (create-div body :content params)
+    (destructuring-bind (stream fname content-type)
+	(form-data-item params "filename")
+      (create-div body :content (format nil "filename = ~A - (contents printed in REPL)" fname))
+      (let ((s (flexi-streams:make-flexi-stream stream :external-format :utf-8))
+	    (b (make-string 1000)))
+	(loop
+	  (let ((c (read-sequence b s)))
+	    (unless (plusp c) (return))
+	    (princ (subseq b 1 c))))))
+    (delete-multipart-data body))
+  (run body))
+
 (defun start-tutorial ()
   "Start tutorial."
   (initialize #'on-index)
   (set-on-new-window #'on-page2 :path "/page2")
   (set-on-new-window #'on-page3 :path "/page3")
+  (set-on-new-window #'on-page4 :path "/page4")
   (open-browser))