WiLiKiソース解読:src/wiliki/db.scm
データベースアクセス
;; Database access ------------------------------------------
(define (with-db thunk)
(parameterize
((db (dbm-open (db-type-of (wiliki))
:path (db-path-of (wiliki)) :rwmode :write)))
(dynamic-wind
(lambda () #f)
thunk
(lambda () (dbm-close (db))))))
データベースを開いて処理(thunk)を行い、データベースを閉じる手続きwith-db。dynamic-windにより、必ずデータベースが閉じられる。
with-dbは、CGIのエントリポイントで、CGIコマンドを囲むように使われているだけ。つまり、 データベースのインスタンスをグローバルに持つことなく、メインメソッドの中で with-dbの中だけデータベースが接続されている。(実際は、CGIへのリクエストから レスポンスまでの間だけだが。)
(define-class <page> () ((key :init-keyword :key :accessor key-of) (ctime :initform (sys-time) :init-keyword :ctime :accessor ctime-of) (cuser :initform #f :init-keyword :cuser :accessor cuser-of) (mtime :initform #f :init-keyword :mtime :accessor mtime-of) (muser :initform #f :init-keyword :muser :accessor muser-of) (content :initform "" :init-keyword :content :accessor content-of) ))
クラス<page>の定義。スーパークラスなし。スロット(インスタンス変数)の一覧を表に示す。
| スロットの名前 | アクセッサ | 初期化する際の識別キーワード | 初期値 |
| key | key-of | :key | 未定義 |
| ctime | ctime-of | :ctime | (sys-time) |
| cuser | cuser-of | :cuser | #f |
| mtime | mtime-of | :mtime | #f |
| muser | muser-of | :muser | #f |
| content | content-of | :content | ""(空文字列) |
(define-method wdb-exists? ((db <dbm>) key) (dbm-exists? db key))
wdb-exists?は、引数に与えたキーがデータベースのキーに存在するかを調べる手続き。
(define-method wdb-record->page ((db <dbm>) key record)
(call-with-input-string record
(lambda (p)
(let* ((params (read p))
(content (port->string p)))
(apply make <page> :key key :content content params)))))
手続きwdb-record->pageは、引数として与えたkeyとrecordから<page>クラスを作る。仮引数のdbは、手続き内部で使われていない。
call-with-input-stringは、引数の文字列(ここではrecord)を入力ポートとし、その入力ポートを第2引数の手続きに渡す。
lambda式では、まず(read p)により読み込まれた最初のトークンをparamsに束縛する。let*では、変数束縛は順番に行われるので、先にこの(params (read p))が評価され、読み込まれた最初のトークンが取りのぞかれた状態で次の(content (port->string) p)が評価される。
port->stringは、ポートの内容を文字列として返す手続き。したがって、recordから最初のトークンが取り除かれた後の文字列が全てcontentに束縛される。
以上で得たparamsとcontentを使って、<page>クラスのインスタンスを作る。<page>クラスの:init-keywordである:contentにcontentを与えているが、paramsは何に渡されているのだろうか？ applyが使われているので、paramsはその内容に展開されて渡されていると思うのだが。paramsの中には、展開されて使われることを想定した:ctimeとかが入っているのかな？
WDB-GET
;; WDB-GET db key &optional create-new
(define-method wdb-get ((db <dbm>) key . option)
(cond ((dbm-get db key #f) => (cut wdb-record->page db key <>))
((and (pair? option) (car option))
(make <page> :key key))
(else #f)))
手続きwdb-getは、データベースにkeyに対応する値があればそれを元に、なければ与えたoptionを元にした内容が空の、<page>オブジェクトを作る。
dbm-getは、dbから、与えたkeyに対応する値を取り出すが、#fはキーが存在しない場合のデフォルト値。(もしかすると、キーは存在するが、キーに対応する値が存在しない場合のデフォルト値かもしれない。) で、結果が真ならば(値があれば)、その値をwdb-record->pageに第3引数として渡す。
cutは、手続きを作る手続きで、cutに与えられる引数は、<>の部分に埋め込まれる。より正確なcutの振る舞いについてはリファレンスマニュアル参照のこと。結果、keyに対応する値を:contentとする<page>オブジェクトを作る。
(dbm-get db key #f)が#fに評価されると、condの2番目に制御が移る。optionがペアで、かつoptionのcarが#fでなければ、:keyが:keyであるだけの<page>オブジェクトを作る。
条件が全て#fならelseで#fが返る。
WDB-PUT!
;; WDB-PUT! db key page
(define-method wdb-put! ((db <dbm>) key (page <page>) . option)
(let ((s (with-output-to-string
(lambda ()
(write (list :ctime (ctime-of page)
:cuser (cuser-of page)
:mtime (mtime-of page)
:muser (muser-of page)))
(display (content-of page)))))
(donttouch (get-keyword :donttouch option #f)))
(dbm-put! db key s)
(unless donttouch
(let1 r (alist-delete key
(read-from-string
(dbm-get db *recent-changes* "()")))
(dbm-put! db *recent-changes*
(write-to-string
(acons key (mtime-of page) (take* r 49))))))
))
手続きwdb-put!は、データベースにデータを追加し、必要ならば「最近の更新」リストを更新する手続き。
メインの処理は、ローカル変数sとdonttouchを用意して、dbm-put!によりデータベースにsを格納するもの。
- sは何か。
- with-output-to-stringは、ローカルな文字列出力ポートをバッファとして用意し、その出力ポートを引数とする手続きを呼び出し、最後にその出力ポートに溜められたものを文字列として返す。
- lambda式では、そのローカルな文字列出力ポートに、1つのリストとpageのcontentを出力しているので、その文字列がsに束縛される。
- リストの内容は、pageオブジェクトから抽出した情報で、(:ctime ctime :cuser cuser :mtime mtime :muser muser)となる。これは、上で疑問であった、wdb-record->pageのlet*文に出てくるparamsの内容だ。
- donttouchは何か。
- get-keywordは、リストoptionからキーが:donttouchである値を取り出したもの。#fは、値が存在しない場合のフォールバック。これは、データベースへのデータの格納の後のunless文で使われる。
unless文は、donttouchが#fである場合のみ処理される。ローカル変数rを用意して、データベースにデータを格納する。
- rは、データベースからキーが*recent-changes*である値(これは多分リストをリテラルで表現したもの)をread-from-stringで読み込むことによりトークンに変換し、それは連想配列のようなものになっているので、そこからキーがkeyである組を削除したものが束縛される。
- dbm-put!では、キー*recent-changes*の値として、リストrから最初の49要素を抽出したものの先頭に、(key . (mtime-of page))を追加したものを文字列として表現した(write-to-string)ものを格納する。
WDB-DELETE!
;; WDB-DELETE! db key
(define-method wdb-delete! ((db <dbm>) key)
(let ((r (alist-delete key
(read-from-string (dbm-get db *recent-changes* "()")))))
(dbm-delete! db key)
(dbm-put! db *recent-changes* (write-to-string r))))
手続きwdb-delete!は、与えたkeyに対応するキーと値をデータベースから削除するとともに、「最近の更新」リストからそのキーに該当するデータを削除する。その際、一旦read-from-stringで読み出してリスト(連想配列)の形にして、リスト操作関数で操作の上、write-to-stringで書き戻している。
(define-method wdb-recent-changes ((db <dbm>)) (read-from-string (dbm-get db *recent-changes* "()")))
手続きwdb-recent-changesは、「最近の更新」を取り出しread-from-stringする。
(define-method wdb-map ((db <dbm>) proc)
(reverse! (dbm-fold db
(lambda (k v r)
(if (string-prefix? " " k)
r
(cons (proc k v) r)))
'())))
dbm-foldは、データベース内のキーと値を繰り返し引数として、引数で与えられた手続き繰り返し呼び出し、結果をここではrに集積する。
ここで、dbm-foldに与えられる手続きlambdaの内容は、キーがスペースで始まっていたらr(lambdaの最初の呼び出し時は'()、2回目以降は前回のlambdaの戻り値)を返す。キーがスペースで始まっていなかったら、wdb-mapに与えた手続きにキーと値を与えて呼び出し、その結果をrにconsする。
つまり、キーがスペースで始まっていないキーと値のみを対象に、それにprocを適用した結果のリスト(最後にreverse!するが)を返す。実際に呼び出している部分を見ないと、具体的なイメージが湧かないが。
(define-method wdb-search ((db <dbm>) pred)
(sort
(dbm-fold db
(lambda (k v r)
(if (pred k v) (acons k (read-from-string v) r) r))
'())
(lambda (a b)
(> (get-keyword :mtime (cdr a) 0) (get-keyword :mtime (cdr b) 0)))))
手続きwdb-searchは、2つの部分に分かれる。sortの対象となるdbm-foldの戻り値と、sortの条件となる後半のlambdaだ。
dbm-foldでは、wdb-searchに渡した(述語/判定)手続きpredが使われている。データベースのキーと値にpredを適用した結果が真の場合のみ後続する処理が行われる。後続する処理とは、キーと、値をread-from-stringしたもののペアをリストとして蓄積する処理だ。これがsortの対象となる。
sortの条件は、(データベースの値をread-from-stringしたものの)cdrにあるキーワード:mtimeの値(フォールバックは0)の大小である。(:mtimeは、modification time、つまり更新時刻を意味していると思われるので、このsortはつまり更新時刻の新しい順にソートしていることになる。)
(define-method wdb-search-content ((db <dbm>) key)
(wdb-search db
(lambda (k v)
(and (not (string-prefix? " " k))
(string-contains (content-of (wdb-record->page db key v))
key)))))
手続きwdb-search-contentは、上で定義されているwdb-searchを使っている。内部でwdb-searchに渡される(述語/判定)手続きのlambdaで、真と判定されるのは、データベースのキーがスペースで始まらず、かつ、keyとvから作った<page>オブジェクトの:contentにkeyが含まれている場合である。まだ、この手続きの意味は分からない。