"Raw" version of add form:

Uses only tools of servlet-handler/servlets.
2002-12-08 18:10:15 +00:00 · 2002-12-08 18:10:15 +00:00 · 5879a83b9a
parent 7f7eb610d8
commit 5879a83b9a
1 changed files with 116 additions and 0 deletions
--- a/scheme/httpd/surflets/web-server/root/surflets/add-raw.scm
+++ b/scheme/httpd/surflets/web-server/root/surflets/add-raw.scm
@ -0,0 +1,116 @@
+(define-structure servlet servlet-interface
+  (open	httpd-requests			; REQUEST-URL
+	httpd-responses			; MAKE-RESPONSE
+	parse-html-forms		; PARSE-HTML-FORM-QUERY
+	url				; HTTP-URL-SEARCH
+	srfi-1				; FILTER
+	servlet-handler/servlet		; SEND/SUSPEND, SEND/FINISH
+	scheme-with-scsh)
+  (begin
+
+    (define (extract-bindings key bindings)
+      (map cdr
+	   (filter (lambda (binding) 
+		     (equal? (car binding) key))
+		   bindings)))
+
+    (define (extract-single-binding key bindings)
+      (let ((bindings (extract-bindings key bindings)))
+	(if (null? bindings)
+	    (error "no binding")
+	    (car bindings))))
+
+    (define (make-get-number-page input-text title)
+	(lambda (new-url)
+	        (let ((HTML-page (format #f "
+<HTML>~a
+<BODY>~a
+<P>
+  <FORM method=\"GET\" action=\"~a\">
+    ~a
+  <INPUT type=\"text\" name=\"number\">
+  <INPUT type=\"submit\">
+  </FORM>
+</P>
+<HR>
+<P>
+ <A href=\"/\">Return to main menu.</A><BR>
+ <A href=\"add-html.scm\">Start new calculation.</A>
+</P>
+</BODY>
+</HTML>"
+			       (if title 
+				   (format #f "<TITLE>~a</TITLE>" title)
+				   "")
+			       (if title
+				   (format #f "<H2>~a</H2>" title))
+			       new-url
+			       input-text
+			       )))
+
+	  (make-response
+	   http-status/ok
+	   (status-code->text http-status/ok)
+	   (time)
+	   "text/html"
+	   '()
+	   (make-writer-body
+	    (lambda (out options)
+	      (format out HTML-page))
+	      )))))
+
+    (define (make-result-page new-url)
+      (let ((HTML-page (format #f "
+<HTML>
+<TITLE>Result</TITLE>
+<BODY>
+<H1>Result</H1>
+<P>
+  ~a
+<P>
+<HR>
+<A href=\"add-html.scm\">New calculation (new session)</A><BR>
+<A href=\"javascript:history.back(2)\">New calculation (same session)</A><BR>
+<A href=~s>Close this session</A>
+</BODY>
+</HTML>"
+			       (number->string (+ (get-number1) (get-number2)))
+			       new-url)))
+      (make-response
+       http-status/ok
+       (status-code->text http-status/ok)
+       (time)
+       "text/html"
+       '()
+       (make-writer-body
+	(lambda (out options)
+	  (format out HTML-page)))
+       )))
+    
+    (define (get-number input-text . maybe-title)
+      (let* ((title (if (pair? maybe-title) (car maybe-title) #f))
+	     (result (send/suspend (make-get-number-page input-text title)))
+	     (bindings (parse-html-form-query
+			(http-url-search (request-url result))))
+	     (number (string->number 
+		      (extract-single-binding "number" bindings))))
+	(if number
+	    number
+	    (get-number input-text "Please enter a valid number"))))
+
+    (define (get-number1)
+      (get-number "First number:" "Calculation - Step one"))
+    
+    (define (get-number2)
+      (get-number "Second number:" "Calculation - Step two"))
+    
+    (define (main req)
+      (send/suspend make-result-page)
+      ;; This finishes the session and does a redirect to the root
+      ;; page.
+      (send/finish
+       (make-http-error-response http-status/moved-temp req 
+				 "/" "/")))
+
+    ))
+