Kahua Release
- Release Note
- Download
- Current Version 1.0.7.3 (2008-05-08)
kahua-web Release
- kahua-webとは
- Release Note
- Download
- Current Version 0.3.1 (2007-06-12)
Security Advisory
Event Log
Documentation
For developers
Site info
Related Site
ソーシャルブックマークを作る(4)
前のStepで2番目の問題として挙げた、「不正なデータも登録できてしまう」を 解決してみましょう。
バリデーションシステムを設計する
実はKahuaには今のところ、バリデーションを統一的にサポートする仕組みはあ りません。実装における優先順位が低かったこともありますし、そもそも統一 的にやる類いのものなのかなぁ、という疑問が開発者(というか備前)にあった ためです。
とはいえ、毎回毎回枠組みから作り上げるのも馬鹿馬鹿しいので、ここでバリ デーションの仕組みを考えてみましょう。よさそうならそのままKahuaに組み 込んでしまいます(そんなんありか)。こんな感じのを
- 宣言的に書ける
- バリデーション違反に対する処理をまとめてしたい
ということでこんなマクロを書いてみました。
(define-syntax with-validation
(syntax-rules (=>)
((_ ((val validator error) ...) => err-hdr body ...)
(let1 check (fold (lambda (e r)
(apply (lambda (v vldr err)
(if (vldr v)
r
(cons (err v) r)))
e))
'() `((,val ,validator ,error) ...))
(if (null? check)
(begin body ...)
(err-hdr (reverse! check)))))))
使い方はこんな感じ。何だかご都合主義ですが。
(with-validator ((a validator-a invalid-a) (b validator-b invalid-b) (c validator-c invalid-c)) => error-handler form ...)
説明すると、値 a b c に対して、それぞれ順番に validator-a validator-b validator-c が適用されます。バリデータは真を返せばvalid、偽(#f)を返せばinvalidということになり ます。invalidな値があった場合、その値に対応する invalid-? が、invalidだった値に 対して適用されたものが、まとめられてリストになります。ひとつ以上invalidな値が存在 した場合、こうして作られたリストを引数にerror-handlerが呼ばれてその値が返り、 全ての値がvalidだった場合はformが実行され、最後の値が返ります。
では実際にこれを使ってみましょう。入力のチェックをしたいのはもちろん、ブックマーク の登録を受けつける処理ですね。書き換えるのは bookmark-form/ です。
まず最初に、バリデーションの処理を書くために追加でモジュールをuseします。
(use srfi-13) (use rfc.uri)
srfi-13は文字列を扱う手続きを定義しているモジュールで、rfc.uriはその名の通り URI(URL)を扱うための手続きを定義しているモジュールです。次に、バリデータを 定義します。
(define string-not-null?
(compose not string-null?))
(define (valid-uri? uri)
(receive (scheme uinfo host port path query fragment) (uri-parse uri)
(and scheme
(or (string=? scheme "http") (string=? scheme "https") (string=? scheme "ftp"))
host)))
いずれも読めばわかる簡単なものですね。valid-uri?については、どんなURLまで登録を 許すか、サイトやアプリケーションに大きく依存します。ここでは、スキーマがhttp、 https、ftpのいずれかであり、ホスト名が指定されているものを許すことにしましょう。
次にバリデーションでinvalidと判断された場合に表示するエラーメッセージ部分を定義します。
(define (validation-error/ s) (li/ (@/ (class "attention")) s)) (define (validation-errors/ l) (ul/ (map/ validation-error/ l)))
classに"attention"をつけているのは、スタイルシートで赤くしたりといったことができるように するためです。これもオーソドックスな手法ですね。
で、さきほどのマクロを書きます。再掲しましょう。
(define-syntax with-validation
(syntax-rules (=>)
((_ ((val validator error) ...) => err-hdr body ...)
(let1 check (fold (lambda (e r)
(apply (lambda (v vldr err)
(if (vldr v)
r
(cons (err v) r)))
e))
'() `((,val ,validator ,error) ...))
(if (null? check)
(begin body ...)
(err-hdr (reverse! check)))))))
最後に、bookmark-form/ を書き換えます。書き換えるのは、entry-lambda定義の中身です。
(define (bookmark-form/ title url msg-element)
(form/cont/
(@@/ (cont (entry-lambda (:keyword title url)
(let ((title (if title (string-trim-both title) ""))
(url (if url (string-trim-both url) "")))
(with-validation
((title string-not-null? (lambda _ "Title cannot be null string"))
(url valid-uri? (pa$ format "Invalid URL: ~s")))
=> (lambda (e)
(standard-page "New Bookmark (retry)"
(node-set/
(all-bookmarks-link/)
(bookmark-form/ title url (validation-errors/ e)))))
(register-bookmark title url)
(redirect/cont (cont all)))))))
(node-set/
msg-element
(table/
(tr/ (th/ "Title: ") (td/ (textbox/ "title" title 50)))
(tr/ (th/ "URL: ") (td/ (textbox/ "url" url 50)))
(tr/ (th/) (td/ (submit/ "Register")))))))
急に長くなった(そして複雑になった)気がしますが、きっと気のせいです(笑)。 まずパラメータ値として渡ってきた値を正規化し、バリデータにかけた後、 invalidな値があればエラーメッセージを埋め込んだフォームを表示し、 全ての値がvalidであればブックマークの登録と一覧ページへのリダイレクトを 行っているのです。entry-lambdaの中身を細かく手続きにわけるともっと わかりやすいでしょうが、ここでは書き換えの様子がわかりやすいように、 entry-lambdaの中に全て詰め込んでいます。
最後にbookmarks.kahua全体をもう一度掲載します。じっくり読むと、大して 難しくないことがわかるでしょう。
(use srfi-13)
(use rfc.uri)
(use gauche.collection)
(load "bookmarks/version.kahua")
(define page-template
(kahua:make-xml-template
(kahua-template-path "bookmarks/page.xml")))
(define (standard-page title body)
(kahua:xml-template->sxml
page-template
:title (title/ (@/ (id "title")) title)
:body (div/ (@/ (id "body")) (h1/ title) body)))
(define (make-link/ entry text)
(p/ (a/cont/ (@@/ (cont entry)) text)))
(define-class <bookmark> (<kahua-persistent-base>)
((title :allocation :persistent :init-keyword :title :init-value "")
(url :allocation :persistent :init-keyword :url :init-value "" :index :unique)
(count :allocation :persistent :init-value 1)))
(define (bookmark-entry/ bm)
(li/ (a/ (@/ (href (slot-ref bm 'url))) (slot-ref bm 'title))
"(" (slot-ref bm 'count) ")"))
(define (bookmark-list/ bm-collection)
(define (count-cmp bm1 bm2)
(> (slot-ref bm1 'count) (slot-ref bm2 'count)))
(ul/ (map/ bookmark-entry/
(sort (coerce-to <list> bm-collection) count-cmp ))))
(define-entry (all)
(standard-page "All Bookmarks"
(node-set/
(new-bookmark-link/)
(bookmark-list/ (make-kahua-collection <bookmark>))
(version-link/))))
(define all-bookmarks-link/ (cut make-link/ all "[All Bookmarks]"))
(define (textbox/ name value . maybe-size)
(input/ (@/ (type "text") (name name) (value value)
(size (get-optional maybe-size #f)))))
(define (submit/ value)
(input/ (@/ (type "submit") (value value))))
(define (register-bookmark title url)
(or (and-let* ((bm (find-kahua-instance <bookmark> 'url url)))
(inc! (ref bm 'count))
bm)
(make <bookmark> :title title :url url)))
(define-syntax with-validation
(syntax-rules (=>)
((_ ((val validator error) ...) => err-hdr body ...)
(let1 check (fold (lambda (e r)
(apply (lambda (v vldr err)
(if (vldr v)
r
(cons (err v) r)))
e))
'() `((,val ,validator ,error) ...))
(if (null? check)
(begin body ...)
(err-hdr (reverse! check)))))))
(define (validation-error/ s)
(li/ (@/ (class "attention")) s))
(define (validation-errors/ l)
(ul/ (map/ validation-error/ l)))
(define string-not-null?
(compose not string-null?))
(define (valid-uri? uri)
(receive (scheme uinfo host port path query fragment) (uri-parse uri)
(and scheme
(or (string=? scheme "http") (string=? scheme "https") (string=? scheme "ftp"))
host)))
(define (bookmark-form/ title url msg-element)
(form/cont/
(@@/ (cont (entry-lambda (:keyword title url)
(let ((title (if title (string-trim-both title) ""))
(url (if url (string-trim-both url) "")))
(with-validation
((title string-not-null? (lambda _ "Title cannot be null string"))
(url valid-uri? (pa$ format "Invalid URL: ~s")))
=> (lambda (e)
(standard-page "New Bookmark (retry)"
(node-set/
(all-bookmarks-link/)
(bookmark-form/ title url (validation-errors/ e)))))
(register-bookmark title url)
(redirect/cont (cont all)))))))
(node-set/
msg-element
(table/
(tr/ (th/ "Title: ") (td/ (textbox/ "title" title 50)))
(tr/ (th/ "URL: ") (td/ (textbox/ "url" url 50)))
(tr/ (th/) (td/ (submit/ "Register")))))))
(define-entry (new)
(standard-page "New Bookmark"
(node-set/
(all-bookmarks-link/)
(bookmark-form/ "" "" empty))))
(define new-bookmark-link/ (cut make-link/ new "[New Bookmark]"))
(define-entry (version)
(standard-page "bookmarks version"
(node-set/
(h2/ *bookmarks-version*)
(all-bookmarks-link/))))
(define version-link/ (cut make-link/ version "[Version]"))
;
; initialization
;
(initialize-main-proc all)