作者：Danny Yoo & Jay McCarthy
原文：https://docs.racket-lang.org/continue/index.html
本教程将向你展示如何使用Racket编写网络应用。包括如何启动网络服务，如何生成动态网页，以及如何与用户交互。我们的例子是一个简单的博客。
本教程面向已学习过《How to Design Programs》的同学，你需要知道如何使用结构体，高阶函数以及一些变体。
1 开始
本教程需要的一切都由Racket提供。
在DrRacket中输入以下代码，并点击运行按钮。
#lang web-server/insta
(define (start request)
(response/xexpr
`(html
(head (title "My Blog"))
(body (h1 "Under construction")))))
如果你看到一个写着"Under construction"的页面，那么恭喜你已经构建了你的第一个网络应用。接下来我们会完善它，现在请点击停止按钮停止服务。
2 规划
我们希望通过向你展示如何开发一个博客来完成此教程。用户可以创建文章并添加评论。我们将迭代的完成此任务，并在此过程中一些陷阱。计划大致如下：
- 展示静态文章列表。
- 允许用户添加文章。
- 让用户可以添加评论。
- 允许所有用户共享一组文章。
- 将数据序列化到磁盘。
在教程结尾，我们将有一个博客应用上线运行。
3 数据定义
让我们重定义必要的数据结构开始。文章定义如下：
(struct post (title body))
博客就是文章的列表，下面是一个示例：
(define BLOG (list (post "First Post!"
"Hey, this is my first post!")))
接下来在我们的网页中展示它。
4 渲染HTML
当通过浏览器访问我们的服务地址，浏览器会通过网络向我们的服务发送请求。我们需要一个名为start的函数接受请求并生成相应。最基本的一种响应是通过response/xexpr函数显示一个HTML页面；该函数的参数是X-expression表示的HTML，X-expression定义如下。
(define xexpr/c
(flat-rec-contract
xexpr
(or/c string?
(cons/c symbol? (listof xexpr))
(cons/c symble?
(cons/c (listof (list/c symbol> string?))
(listof xexpr))))))
下面的示例说明了用X-expression表示HTML是一件非常自然的事。
xexpr/c的第一种情况是string？。比如"hello"就表示显示hello。为了保证HTML是合法的，字符串输出前都会被转义。举几个例子，<b>Unfinished tag渲染成HTML是<b>Unfinished tag，<i>Finished\ntag</i>渲染出来是<i>Finished tag</i>。
xexpr/c的第二种情况是递归定义(cons/c symbol? (listof xexpr))。例如HTML<p> This is an exapmle</p>的X-expression表示如下：
'(p "This is an example")
最后，xexpr/c的三种情况是支持HTML标签属性。例如<a href="link.html">Past</a>表示如下：
'(a ((href "link.html")) "Past")
<p>This is <div class="emph">another</div> example.</p>表示如下：
'(p "This is " (div ((class "emph")) "another") " example.")
我们也可以使用cons和list生成X-expression，相比于使用x-expression代码要长很多。比如下面的两段X-expression是等价的：
(list 'html (list 'head (list 'title "Some title"))
(list 'body (list 'p "This is a simple static page.")))
'(html (head (title "Some title"))
(body (p "This is a simple static page.")))
后者更容易阅读和输入，因为它使用了引号来简洁的表示列表。这就是我们构造静态html响应的方式。
更过关于列表简写语法，参见《How to Design Programs》第13章。
显然，简写的list语法依然无法生成动态网页。我们需要的是在list中能支持表达式，也就是说我们希望定义一个模板，其中占位符可以动态填入。
Racket通过反引号提供模板的功能，也就是把list前的单引号换成反引号。然后再需要动态填入内容的地方放上一个表达式即可。例如：
; render-greeting: string -> response
; 接收一个名字，返回一个动态响应
（define (render-greeting a-name)
(response/xexpr
`(html (head (title "Welcome"))
(body (p, (string-append "Hello " a-name))))))
练习
编写一个函数，接受一个
post，返回一个X-expression。调用方式：
(render-post (post "First post!" "This is a firlst post."))结果：
'(div ((class "post")) "First post!" (p "This is a first post."))
有时我们希望将一个X-expression列表作为模板嵌入另一个list。比如，给你一个X-expression列表'((li "Larry") (li "Curly") (li "Moe"))，我们希望生成一个X-expression：
'(ul (li "Larry")
(li "Curly")
(li "Moe"))
我们不能通过直接去掉引号来实现，因为在'((li "Larry") (li "Curly") (li "Moe"))前放一个逗号会解引整个list，产生一个畸形的表达式'(ul ((li "Larry") (li "Curly") (li "Moe")))。
相反，我们必须拼接表达式，就像像这样：``(ul ,@’((li “Larry”) (li “Curly”) (li “Moe”)))。,@expression`语法让我们可以把一个X-expression列表拼接到一个更大的模板列表中。下面是两个辅助函数，将任何X-expression列表转化成一个表示HTML无序列表的X-expression：
; render-as-itemized-list: (listof xexpr) -> xexpr
; 接受一个元素列表，渲染成无序列表
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
; render-as-item: xexpr -> xexpr
; 接受一个xexpr，渲染成一个列表元素
(define (render-as-item a-fragment)
`(li ,a-fragment))
练习
编写一个
render-posts函数，接受post列表，输出一个X-expression。调用方式：
render-posts empty结果：
'(div ((class "posts")))例2：
render-posts (list (post "Post 1" "Body 1") (post "Post 2" "Body 2")))输出：
'(div ((class "post")) (div ((class "post")) "Post 1" (p "Body 1")) (div ((class "post")) "Post 2" (p "Body 2")))
现在我们有了render-posts函数，让我们再次回到我们的网络服务，修改我们的start函数来展示一些有趣的东西。
#lang web-server/insta
; 文章定义
(struct post (title body))
; 博客
(define BLOG
(list (post "Second Post" "This is another post")
(post "First Post" "This is my first post")))
; start: request -> response
; 接受一个请求并输出一个页面
(define (start request)
(render-blog-page BLOG request))
; render-blog-page: blog request -> response
; 接受一个博客和请求，输出一个HTML页面
(define (render-blog-page a-blog request)
(response/xexpr
`(html (header (title "My Blog"))
(body (h1 "My Blog")
,(render-posts a-blog)))))
; render-post: post -> xexpr
; 接受一个post，输出一个包含该文章的xexpr
(define (render-post a-post)
`(div ((class "post"))
,(post-title a-post)
(p ,(post-body a-post))))
; render-posts: blog -> xexpr
; 接受一个博客，输出一个包含所有文章的xexpr
(define (render-posts a-blog)
`(div ((class "posts"))
,@(map render-post a-blog)))
点击运行，就可以在浏览器中看到博客文章了。
5 接收请求
虽然我们已经可以动态生成网页，但是还无法接收请求。接下来我们会提供一个表单让用户可以添加文章。
函数request-bindings可以从请求中提取表单，生成一些绑定。
函数extract-binding/single可以从绑定中提取单个值。
函数exists-binding?可以判断某个字段是否存在。
利用这单个函数，我们就可以从请求中提取有用的信息了。
练习
编写
parse-post函数根据表单绑定生成一个post。
有了这些帮助函数，我们的程序就可以处理表单输入了。我们会在页面底部加一个表单，并扩展我们的程序来处理表单。新的start函数将会检查表单中是否包含一个post，若是则更新文章列表并显示。
这个方案可以工作，但有bug。尝试添加两篇文章，看看会发生什么。
6 路由转发
现在，让我们先暂时忽略上一节只能添加一篇文章的bug，后面我们再修复它。
目前，另一个更严重的问题是我们直接在start函数中响应请求，导致我们的start函数越来越臃肿。我们在start中处理了两种请求，显示博客和添加博客，这就是路由分发。那么Racket能否做到不同的请求自动转发到不同的函数呢？
当然可以！网络服务库为我们提供了send/suspend/dispatch函数，把不同URL的请求转发到不同的函数。我们用一个新的例子来演示此功能。
#lang web-server/insta
; start: request -> response
(define (start request)
(phase-1 request))
; phase-1: request -> response
(define (phase-1 request)
(define (response-generator embed/url)
(response/xexpr
`(html
(body (h1 "Phase 1")
(a ((href ,(embed/url phase-2)))
"click me!")))))
(send/suspend/dispatch response-generator))
; phase-2: request -> response
(define (phase-2 request)
(define (response-generator embed/url)
(response/xexpr
`(html
(body (h1 "Phase 2")
(a ((href ,(embed/url phase-1)))
"click me!")))))
(send/suspend/dispatch response-generator))
点击运行，你会看到Phase-1页面，点击超链接，就可以在Phase-1和Phase-2页面之间来回跳转。
按照惯例，我们将接收请求返回响应的函数(如phase-1和phase-2)称为处理器。send/suspend/dispatch函数接收一个response-generating函数，response-generating函数的参数是embed/url函数，embed/url函数的参数是一个处理器，同时他还会生成一个特殊的url，并与处理器绑定。当浏览器访问某个url时，程序不再是进入start函数，而是执行和url绑定的处理器。上例中，我们在phase-1处理器中使用embed/url函数将链接绑定到了phase-2处理器，反之亦然。
处理器只是一个接收请求的函数，我们甚至可以定义一个局部函数作为处理器，这样能访问其他局部变量。下面是另一个例子。
#lang web-server/insta
; start: request -> response
(define (start request)
(show-counter 0 request))
; show-counter: number request -> doesn't return
; 显示一个数字，点击时跳转到一个新的页面并将数字加1
(define (show-counter n request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Counting example"))
(body
(a ((href ,(embed/url next-number-handler)))
,(number->string n))))))
(define (next-number-handler request)
(show-counter (+ n 1) request))
(send/suspend/dispatch response-generator))
这个例子说明我们可以累加交互结果。虽然用户开始看到的是0，但next-number-handler生成的处理器会持续累加这个数字。
言归正传，下面我们将博客表单提交到一个新url，在独立的处理器insert-post-handler中处理创建文章的请求。
#lang web-server/insta
; 文章定义
(struct post (title body))
; 博客
(define BLOG
(list (post "Second Post" "This is another post")
(post "First Post" "This is my first post")))
; start: request -> doesn't return
; 接受一个请求并输出一个页面
(define (start request)
(render-blog-page BLOG request))
; parse-post: bindings -> post
; 接收一个绑定，生成一个post
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)))
; render-blog-page: blog request -> doesn't return
; 接受一个博客和请求，输出一个HTML页面
(define (render-blog-page a-blog request)
(define (response-generator embed/url)
(response/xexpr
`(html (header (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts a-blog)
(form ((action
,(embed/url insert-post-handler)))
(input ((name "title")))
(input ((name "body")))
(input ((type "submit"))))))))
(define (insert-post-handler request)
(render-blog-page
(cons (parse-post (request-bindings request))
a-blog)
request))
(send/suspend/dispatch response-generator))
; render-post: post -> xexpr
; 接受一个post，输出一个包含该文章的xexpr
(define (render-post a-post)
`(div ((class "post"))
,(post-title a-post)
(p ,(post-body a-post))))
; render-posts: blog -> xexpr
; 接受一个博客，输出一个包含所有文章的xexpr
(define (render-posts a-blog)
`(div ((class "posts"))
,@(map render-post a-blog)))
仔细观察就会发现，render-blog-page函数和第二个例子中的show-counter的逻辑是一样的。现在你可以添加多篇文章了。
然而，我们的程序依然有bug，添加几篇文章，然后在一个新的网页打开博客地址(服务地址会在交互区打印出来)，看看会发生什么？
7 数据共享
我们程序面临的问题是浏览器窗口之前看不到对方的修改，这与博客的设计目标不符。当插入文章时，我们希望修改博客，而不是创建一个新的博客。(数据修改参见《How to Design Programs》第41章)。如果只是使用结构体，我们会这样写：
(struct blog (posts))
但是在Racket中，结构体默认是不可变的。如果要让它可变，我们需要在结构体定义中加上#:mutable关键字。我们将博客结构体定义如下：
(struct blog (posts) #:mutable)
可变结构体会提供改变其字段的函数，在这个例子中，我们有set-blog-posts!函数来修改博客的文章列表。
练习
编写一个
blog-insert-post!函数，向博客中添加文章。
下面我们使用新的博客数据结构修改我们的程序。
#lang web-server/insta
; 博客定义
(struct blog (posts) #:mutable)
; 文章定义
(struct post (title body))
; 博客
(define BLOG
(blog
(list (post "Second Post" "This is another post")
(post "First Post" "This is my first post"))))
; blog-insert-post!: blog post -> void
; 接收一篇文章，并插入到博客开头
(define (blog-insert-post! a-blog a-post)
(set-blog-posts! a-blog
(cons a-post (blog-posts a-blog))))
; start: request -> doesn't return
; 接受一个请求并输出一个页面
(define (start request)
(render-blog-page request))
; parse-post: bindings -> post
; 接收一个绑定，生成一个post
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)))
; render-blog-page: blog request -> doesn't return
; 接受一个博客和请求，输出一个HTML页面
(define (render-blog-page request)
(define (response-generator embed/url)
(response/xexpr
`(html (header (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts)
(form ((action
,(embed/url insert-post-handler)))
(input ((name "title")))
(input ((name "body")))
(input ((type "submit"))))))))
(define (insert-post-handler request)
(blog-insert-post!
BLOG (parse-post (request-bindings request)))
(render-blog-page request))
(send/suspend/dispatch response-generator))
; render-post: post -> xexpr
; 接受一个post，输出一个包含该文章的xexpr
(define (render-post a-post)
`(div ((class "post"))
,(post-title a-post)
(p ,(post-body a-post))))
; render-posts: blog -> xexpr
; 接受一个博客，输出一个包含所有文章的xexpr
(define (render-posts)
`(div ((class "posts"))
,@(map render-post (blog-posts BLOG))))
现在在两个浏览器窗口中打开博客网站，并在任意一个窗口中添加博客，另一个窗口通过刷新应该也能看到变化。
8 模型扩展
接下来我们需要扩展模型，在文章结构体中加入评论列表。
练习：
1）写出扩展后的数据结构，为了可变，需要加上
#:mutable2）实现
post-insert-comment函数，向文章中添加评论3）修改
render-post函数支持渲染评论
9 分开显示文章和评论
将文章和评论显示在一起对用户来说体验并不好，我们应该新建一个详情页来放评论，首页只有标题和内容，以及评论数。
跳转评论页的其中一种方式是在标题加上超链接，用户点击标题即跳转到评论页。甚至在评论页我们可以加上一个表单让用户添加评论。页面流程如下：
[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-rXhDkC7b-1648275807806)(file://C:\Users\gram\Pictures\Camera Roll\blog_9.png?msec=1648275761410)]
图中每一个节点代表了一个处理器。箭头对应一个URL。
这种方式也有个不好的地方。因为必须用embed/url生成URL，我们需要调整render-posts和render-post函数使用embed/url来生成超链接标题。
修改后的程序如下：
#lang web-server/insta
; 博客定义
(struct blog (posts) #:mutable)
; 文章定义
(struct post (title body comments) #:mutable)
; 博客
(define BLOG
(blog
(list (post "Second Post"
"This is another post"
(list))
(post "First Post"
"This is my first post"
(list "First comment!")))))
; blog-insert-post!: blog post -> void
; 接收一篇文章，并插入到博客开头
(define (blog-insert-post! a-blog a-post)
(set-blog-posts! a-blog
(cons a-post (blog-posts a-blog))))
(define (post-insert-comment! a-post a-comment)
(set-post-comments!
a-post
(append (post-comments a-post) (list a-comment))))
; start: request -> doesn't return
; 接受一个请求并输出一个页面
(define (start request)
(render-blog-page request))
; parse-post: bindings -> post
; 接收一个绑定，生成一个post
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)))
; render-blog-page: blog request -> doesn't return
; 接受一个博客和请求，输出一个HTML页面
(define (render-blog-page request)
(define (response-generator embed/url)
(response/xexpr
`(html (header (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts embed/url)
(form ((action
,(embed/url insert-post-handler)))
(input ((name "title")))
(input ((name "body")))
(input ((type "submit"))))))))
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)
(list)))
(define (insert-post-handler request)
(blog-insert-post!
BLOG (parse-post (request-bindings request)))
(render-blog-page request))
(send/suspend/dispatch response-generator))
; 评论页
(define (render-post-detail-page a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Post Details"))
(body
(h1 "Post Details")
(h2 ,(post-title a-post))
(p ,(post-body a-post))
,(render-as-itemized-list
(post-comments a-post))
(form ((action
,(embed/url insert-comment-handler)))
(input ((name "comment")))
(input ((type "submit"))))))))
(define (parse-comment bindings)
(extract-binding/single 'comment bindings))
(define (insert-comment-handler a-request)
(post-insert-comment!
a-post (parse-comment (request-bindings a-request)))
(render-post-detail-page a-post a-request))
(send/suspend/dispatch response-generator))
; render-post: post -> xexpr
; 接受一个post，输出一个包含该文章的xexpr
(define (render-post a-post embed/url)
(define (view-post-handler request)
(render-post-detail-page a-post request))
`(div ((class "post"))
(a ((href ,(embed/url view-post-handler)))
(h3 ,(post-title a-post)))
(p ,(post-body a-post))
(div ,(number->string (length (post-comments a-post)))
" comment(s)")))
; render-posts: blog -> xexpr
; 接受一个博客，输出一个包含所有文章的xexpr
(define (render-posts embed/url)
(define (render-post/embed/url a-post)
(render-post a-post embed/url))
`(div ((class "posts"))
,@(map render-post/embed/url (blog-posts BLOG))))
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
(define (render-as-item a-fragment)
`(li ,a-fragment))
现在的问题是用户一旦进入评论页就只能通过浏览器的回退按钮回到文章列表页。下一节我们将修复这个问题。
10 添加回退按钮
兴许我们应该在详情页添加一个按钮回到文章列表页。
[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-FfhTe8cv-1648275807808)(file://C:\Users\gram\Pictures\Camera Roll\blog_10_1.png?msec=1648275761411)]
练习
在
render-post-detail-page函数中添加一个返回到文章列表页的连接。
此外，我们还可以让用户可以取消提交评论。
[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-4B5FW1k1-1648275807809)(file://C:\Users\gram\Pictures\Camera Roll\blog_10_2.png?msec=1648275761411)]
这一改变看似复杂，实际上并不影响处理器的结构。
#lang web-server/insta
; 博客定义
(struct blog (posts) #:mutable)
; 文章定义
(struct post (title body comments) #:mutable)
; 博客
(define BLOG
(blog
(list (post "Second Post"
"This is another post"
(list))
(post "First Post"
"This is my first post"
(list "First comment!")))))
; blog-insert-post!: blog post -> void
; 接收一篇文章，并插入到博客开头
(define (blog-insert-post! a-blog a-post)
(set-blog-posts! a-blog
(cons a-post (blog-posts a-blog))))
(define (post-insert-comment! a-post a-comment)
(set-post-comments!
a-post
(append (post-comments a-post) (list a-comment))))
; start: request -> doesn't return
; 接受一个请求并输出一个页面
(define (start request)
(render-blog-page request))
; parse-post: bindings -> post
; 接收一个绑定，生成一个post
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)))
; render-blog-page: blog request -> doesn't return
; 接受一个博客和请求，输出一个HTML页面
(define (render-blog-page request)
(define (response-generator embed/url)
(response/xexpr
`(html (header (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts embed/url)
(form ((action
,(embed/url insert-post-handler)))
(input ((name "title")))
(input ((name "body")))
(input ((type "submit"))))))))
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)
(list)))
(define (insert-post-handler request)
(blog-insert-post!
BLOG (parse-post (request-bindings request)))
(render-blog-page request))
(send/suspend/dispatch response-generator))
; 评论页
(define (render-post-detail-page a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Post Details"))
(body
(h1 "Post Details")
(h2 ,(post-title a-post))
(p ,(post-body a-post))
,(render-as-itemized-list
(post-comments a-post))
(form ((action
,(embed/url insert-comment-handler)))
(input ((name "comment")))
(input ((type "submit"))))
(a ((href ,(embed/url back-handler)))
"Back to blog")))))
(define (parse-comment bindings)
(extract-binding/single 'comment bindings))
(define (insert-comment-handler request)
(render-confirm-add-comment-page
(parse-comment (request-bindings request))
a-post
request))
(define (back-handler request)
(render-blog-page request))
(send/suspend/dispatch response-generator))
; 评论提交确认
(define (render-confirm-add-comment-page a-comment a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Add a Comment"))
(body
(h1 "Add a Comment")
"The comment: " (div (p ,a-comment))
"will be added to "
(div ,(post-title a-post))
(p (a ((href ,(embed/url yes-handler)))
"Yes, add the comment."))
(p (a ((href ,(embed/url cancel-handler)))
"No, I changed my mind!"))))))
(define (yes-handler request)
(post-insert-comment! a-post a-comment)
(render-post-detail-page a-post request))
(define (cancel-handler request)
(render-post-detail-page a-post request))
(send/suspend/dispatch response-generator))
; render-post: post -> xexpr
; 接受一个post，输出一个包含该文章的xexpr
(define (render-post a-post embed/url)
(define (view-post-handler request)
(render-post-detail-page a-post request))
`(div ((class "post"))
(a ((href ,(embed/url view-post-handler)))
(h3 ,(post-title a-post)))
(p ,(post-body a-post))
(div ,(number->string (length (post-comments a-post)))
" comment(s)")))
; render-posts: blog -> xexpr
; 接受一个博客，输出一个包含所有文章的xexpr
(define (render-posts embed/url)
(define (render-post/embed/url a-post)
(render-post a-post embed/url))
`(div ((class "posts"))
,@(map render-post/embed/url (blog-posts BLOG))))
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
(define (render-as-item a-fragment)
`(li ,a-fragment))
11 界面美化
我们的网络应用功能差不多已完成，但是界面还很拉跨。为了提高界面观感，一种方式是在网页中内嵌css代码。例如我们想让页面变绿，可以在响应中加入以下代码。
'(style ((type "text/css")) "p { color: green }")
原则上，逻辑和渲染应该分离。因此我们并不直接将css代码嵌入html响应中，而是添加一个指向独立css文件的连接。
截至目前，我们所看到的内容都是由处理器生成的。但是对于像图片、js、css这些不需要动态生成的文件，我们会将它们放到一个独立的目录下，然后通过static-files-path函数提供静态文件服务。
练习1
创建一个test-static.rkt文件，输入以下内容：
#lang web-server/insta (define (start request) (response/xexpr '(html (head (title "Testing") (link ((rel "stylesheet") (href "/test-static.css") (type "text/css")))) (body (h1 "Testing") (h2 "This is a header") (p "This is " (span ((class "hot")) "hot") "."))))) (static-files-path "htdocs")创建htdocs子目录，然后在该目录下创建一个test-static.css文件，输入以下内容：
body { margin-left: 10%; margin-right: 10%; } p { font-family: sans-serif } h1 { color: green } h2 { font-size: small } span.hot {color: red }运行程序观察输出。
练习2
为我们的博客程序编写一个css文件，并修改代码，使用这个css文件美化页面。
12 重复提交问题
我们的程序还有另一个问题。运行程序并打开页面，添加一篇文章然后刷新。
你所看到的就是著名的重提提交问题。每当用户按下刷新按钮，一个请求就会发送到我们程序，问题是这些请求会更改数据。
一个常用的避免重复提交问题的方法是将会修改状态的请求重定向到一个不同的URL。在Racket中，我们使用函数redirect/get函数实现重定向。
它的作用是让浏览器重定向到一个新的URL并发起新的请求。
下面是一个例子，我们可以向一个花名册中添加名字：
#lang web-server/insta
; A roster is a (roster names)
; where names is a list of string.
(struct roster (names) #:mutable)
; roster-add-name!: roster string -> void
; Given a roster and a name, adds the name
; to the end of the roster.
(define (roster-add-name! a-roster a-name)
(set-roster-names! a-roster
(append (roster-names a-roster)
(list a-name))))
(define ROSTER (roster '("kathi" "shriram" "dan")))
; start: request -> doesn't return
(define (start request)
(show-roster request))
; show-roster: request -> doesn't return
(define (show-roster request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Roster"))
(body (h1 "Roster")
,(render-as-itemized-list
(roster-names ROSTER))
(form ((action
,(embed/url add-name-handler)))
(input ((name "a-name")))
(input ((type "submit"))))))))
(define (parse-name bindings)
(extract-binding/single 'a-name bindings))
(define (add-name-handler request)
(roster-add-name!
ROSTER (parse-name (request-bindings request)))
(show-roster request))
(send/suspend/dispatch response-generator))
; render-as-itemized-list: (listof xexpr) -> xexpr
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
; render-as-item: xexpr -> xexpr
(define (render-as-item a-fragment)
`(li ,a-fragment))
这个例子也有重复提交问题，如果我们添加一个名字后刷新，同一个名字就会被添加两次。
我们可以通过修改一个表达式来修复这个问题，仔细观察下面的代码和上面有什么不同。
#lang web-server/insta
; A roster is a (roster names)
; where names is a list of string.
(struct roster (names) #:mutable)
; roster-add-name!: roster string -> void
; Given a roster and a name, adds the name
; to the end of the roster.
(define (roster-add-name! a-roster a-name)
(set-roster-names! a-roster
(append (roster-names a-roster)
(list a-name))))
(define ROSTER (roster '("kathi" "shriram" "dan")))
; start: request -> doesn't return
(define (start request)
(show-roster request))
; show-roster: request -> doesn't return
(define (show-roster request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Roster"))
(body (h1 "Roster")
,(render-as-itemized-list
(roster-names ROSTER))
(form ((action
,(embed/url add-name-handler)))
(input ((name "a-name")))
(input ((type "submit"))))))))
(define (parse-name bindings)
(extract-binding/single 'a-name bindings))
(define (add-name-handler request)
(roster-add-name!
ROSTER (parse-name (request-bindings request)))
(show-roster (redirect/get))) ;;看这里
(send/suspend/dispatch response-generator))
; render-as-itemized-list: (listof xexpr) -> xexpr
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
; render-as-item: xexpr -> xexpr
(define (render-as-item a-fragment)
`(li ,a-fragment))
当处理器会修改数据时，使用redirect/get返回响应就能避免重复提交问题。
修复重复提交问题后，我们的博客代码如下。
#lang web-server/insta
; 博客定义
(struct blog (posts) #:mutable)
; 文章定义
(struct post (title body comments) #:mutable)
; 博客
(define BLOG
(blog
(list (post "Second Post"
"This is another post"
(list))
(post "First Post"
"This is my first post"
(list "First comment!")))))
; blog-insert-post!: blog post -> void
; 接收一篇文章，并插入到博客开头
(define (blog-insert-post! a-blog a-post)
(set-blog-posts! a-blog
(cons a-post (blog-posts a-blog))))
(define (post-insert-comment! a-post a-comment)
(set-post-comments!
a-post
(append (post-comments a-post) (list a-comment))))
; start: request -> doesn't return
; 接受一个请求并输出一个页面
(define (start request)
(render-blog-page request))
; parse-post: bindings -> post
; 接收一个绑定，生成一个post
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)))
; render-blog-page: blog request -> doesn't return
; 接受一个博客和请求，输出一个HTML页面
(define (render-blog-page request)
(define (response-generator embed/url)
(response/xexpr
`(html (header (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts embed/url)
(form ((action
,(embed/url insert-post-handler)))
(input ((name "title")))
(input ((name "body")))
(input ((type "submit"))))))))
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)
(list)))
(define (insert-post-handler request)
(blog-insert-post!
BLOG (parse-post (request-bindings request)))
(render-blog-page (redirect/get))) ;;重定向
(send/suspend/dispatch response-generator))
; 评论页
(define (render-post-detail-page a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Post Details"))
(body
(h1 "Post Details")
(h2 ,(post-title a-post))
(p ,(post-body a-post))
,(render-as-itemized-list
(post-comments a-post))
(form ((action
,(embed/url insert-comment-handler)))
(input ((name "comment")))
(input ((type "submit"))))
(a ((href ,(embed/url back-handler)))
"Back to blog")))))
(define (parse-comment bindings)
(extract-binding/single 'comment bindings))
(define (insert-comment-handler request)
(render-confirm-add-comment-page
(parse-comment (request-bindings request))
a-post
request))
(define (back-handler request)
(render-blog-page request))
(send/suspend/dispatch response-generator))
; 评论提交确认
(define (render-confirm-add-comment-page a-comment a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Add a Comment"))
(body
(h1 "Add a Comment")
"The comment: " (div (p ,a-comment))
"will be added to "
(div ,(post-title a-post))
(p (a ((href ,(embed/url yes-handler)))
"Yes, add the comment."))
(p (a ((href ,(embed/url cancel-handler)))
"No, I changed my mind!"))))))
(define (yes-handler request)
(post-insert-comment! a-post a-comment)
(render-post-detail-page a-post (redirect/get))) ;;重定向
(define (cancel-handler request)
(render-post-detail-page a-post request))
(send/suspend/dispatch response-generator))
; render-post: post -> xexpr
; 接受一个post，输出一个包含该文章的xexpr
(define (render-post a-post embed/url)
(define (view-post-handler request)
(render-post-detail-page a-post request))
`(div ((class "post"))
(a ((href ,(embed/url view-post-handler)))
(h3 ,(post-title a-post)))
(p ,(post-body a-post))
(div ,(number->string (length (post-comments a-post)))
" comment(s)")))
; render-posts: blog -> xexpr
; 接受一个博客，输出一个包含所有文章的xexpr
(define (render-posts embed/url)
(define (render-post/embed/url a-post)
(render-post a-post embed/url))
`(div ((class "posts"))
,@(map render-post/embed/url (blog-posts BLOG))))
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
(define (render-as-item a-fragment)
`(li ,a-fragment))
13 模型抽象
如果我们停掉服务，程序的状态就会消失。在考虑如何持久化状态之前，我们需要明确的是，我们只需要持久化那些我们关心的状态，比如博客。
仔细观察我们的程序，可以看到一条明显的分界线，分界线上面就是我们的模型定义。
(struct blog (posts) #:mutable)
(struct post (title body comments) #:mutable)
(define BLOG ...)
(define (blog-insert-post! ...) ...)
(define (post-insert-comment! ...) ...)
在实际的网络应用中，模型和网络应用通过抽象进行分离。理论上这种分离可以让我们在将来修改程序是不会影响到整个系统。首先我们将模型抽离到一个独立的文件中，然后再考虑持久化。
创建一个名为model.rkt的文件，输入以下内容。
#lang racket/base
; 博客定义
(struct blog (posts) #:mutable)
; 文章定义
(struct post (title body comments) #:mutable)
; 博客
(define BLOG
(blog
(list (post "Second Post"
"This is another post"
(list))
(post "First Post"
"This is my first post"
(list "First comment!")))))
; blog-insert-post!: blog post -> void
; 接收一篇文章,并插入到博客开头
(define (blog-insert-post! a-blog a-post)
(set-blog-posts! a-blog
(cons a-post (blog-posts a-blog))))
(define (post-insert-comment! a-post a-comment)
(set-post-comments!
a-post
(append (post-comments a-post) (list a-comment))))
(provide (all-defined-out))
基本上就是把模型定义复制粘贴过来。文件开头我们选择了racket语言，因为模型与网络无关。最后一行表达式告诉Racket允许其他文件访问model.rkt文件中的所有定义。
回到网络应用，删掉模型定义，加上表达式(require "model.rkt")。
#lang web-server/insta
(require "model.rkt")
; start: request -> doesn't return
; 接受一个请求并输出一个页面
(define (start request)
(render-blog-page request))
; parse-post: bindings -> post
; 接收一个绑定，生成一个post
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)))
; render-blog-page: blog request -> doesn't return
; 接受一个博客和请求，输出一个HTML页面
(define (render-blog-page request)
(define (response-generator embed/url)
(response/xexpr
`(html (header (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts embed/url)
(form ((action
,(embed/url insert-post-handler)))
(input ((name "title")))
(input ((name "body")))
(input ((type "submit"))))))))
(define (parse-post bindings)
(post (extract-binding/single 'title bindings)
(extract-binding/single 'body bindings)
(list)))
(define (insert-post-handler request)
(blog-insert-post!
BLOG (parse-post (request-bindings request)))
(render-blog-page (redirect/get))) ;;重定向
(send/suspend/dispatch response-generator))
; 评论页
(define (render-post-detail-page a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Post Details"))
(body
(h1 "Post Details")
(h2 ,(post-title a-post))
(p ,(post-body a-post))
,(render-as-itemized-list
(post-comments a-post))
(form ((action
,(embed/url insert-comment-handler)))
(input ((name "comment")))
(input ((type "submit"))))
(a ((href ,(embed/url back-handler)))
"Back to blog")))))
(define (parse-comment bindings)
(extract-binding/single 'comment bindings))
(define (insert-comment-handler request)
(render-confirm-add-comment-page
(parse-comment (request-bindings request))
a-post
request))
(define (back-handler request)
(render-blog-page request))
(send/suspend/dispatch response-generator))
; 评论提交确认
(define (render-confirm-add-comment-page a-comment a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Add a Comment"))
(body
(h1 "Add a Comment")
"The comment: " (div (p ,a-comment))
"will be added to "
(div ,(post-title a-post))
(p (a ((href ,(embed/url yes-handler)))
"Yes, add the comment."))
(p (a ((href ,(embed/url cancel-handler)))
"No, I changed my mind!"))))))
(define (yes-handler request)
(post-insert-comment! a-post a-comment)
(render-post-detail-page a-post (redirect/get))) ;;重定向
(define (cancel-handler request)
(render-post-detail-page a-post request))
(send/suspend/dispatch response-generator))
; render-post: post -> xexpr
; 接受一个post，输出一个包含该文章的xexpr
(define (render-post a-post embed/url)
(define (view-post-handler request)
(render-post-detail-page a-post request))
`(div ((class "post"))
(a ((href ,(embed/url view-post-handler)))
(h3 ,(post-title a-post)))
(p ,(post-body a-post))
(div ,(number->string (length (post-comments a-post)))
" comment(s)")))
; render-posts: blog -> xexpr
; 接受一个博客，输出一个包含所有文章的xexpr
(define (render-posts embed/url)
(define (render-post/embed/url a-post)
(render-post a-post embed/url))
`(div ((class "posts"))
,@(map render-post/embed/url (blog-posts BLOG))))
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
(define (render-as-item a-fragment)
`(li ,a-fragment))
14 持久化模型
将模型定义放到独立的模块可以让我们方便的修改模型和持久化。
第一步需要让模型可序列化。之前我们通过在模型定义后添加#:mutable让结构体可变。类似的，现在我们需要要结构体定义后添加关键字#:prefab，它告诉Racket这个结构体是可以"预先装配"的，也就是在程序运行之前创建。这正是我们从磁盘恢复博客数据所需要的。修改后的博客定义如下：
(struct blog (posts) #:mutable #:prefab)
现在我们可以通过read和write函数从外界读写blog结构体。此外我们还需要保证blog结构体内的所有字段都标记为#:prefab。
练习
修改
post结构体。
现在我们可以在磁盘读写博客了。不过首先我们需要在博客定义中加上一个路径。
(struct blog (home posts) #:mutable #:prefab)
注意我们需要将路径转化为字符串。为什么不直接用路径呢？因为路径不能通过read和write读写。
接下来我们创建一个函数来初始化博客。
(define (initialize-blog! home)
(define (log-missing-exn-handler exn)
(blog
(path->string home)
(list (post "First Post"
"This is my first post"
(list "First comment!"))
(post "Second Post"
"This is another post"
(list)))))
(define the-blog
(with-handlers ([exn? log-missing-exn-handler])
(with-input-from-file home read)))
(set-blog-home! the-blog (path->string home))
the-blog)
initialize-blog!接收一个路径并尝试读取和反序列化。如果文件不存在或数据格式错误，read或with-input-from-file会抛出一个异常。with-handlers提供了一个异常处理器，当发生错误时返回默认数据。当the-blog被绑定后，将路径设置进去。
接下来我们需要一个函数将博客保存到磁盘：
(define (save-blog! a-blog)
(define (write-to-blog)
(write a-blog))
(with-output-to-file (blog-home a-blog)
write-to-blog
#:exists 'replace))
save-blog!将模型写入home文件，with-output-to-file后面的#:exists保证了磁盘上旧的数据会被覆写。
接下来我们需要在blog-insert-post!和post-insert-comment!函数中调用save-blog!来保存模型。但是很快你就会发现一个问题，post-insert-comment!函数中并没有blog实例。因此我们需要在它的参数中也加上blog。同时，我们让blog-insert-post!函数接收文章内容作为参数，而不是post结构体。
练习
更新
blog-insert-post!函数和post-insert-comment!函数，记得调用save-blog!。
在之前的章节，我们使用(provide (all-defined-out))来导出模型定义。这违背了抽象原则，抽象原则要求隐藏实现细节，比如私有函数和内部数据结构。为此，我们在provide中列出需要导出的定义。
我们需要导出9个函数，因此将provide修改如下：
(provide blog? blog-posts
post? post-title post-body post-comments
initialize-blog!
blog-insert-post! post-insert-comment!)
最后还需要修改网络部分代码，首先是在start函数中调用initialize-blog!初始化博客；其次，由于BLOG不在导出，我们需要将他放到参数中传递。
(define (start request)
(render-blog-page
(initialize-blog!
(build-path (current-directory)
"the-blog-data.db"))
request))
练习
修改
blog-insert-post!和post-insert-comment!接收blog参数。
#lang racket/base
(require racket/list)
; 博客定义
(struct blog (home posts) #:mutable #:prefab)
; 文章定义
(struct post (title body comments) #:mutable #:prefab)
; blog-insert-post!: blog post -> void
; 接收一篇文章,并插入到博客开头
(define (blog-insert-post! a-blog title body)
(set-blog-posts!
a-blog
(cons (post title body empty) (blog-posts a-blog)))
(save-blog! a-blog))
(define (post-insert-comment! a-blog a-post a-comment)
(set-post-comments!
a-post
(append (post-comments a-post) (list a-comment)))
(save-blog! a-blog))
; 初始化博客
(define (initialize-blog! home)
(define (log-missing-exn-handler exn)
(blog
(path->string home)
(list (post "First Post"
"This is my first post"
(list "First comment!"))
(post "Second Post"
"This is another post"
(list)))))
(define the-blog
(with-handlers ([exn? log-missing-exn-handler])
(with-input-from-file home read)))
(set-blog-home! the-blog (path->string home))
the-blog)
; 保存博客
(define (save-blog! a-blog)
(define (write-to-blog)
(write a-blog))
(with-output-to-file (blog-home a-blog)
write-to-blog
#:exists 'replace))
(provide blog? blog-posts
post? post-title post-body post-comments
initialize-blog!
blog-insert-post! post-insert-comment!)
#lang web-server/insta
(require "model.rkt")
; start: request -> doesn't return
; 接受一个请求并输出一个页面
(define (start request)
(render-blog-page
(initialize-blog!
(build-path (current-directory)
"the-blog-data.db"))
request))
; render-blog-page: blog request -> doesn't return
; 接受一个博客和请求，输出一个HTML页面
(define (render-blog-page a-blog request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts a-blog embed/url)
(form ((action
,(embed/url insert-post-handler)))
(input ((name "title")))
(input ((name "body")))
(input ((type "submit"))))))))
(define (insert-post-handler request)
(define bindings (request-bindings request))
(blog-insert-post!
a-blog
(extract-binding/single 'title bindings)
(extract-binding/single 'body bindings))
(render-blog-page a-blog (redirect/get)))
(send/suspend/dispatch response-generator))
; 评论页
(define (render-post-detail-page a-blog a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Post Details"))
(body
(h1 "Post Details")
(h2 ,(post-title a-post))
(p ,(post-body a-post))
,(render-as-itemized-list
(post-comments a-post))
(form ((action
,(embed/url insert-comment-handler)))
(input ((name "comment")))
(input ((type "submit"))))
(a ((href ,(embed/url back-handler)))
"Back to the blog")))))
(define (parse-comment bindings)
(extract-binding/single 'comment bindings))
(define (insert-comment-handler request)
(render-confirm-add-comment-page
a-blog
(parse-comment (request-bindings request))
a-post
request))
(define (back-handler request)
(render-blog-page a-blog request))
(send/suspend/dispatch response-generator))
; 评论提交确认
(define (render-confirm-add-comment-page a-comment a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Add a Comment"))
(body
(h1 "Add a Comment")
"The comment: " (div (p ,a-comment))
"will be added to "
(div ,(post-title a-post))
(p (a ((href ,(embed/url yes-handler)))
"Yes, add the comment."))
(p (a ((href ,(embed/url cancel-handler)))
"No, I changed my mind!"))))))
(define (yes-handler request)
(post-insert-comment! a-post a-comment)
(render-post-detail-page a-post (redirect/get))) ;;重定向
(define (cancel-handler request)
(render-post-detail-page a-post request))
(send/suspend/dispatch response-generator))
; render-post: post -> xexpr
; 接受一个post，输出一个包含该文章的xexpr
(define (render-post a-blog a-post embed/url)
(define (view-post-handler request)
(render-post-detail-page a-blog a-post request))
`(div ((class "post"))
(a ((href ,(embed/url view-post-handler)))
,(post-title a-post))
(p ,(post-body a-post))
(div ,(number->string (length (post-comments a-post)))
" comment(s)")))
; render-posts: blog -> xexpr
; 接受一个博客，输出一个包含所有文章的xexpr
(define (render-posts a-blog embed/url)
(define (render-post/embed/url a-post)
(render-post a-blog a-post embed/url))
`(div ((class "posts"))
,@(map render-post/embed/url (blog-posts a-blog))))
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
(define (render-as-item a-fragment)
`(li ,a-fragment))
这种持久化方式只适用于简单的程序，随着开发继续，我们需要处理并发问题，以及模型查询。下一节，我们将介绍如何使用SQL来存储模型。
15 使用SQL数据库
要使用SQL数据库，我们需要用到一些db库中的绑定：connection?，sqlite3-connect，table-exists?，query-exec，query-list以及query-value。通过下面的代码引入上面的内容。
(require db)
模型对应表结构如下：
CREATE TABLE posts (id INTEGER PRIMARY KEY, title TEXT, body TEXT)
CREATE TABLE comments (pid INTEGER, content TEXT)
评论和文章之间通过pid关联。
现在blog结构体编程对数据库连接的封装。
练习
写出
blog定义，它现在不需要可变和序列化了。
初始化blog代码修改如下：
(define db (sqlite3-connect #:database home #:mode 'create))
(define the-blog (blog db))
(unless (table-exists? db "posts")
(query-exec db
(string-append
"CREATE TABLE posts "
"(id INTEGER PRIMARY KEY, title TEXT, body TEXT)"))
(blog-insert-post!
the-blog "First Post" "This is my first post")
(blog-insert-post!
the-blog "Second Post" "This is another post"))
(unless (table-exists? db "comments")
(query-exec db
"CREATE TABLE comments (pid INTEGER, content TEXT)")
(post-insert-comment!
the-blog (first (blog-posts the-blog))
"First comment!"))
the-blog)
'create标识会让sqlite3-connect自动创建数据库文件。
同时，我们也使用blog-insert-post!和post-insert-comment!初始化了一些数据，它们的实现如下：
(define (blog-insert-post! a-blog title body)
(query-exec
(blog-db a-blog)
"INSERT INTO posts (title, body) VALUES (?, ?)"
title body))
(define (post-insert-comment! a-blog p a-comment)
(query-exec
(blog-db a-blog)
"INSERT INTO comments (pid, content) VALUES (?, ?)"
(post-id p) a-comment))
注意，这里我们使用?占位符实现字符串替换。如果使用format或者~a会有SQL注入风险。比如用户可以创建一个标题为"null', 'null') and INSERT INTO accounts (username,\npassword) VALUES ('ur','hacked"的文章，导致query-exec插入两条数据。
SQL占位符通过确保将查询按原样提交给SQLite来防止这种攻击(SQLite会解析SQL并应用参数)。这种方式确保参数被严格视为数据。
我们在post-insert-comment!函数中使用了post-id，但是我们还没重新定义post结构体。我们可以参考数据库表来定义post结构体，但这样还不够，我们无法知道这篇文章属于哪个博客，更具体的，不知道属于哪个数据库，也就无法查到文章标题和内容。
解决办法就是在post中关联一个blog。
练习
定义
post结构体。
创建文章列表的函数如下：
(define (blog-posts a-blog)
(define (id->post an-id)
(post a-blog an-id))
(map id->post
(query-list
(blog-db a-blog)
"SELECT id FROM posts")))
query-list可以用来查询某一列并返回一个列表。
获取文章标题函数如下：
(define (post-title a-post)
(query-value
(blog-db (post-blog a-post))
"SELECT title FROM posts WHERE id = ?"
(post-id a-post)))
query-value用来插叙某一行的某一列。
练习1
写出
post-body函数练习2
参考
blog-posts写出post-comments函数。
程序最后需要修改的地方就是导入新的模型。
新的模型模块代码如下：
#lang racket/base
(require racket/list
db)
; 博客定义
(struct blog (db))
; 文章定义
(struct post (blog id))
; blog-insert-post!: blog post -> void
; 接收一篇文章,并插入到博客开头
(define (blog-insert-post! a-blog title body)
(query-exec
(blog-db a-blog)
"INSERT INTO posts (title, body) VALUES (?, ?)"
title body))
(define (post-insert-comment! a-blog p a-comment)
(query-exec
(blog-db a-blog)
"INSERT INTO comments (pid, content) VALUES (?, ?)"
(post-id p) a-comment))
; 初始化博客
(define (initialize-blog! home)
(define db (sqlite3-connect #:database home #:mode 'create))
(define the-blog (blog db))
(unless (table-exists? db "posts")
(query-exec db
(string-append
"CREATE TABLE posts "
"(id INTEGER PRIMARY KEY, title TEXT, body TEXT)"))
(blog-insert-post!
the-blog "First Post" "This is my first post")
(blog-insert-post!
the-blog "Second Post" "This is another post"))
(unless (table-exists? db "comments")
(query-exec db
"CREATE TABLE comments (pid INTEGER, content TEXT)")
(post-insert-comment!
the-blog (first (blog-posts the-blog))
"First comment!"))
the-blog)
; blog-posts : blog -> (listof post?)
; Queries for the post ids
(define (blog-posts a-blog)
(define (id->post an-id)
(post a-blog an-id))
(map id->post
(query-list
(blog-db a-blog)
"SELECT id FROM posts")))
(define (post-title a-post)
(query-value
(blog-db (post-blog a-post))
"SELECT title FROM posts WHERE id = ?"
(post-id a-post)))
(define (post-body p)
(query-value
(blog-db (post-blog p))
"SELECT body FROM posts WHERE id = ?"
(post-id p)))
(define (post-comments p)
(query-list
(blog-db (post-blog p))
"SELECT content FROM comments WHERE pid = ?"
(post-id p)))
(provide blog? blog-posts
post? post-title post-body post-comments
initialize-blog!
blog-insert-post! post-insert-comment!)
网络服务模块：
#lang web-server/insta
(require "model-3.rkt")
......
更多基于数据库的网络服务参考Databases and Web Servlets。
16 使用表单绑定
回到网络应用，我们还有一个可以优化的地方。表单渲染和表单提取用到的名称是一样的，但是我们的程序中并没有体现出这种关联性。
(define (render-blog-page a-blog request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts a-blog embed/url)
(form ((action
,(embed/url insert-post-handler)))
; "title"在这里使用
(input ((name "title")))
(input ((name "body")))
(input ((type "submit"))))))))
(define (insert-post-handler request)
(define bindings (request-bindings request))
(blog-insert-post!
a-blog
; "title"也在这里使用
(extract-binding/single 'title bindings)
(extract-binding/single 'body bindings))
(render-blog-page a-blog (redirect/get)))
(send/suspend/dispatch response-generator))
Racket网络框架提供了formlets来抽象这种关联。它会自动调整HTML表单的名称，并提供了以下接口来显示和处理表单。
-
formlet-display接收一个formlet返回一个X-expression列表用于渲染表单。它会为表单的每一项生成一个唯一的名字。 -
formlet-process接收一个formlet和一个request并使用formlet-display生成的名字从request中提取表单绑定。
formlet通过[formlet](6 Formlets: Functional Form Abstraction)语法生成。例如，下面是用于渲染博客的formlet：
(define new-post-formlet
(formlet
(#%# ,{input-string . => . title}
,{input-string . => . body})
(values title body)))
注意：
formlet需要导入web-server/formlets/syntax，input-string需要导入web-server/formlets/input。(require web-server/formlets/syntax web-server/formlets/input)或者也可以只导入
web-server/formlets。
formlet的第一个参数告诉formlet-display如何渲染表单，它和X-expression有两点不同：
-
#%#引入一个X-expression列表 -
,{=> formlet id}嵌入一个子formlet，在处理这个子formlet时，通过id进行关联。例如，
input-string是一个产生字符串的formlet，,{=> input-string title}将input-string嵌入到new-post-formlet，并将它生成的字符串与title关联。input-string渲染为:`(input ([type "text"] [name ,fresh-name]))因此
(formlet-display new-post-formlet)渲染为：(list '(input ([type "text"] [name "input_0"])) '(input ([type "text"] [name "input_1"])))
formlet的第二个参数告诉formlet-process函数如何处理formlet。也就是如何打包和整理子formlet的结果。=>右边的标识符就是子formlet的处理结果。
例如，input-string的处理同(extract-binding/single fresh_name (request-bindings request))。因此，如果request将"input_0"绑定到"Title"，将"input_1"绑定到"Body"，则(formlet-process new-post-formlet request)返回(values "Title" "Body")。
最后，以下是使用new-post-formlet的render-blog-page函数：
(define (render-blog-page a-blog request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts a-blog embed/url)
(form ([action
,(embed/url insert-post-handler)])
,@(formlet-display new-post-formlet)
(input ([type "submit"])))))))
(define (insert-post-handler request)
(define-values (title body)
(formlet-process new-post-formlet request))
(blog-insert-post! a-blog title body)
(render-blog-page a-blog (redirect/get)))
(send/suspend/dispatch response-generator))
input-string组合器使用默认值将一堆formlet组合到一个容器。有时候我们也需要把formlet拆开给予不同的参数。比如我们希望给表单元素加上CSS class。
(define new-post-formlet
(formlet
(#%# ,((to-string
(required
(text-input
#:attributes '([class "form-text"]))))
. => . title)
,((to-string
(required
(text-input
#:attributes '([class "form-text"]))))
. => . body))
(values title body)))
练习
修改
render-post-detail函数使用formlet。
现在，我们的程序如下：
#lang web-server/insta
(require web-server/formlets
"model.rkt")
; start: request -> doesn't return
; 接受一个请求并输出一个页面
(define (start request)
(render-blog-page
(initialize-blog!
(build-path (current-directory)
"the-blog-data.sqlite"))
request))
; new-post-formlet : formlet (values string? string?)
; 用于请求文章标题和内容的formlet
(define new-post-formlet
(formlet
(#%# ,{input-string . => . title}
,{input-string . => . body})
(values title body)))
; render-blog-page: blog request -> doesn't return
; 接受一个博客和请求，输出一个HTML页面
(define (render-blog-page a-blog request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "My Blog"))
(body
(h1 "My Blog")
,(render-posts a-blog embed/url)
(form ([action
,(embed/url insert-post-handler)])
,@(formlet-display new-post-formlet)
(input ([type "submit"])))))))
(define (insert-post-handler request)
(define-values (title body)
(formlet-process new-post-formlet request))
(blog-insert-post! a-blog title body)
(render-blog-page a-blog (redirect/get)))
(send/suspend/dispatch response-generator))
; new-comment-formlet : formlet string
; 用于请求评论的formlet
(define new-comment-formlet
input-string)
; 评论页
(define (render-post-detail-page a-blog a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Post Details"))
(body
(h1 "Post Details")
(h2 ,(post-title a-post))
(p ,(post-body a-post))
,(render-as-itemized-list
(post-comments a-post))
(form ([action
,(embed/url insert-comment-handler)])
,@(formlet-display new-comment-formlet)
(input ([type "submit"])))
(a ([href ,(embed/url back-handler)])
"Back to the blog")))))
(define (insert-comment-handler request)
(render-confirm-add-comment-page
a-blog
(formlet-process new-comment-formlet request)
a-post
request))
(define (back-handler request)
(render-blog-page a-blog request))
(send/suspend/dispatch response-generator))
; 评论提交确认
(define (render-confirm-add-comment-page a-comment a-post request)
(define (response-generator embed/url)
(response/xexpr
`(html (head (title "Add a Comment"))
(body
(h1 "Add a Comment")
"The comment: " (div (p ,a-comment))
"will be added to "
(div ,(post-title a-post))
(p (a ((href ,(embed/url yes-handler)))
"Yes, add the comment."))
(p (a ((href ,(embed/url cancel-handler)))
"No, I changed my mind!"))))))
(define (yes-handler request)
(post-insert-comment! a-post a-comment)
(render-post-detail-page a-post (redirect/get))) ;;重定向
(define (cancel-handler request)
(render-post-detail-page a-post request))
(send/suspend/dispatch response-generator))
; render-post: post -> xexpr
; 接受一个post，输出一个包含该文章的xexpr
(define (render-post a-blog a-post embed/url)
(define (view-post-handler request)
(render-post-detail-page a-blog a-post request))
`(div ((class "post"))
(a ((href ,(embed/url view-post-handler)))
,(post-title a-post))
(p ,(post-body a-post))
(div ,(number->string (length (post-comments a-post)))
" comment(s)")))
; render-posts: blog -> xexpr
; 接受一个博客，输出一个包含所有文章的xexpr
(define (render-posts a-blog embed/url)
(define (render-post/embed/url a-post)
(render-post a-blog a-post embed/url))
`(div ((class "posts"))
,@(map render-post/embed/url (blog-posts a-blog))))
(define (render-as-itemized-list fragments)
`(ul ,@(map render-as-item fragments)))
(define (render-as-item a-fragment)
`(li ,a-fragment))
17 离开DrRacket
目前我们还在DrRacket中点击运行按钮来启动程序。如果真的要部署程序，我们需要用另一种方式来启动程序。
最简单的方式是使用web-server/servlet-env。
第一步，将第一行#lang web-server/insta替换如下：
#lang racket
(require web-server/servlet)
(provide/contract (start (request? . -> . response?)))
第二步，添加以下代码：
(require web-server/servlet-env)
(serve/servlet start
#:launch-browser? #f
#:quit? #f
#:listen-ip #f
#:port 8000
#:extra-files-paths
(list (build-path your-path-here "htdocs"))
#:servlet-path
"/servlets/APPLICATION.rkt")
关于serve/servlet的参数：
-
你可以修改
#:port参数来使用不同的端口。 -
#:listen-ip设置为#f表示服务会监听所有可用的IP。 -
你需要将
your-path-here替换成你的htdocs的父目录。 -
你需要将"APPLICATION.rkt"替换成你的程序的文件名。
第三步，你依然可以在DrRacket中点击运行按钮来运行程序，或则在命令行输入racket -t <file.rkt>。服务地址为http://localhost:8000/servlets/APPLICATION.rkt。
更多关于serve/servlet的参数以及启动web服务器的方式，可以看Racket网络服务器参考手册。
18 使用HTTPS
使用HTTPS服务需要一个证书和一个私钥。以下是在UNIX上使用OpenSSL获取私钥证书的方式。
openssl genrsa -des3 -out private-key.pem 1024
它会生成一个带密码的私钥，你可以通过以下方式删除它：
openssl rsa -in private-key.pem -out private-key.pem
chmod 400 private-key.pem
接下来生成证书：
openssl req -new -x509 -nodes -sha1 -days 365 -key private-key.pem > server-cert.pem
最后通过以下参数启动服务：
plt-web-server --ssl
服务将会使用我们创建的"private-key.pem"和"server-cert.pem"在443端口启动（可通过-p选项修改）。
19 前进
随着学习的深入，你会发现其他有空库。如访问其他数据库的接口，生成HTML、XML、JavsScript的工具等，点击https://pkgs.racket-lang.org/查看。
欢迎加入Racket社区！
3372
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
