Support for POST method

clog-connection.lisp

@@ -29,6 +29,7 @@ script."
   (initialize          function)
   (shutdown-clog       function)
   (set-on-connect      function)
+  (set-on-post         function)
   (set-clog-path       function)
   (get-connection-data function)
 
@@ -80,6 +81,7 @@ script."
 (defvar *query-time-out* 3 "Number of seconds to timeout waiting for a query")
 
 (defvar *url-to-boot-file* (make-hash-table :test 'equalp) "URL to boot-file")
+(defvar *on-post-handler* nil "Set a global on-post-handler for form posts")
 
 ;;;;;;;;;;;;;;;;;
 ;; generate-id ;;
@@ -223,6 +225,27 @@ the default answer. (Private)"
       (declare (ignore responder))
       (websocket-driver:start-connection ws))))
 
+;;;;;;;;;;;;;;;;;
+;; set-on-post ;;
+;;;;;;;;;;;;;;;;;
+
+(defun set-on-post (on-post-handler)
+  "Set the global ON-POST-HANDLER. ON-POST URI PARAMS
+the params is an a-list"
+  (setf *on-post-handler* on-post-handler))
+
+;;;;;;;;;;;;;;;;;;
+;; process-post ;;
+;;;;;;;;;;;;;;;;;;
+
+(defun process-post (env)
+  "Process incoming data posted to server. Note that posts are not based on
+connectons. You will need to post some session value to know how to connect
+the post data to an app."
+  (when *on-post-handler*
+    (funcall *on-post-handler* (getf env :request-uri) 
+	     (quri:url-decode-params (read-line (getf env :raw-body))))))
+
 ;;;;;;;;;;;;;;;;
 ;; initialize ;;
 ;;;;;;;;;;;;;;;;
@@ -246,14 +269,24 @@ path by querying the browser. See PATH-NAME (CLOG-LOCATION)."
   
   (setf *app*
 	(lack:builder
+	 
+	 (lambda (app)
+	   (lambda (env)
+             (prog1 (funcall app env)
+	       (when (equal (getf env :content-type)
+			    "application/x-www-form-urlencoded")
+		 (process-post env)))))
+	 
 	 (:static :path (lambda (path)
 			  (let ((clog-path (gethash path *url-to-boot-file*)))
 			    (cond ((ppcre:scan "^(?:/clog$)" path) nil)
 				  (clog-path clog-path)
 				  (t path))))
 		  :root static-root)
+	 
 	 (lambda (env)
 	   (clog-server env))))
+
   (setf *client-handler* (clack:clackup *app* :address host :port port))
   (format t "HTTP listening on    : ~A:~A~%" host port)
   (format t "HTML Root            : ~A~%"    static-root)

tutorial/17-tutorial.lisp

@@ -17,11 +17,13 @@
   (let* ((header (create-section body :header :class "w3-container w3-card w3-theme"))
 	 (tmp    (create-section header :h1 :content "Explore Forms"))
 
-	 (tmp (create-hr body))
+	 (data-area (create-div body :class "w3-container"))
+	 (tmp (create-hr data-area))
 	 
 	 ;; This is a traditional "post" form that will submit data
-	 ;; to a server.
-	 (fcontainer (create-div body  :class "w3-container"))
+	 ;; to a server. Posts are associated with the "page"  and
+	 ;; not with a CLOG connection, so are not ideal.
+	 (fcontainer (create-div data-area :class "w3-container"))
 	 (tmp        (create-section fcontainer :h2 :content "Post Form"))
 	 (tmp        (create-br fcontainer))
 	 (form1      (create-form fcontainer :method :post :action "/page2"))
@@ -30,11 +32,13 @@
 	 (fsubmit    (create-form-element form1 :submit))
 	 (tmp        (create-br fcontainer))
 
-	 (tmp (create-hr body))
+	 (tmp (create-hr data-area))
 
-	 ;; This is a traditional "put" form that will submit data
-	 ;; to a server.
-	 (fcontainer (create-div body  :class "w3-container"))
+	 ;; This is a traditional "get" form that will submit data
+	 ;; to a server. While also associated with the page and
+	 ;; not with the CLOG connection, you can get the URL from
+	 ;; browser and parse put out the results easily.
+	 (fcontainer (create-div data-area :class "w3-container"))
 	 (tmp        (create-section fcontainer :h2 :content "Get Form"))
 	 (tmp        (create-br fcontainer))
 	 (form2      (create-form fcontainer :method :get :action "/page3"))
@@ -43,11 +47,11 @@
 	 (fsubmit    (create-form-element form2 :submit))
 	 (tmp        (create-br fcontainer))
 
-	 (tmp (create-hr body))
+	 (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 body  :class "w3-container"))
+	 (fcontainer (create-div data-area :class "w3-container"))
 	 (tmp        (create-section fcontainer :h2 :content "CLOG Style Form"))
 	 (tmp        (create-br fcontainer))
 	 (form3      (create-form fcontainer))
@@ -56,22 +60,37 @@
 	 (fsubmit3   (create-form-element form3 :submit))
 	 (tmp        (create-br fcontainer))
 
-	 (tmp (create-hr body))
+	 (tmp (create-hr data-area))
 	 
 	 (footer (create-section body :footer :class "w3-container w3-theme"))
 	 (tmp    (create-section footer :p :content "(c) All's well that ends well")))
 
     (set-on-click fsubmit3
 		  (lambda (obj)
+		    (setf (hiddenp data-area) t)
 		    (place-before footer
-				  (create-div body :content (format nil "yourname3 = ~A or ~A"
-								    (name-value form3 "yourname3")
-								    (value finput3)))))))
+				  (create-div body
+				    :content (format nil "yourname3 = using NAME-VALUE ~A or VALUE ~A"
+						     (name-value form3 "yourname3")
+						     (value finput3)))))))
   
   (run body))
 
+;; Globals are used as the post data is delivered in parallel to the new
+;; page being loaded. If one must use the post method, they will need
+;; a more elaborate scheme of hidden fields and synchroniaztion.
+(defvar *uri* nil)
+(defvar *params* nil)
+
+(defun on-post (uri params)
+  (setf *uri* uri)
+  (setf *params* params))
+
 (defun on-page2 (body)
-  (create-db body :content "POST currently unsupported to a CLOG server app.")
+  (create-div body :content *uri*)
+  (create-div body :content *params*)
+  (create-div body :content (format nil "yourname = ~A"
+				    (cdr (assoc "yourname" *params* :test #'equalp))))
   (run body))
 
 (defun on-page3 (body)
@@ -85,6 +104,7 @@
   "Start turtorial."
 
   (initialize #'on-index)
+  (clog-connection:set-on-post #'on-post)
   (set-on-new-window #'on-page2 :path "/page2")
   (set-on-new-window #'on-page3 :path "/page3")
   (open-browser))