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
ソーシャルブックマークを作る(5)
ここまでで単なるブックマークとしての機能は揃ったはずなので、 少し機能拡張をしてみましょう。ここで付け足すのは、最近さまざまな サイトで普通に見かけるようになった「タグ」づけ機能です。 タグについてはさまざま議論があるようですが、ここでは 「タグかくあるべし」という議論には全く踏み込まず、単に 「複数のキーワードにブックマークを結びつける」機能ということに しておきます。
タグクラスを定義する
何はともあれタグを表現するクラスを定義してみましょう。 ここでのタグは単なる文字列(キーワード)ですが、 永続化してデータベースに保存するためには、<kahua-persistent-base> を継承するクラスとして定義する必要がありますからね。
(define-class <tag> (<kahua-persistent-base>) ((name :allocation :persistent :init-keyword :name :index :unique) (bookmarks :allocation :persistent :init-keyword :bookmarks)))
nameスロットは、タグ自身を表す文字列、 bookmarksスロットはそのタグをつけられたブックマークの集合を保持します。 タグそのものは重複して欲しくないですから、nameスロットには :index :unique オプションをつけます。また、ブックマークの集合は実際にはリストで 実装します。リストを集合として扱うための手続き群は srfi-1 モジュールに 定義されていますから、
(use srfi-1)
をbookmarks.kahuaの先頭部分に追加しておきましょう。
さて、<bookmark>にも手を入れます。そのブックマークに何のタグがつけられているのか、 これも集合として管理しておきたいですよね。
(define-class <bookmark> (<kahua-persistent-base>) ((title :allocation :persistent :init-keyword :title :init-value "") (url :allocation :persistent :init-keyword :url :init-value "" :index :unique) (tags :allocation :persistent :init-keyword :tags :init-value '()) (count :allocation :persistent :init-value 1)))
tagsというスロットを追加しています。ここにリストで表現された<tag>インスタンスの 集合を保持するわけです。
タグの登録と表示を考える
タグの登録は少々複雑です。なぜなら、常にどのブックマークと結びつけられるのかを意識する 必要があるからです。ここでは、イメージしやすくするために入力画面を基点に考えていくことに しましょう。
(define (bookmark-form/ title url tags 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 tags (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/ "Tags: ") (td/ (textbox/ "tags" tags 50)))
(tr/ (th/) (td/ (submit/ "Register")))))))
定義単位で掲載しているので一瞬ウゲッとなりそうですが、単純に「Tags」という入力欄を増やし、 それに対応する引数 tags を bookmark-form/ に追加しているだけです。ついでに、bookmark-form/ を呼び出している箇所も引数を増やしておきましょう。上記のentry-lambdaフォームの中と、
(define-entry (new)
(standard-page "New Bookmark"
(node-set/
(all-bookmarks-link/)
(bookmark-form/ "" "" "" empty))))
new エントリの中ですね。タグの入力欄はテキストボックスで、 タグはスペースで区切って入力することにします。従って、パラメータとして 渡ってくるのは、スペースで区切られた任意の文字列ということになります。
そこで、この「スペースで区切られた任意の文字列」を<tag>インスタンスの集合に変換し、 <bookmark>インスタンスのtagsスロットに必要に応じて登録し、 かつその<bookmark>インスタンスを各<tag>インスタンスのbookmarksスロットに登録する 手続きを作成しましょう。
(define (tag-set-register! tags bm)
(when tags
(let* ((tags (string-trim-both tags))
(unified-tags (fold (lambda (e r)
(lset-adjoin equal? r
(or (and-let* ((tag (find-kahua-instance <tag> 'name e))
(bookmarks (slot-ref tag 'bookmarks)))
(slot-set! tag 'bookmarks (lset-adjoin equal? bookmarks bm))
tag)
(make <tag> :name e :bookmarks (list bm)))))
(slot-ref bm 'tags)
(string-split tags #[\s]))))
(slot-set! bm 'tags unified-tags))))
kahua-shellで試してみましょうか。あらかじめ「http://www.kahua.org/」に対するブックマークを 登録しておいて下さい。
bookmarks(ll:ktvt)> (define bm (find-kahua-instance <bookmark> 'url "http://www.kahua.org/")) bm bookmarks(ll:ktvt)> bm #<<bookmark> 0x1336920> bookmarks(ll:ktvt)> (tag-set-register! " Kahua Gauche " bm) (#<<tag> 0x153fcc8> #<<tag> 0x1541280>) bookmarks(ll:ktvt)>
うまくいっているみたいですね。それでは、各ブックマークに登録されたタグを表示してみましょう。 bookmark-entry/ を以下のように書き換えます。
(define (bookmark-entry/ bm)
(li/ (a/ (@/ (href (slot-ref bm 'url))) (slot-ref bm 'title))
"(" (slot-ref bm 'count) ")"
(br/)
(span/ (@/ (class "bookmark-tags"))
(map/ (lambda (tag)
(node-set/ " " (slot-ref tag 'name)))
(slot-ref bm 'tags)))))
kahua-shellで評価してブラウザをリロードしてみて下さい。さっきkahua-shellから登録した タグが表示されましたか?
では、tag-set-register! をブックマークの登録手続きに組み込んでみましょう。
(define (bookmark-form/ title url tags msg-element)
(form/cont/
(@@/ (cont (entry-lambda (:keyword title url tags)
(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 tags (validation-errors/ e)))))
(let1 bm (register-bookmark title url)
(tag-set-register! tags bm))
(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/ "Tags: ") (td/ (textbox/ "tags" tags 50)))
(tr/ (th/) (td/ (submit/ "Register")))))))
そろそろこの手続きも整理した方がいいかも。ポイントは、entry-lambda の :keyword 引数に tags を追加し、本体部分でregister-bookmark手続きの戻り値を受けて tag-set-register! を呼んでいるところです。ブックマーク登録フォームから、 登録してみて下さい。既存のブックマークと同じURLを指定すれば、ブックマークに タグを追加することができるのがわかりますか?
タグでの絞り込みを考える
ブックマークにタグをつけるだけではあまり面白みがありません。 タグで表示するブックマークを絞り込めるようにしてみましょう。
あるタグを持っているブックマークのコレクションを得るのは簡単です。 何しろ、<tag>クラスにはそれに相当する bookmarks スロットがありますから。 allエントリそっくりになりそうです。ですから、allエントリをベースに tagエントリを書いてみましょう。
(define (bookmark-list-page/ title header bms)
(standard-page title
(node-set/
header
(bookmark-list/ bms)
(version-link/))))
(define-entry (all)
(bookmark-list-page/ "All Bookmarks"
(new-bookmark-link/)
(make-kahua-collection <bookmark>)))
(define-entry (tag tag-name)
(bookmark-list-page/ (format "Tag: ~a" tag-name)
(all-bookmarks-link/)
(or (and-let* ((t (find-kahua-instance <tag> 'name tag-name)))
(slot-ref t 'bookmarks))
'())))
何だかその場しのぎのコピペ臭がぷんぷんとしますが、今は気にしないことにします。 やっていることは、allエントリの中身をごっそり取り出して bookmark-list-page/ 手続きに仕立て、 それを使ってallを書き直し、tagエントリを書いているだけです。
ここでtagエントリにtag-nameという引数がつけられていることに注目して下さい。 define-entryにおいて、エントリ名(ここではtag)直後に続く引数群は、パス要素として 扱われます。ただし、:keyword などのキーワードが入ると、そこから後ろの引数については 扱いが変わります。詳細はリファレンスマニュアルのdefine-entryやentry-lambdaの説明を 読んでみて下さい。ここでは、タグによる絞り込みが、
http://localhost:8088/bookmarks/tag/タグ名
で行われることがわかれば充分です。登録したタグ名を使って直接URLを組み立ててブラウザで アクセスしてみて下さい。絞り込みができていますか?
タグへのリンクを作る
ここまでできてしまえば、ブックマークにくっついているタグ一覧をタグへのリンク一覧にするのは 簡単ですね。
(define (tag-link/ t)
(let1 tag-name (slot-ref t 'name)
(a/cont/ (@@/ (cont tag tag-name)) tag-name)))
(define (bookmark-entry/ bm)
(li/ (a/ (@/ (href (slot-ref bm 'url))) (slot-ref bm 'title))
"(" (slot-ref bm 'count) ")"
(br/)
(span/ (@/ (class "bookmark-tags"))
(map/ (lambda (tag)
(node-set/ " " (tag-link/ tag)))
(slot-ref bm 'tags)))))
評価してブラウザをリロードしてみましょう。デザインには改善の余地がかなりありますが(笑)、 とりあえずタグによる一覧の絞り込みができるようになりましたね。
いつものようにこの段階のbookmarks.kahuaを掲載しておきます。
(use srfi-1)
(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)
(tags :allocation :persistent :init-keyword :tags :init-value '())
(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) ")"
(br/)
(span/ (@/ (class "bookmark-tags"))
(map/ (lambda (tag)
(node-set/ " " (tag-link/ tag)))
(slot-ref bm 'tags)))))
(define (tag-link/ t)
(let1 tag-name (slot-ref t 'name)
(a/cont/ (@@/ (cont tag tag-name)) tag-name)))
(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-class <tag> (<kahua-persistent-base>)
((name :allocation :persistent :init-keyword :name :index :unique)
(bookmarks :allocation :persistent :init-keyword :bookmarks)))
(define (tag-set-register! tags bm)
(when tags
(let* ((tags (string-trim-both tags))
(unified-tags (fold (lambda (e r)
(lset-adjoin equal? r
(or (and-let* ((tag (find-kahua-instance <tag> 'name e))
(bookmarks (slot-ref tag 'bookmarks)))
(slot-set! tag 'bookmarks (lset-adjoin equal? bookmarks bm))
tag)
(make <tag> :name e :bookmarks (list bm)))))
(slot-ref bm 'tags)
(string-split tags #[\s]))))
(slot-set! bm 'tags unified-tags))))
(define (bookmark-list-page/ title header bms)
(standard-page title
(node-set/
header
(bookmark-list/ bms)
(version-link/))))
(define-entry (all)
(bookmark-list-page/ "All Bookmarks"
(new-bookmark-link/)
(make-kahua-collection <bookmark>)))
(define-entry (tag tag-name)
(bookmark-list-page/ (format "Tag: ~a" tag-name)
(all-bookmarks-link/)
(or (and-let* ((t (find-kahua-instance <tag> 'name tag-name)))
(slot-ref t 'bookmarks))
'())))
(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 tags msg-element)
(form/cont/
(@@/ (cont (entry-lambda (:keyword title url tags)
(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 tags (validation-errors/ e)))))
(let1 bm (register-bookmark title url)
(tag-set-register! tags bm))
(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/ "Tags: ") (td/ (textbox/ "tags" tags 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)
問題点
ちょっと脱線。
ここまで述べてきたタグの実装を見て、「何だよスケールしねーじゃん」と思ったあなた。 正しいです。こんなナイーブな実装では、あっという間に<tag>インスタンスが参照する <bookmark> インスタンスの数が爆発して、にっちもさっちもいかなくなります。 このチュートリアルでは、説明のしやすさを優先して、このような実装を選択しました。
RDBMS的な正解は、<bookmark> と <tag> の間にその参照関係を管理するクラスを設ける ことだと思います。あくまでもRDBMS的解ですが。
Kahuaでは、将来的に :index :set というインデックススロットオプションを設け、 スロット値がリストである場合に各要素をインデックス値として使用できるよう、 拡張したいと考えています。これが実現すると、<bookmark> の tags スロット、 <tag> の bookmarks スロットにそれぞれ :index :set を設定するだけで、きちんとスケールするようになります。