;; 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 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! 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を格納するもの。
unless文は、donttouchが#fである場合のみ処理される。ローカル変数rを用意して、データベースにデータを格納する。
;; 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が含まれている場合である。まだ、この手続きの意味は分からない。