Last change
on this file since 33282 was
33282,
checked in by sjamaan, 5 years ago
|
Modernise the spiffy web server demo a bit by using the simpler sxml-serializer instead of sxml-trasnforms with pre-post-order stuff. Thanks to Norman Gray
|
File size:
1.4 KB
|
Line | |
---|
1 | (use spiffy simple-directory-handler |
---|
2 | spiffy-uri-match intarweb uri-common |
---|
3 | sxml-serializer) |
---|
4 | |
---|
5 | (define (send-sxml-response sxml) |
---|
6 | (with-headers `((connection close)) |
---|
7 | (lambda () |
---|
8 | (write-logged-response))) |
---|
9 | (serialize-sxml sxml |
---|
10 | output: (response-port (current-response)))) |
---|
11 | |
---|
12 | (define my-custom-routes |
---|
13 | `(((/ "greeting") |
---|
14 | (GET ,(lambda _ |
---|
15 | (let* ((q (uri-query (request-uri (current-request)))) |
---|
16 | (name (alist-ref 'name q)) |
---|
17 | (greeting (if (and name (not (string=? name ""))) |
---|
18 | (sprintf "Hi there, ~A!" name) |
---|
19 | "Please type in your name below"))) |
---|
20 | (send-sxml-response |
---|
21 | `(html |
---|
22 | (head (title ,greeting)) |
---|
23 | (body |
---|
24 | (h1 ,greeting) |
---|
25 | (form |
---|
26 | (input (@ (type "text") (name "name"))) |
---|
27 | (input (@ (type "submit") (value "Go!")))) |
---|
28 | (p "If you're bored, you can " |
---|
29 | (a (@ (href "/")) |
---|
30 | "go back to browsing the docroot"))))))))))) |
---|
31 | |
---|
32 | (vhost-map ; Make route matching available on all virtual hosts |
---|
33 | `((".*" . ,(uri-match/spiffy my-custom-routes)))) |
---|
34 | |
---|
35 | ;; Let simple-directory-handler handle directories (default is 304 access denied) |
---|
36 | (handle-directory simple-directory-handler) |
---|
37 | |
---|
38 | (start-server) |
---|
Note: See
TracBrowser
for help on using the repository browser.