以前 CUW で作成した TODO リストアプリケーション は todo オブジェクトをメモリ上に持っているだけでした。
今回は
Elephant を使って todo オブジェクトを永続化してみます。
Elephant は Common Lisp のオブジェクトデータベースです。
バックエンドとして Berkeley DB、CL-SQL 経由の PostgreSQL or SQLite3 が使用可能です。Postmodern も使えるようになっているかもしれません。
elephant:open-store でデータストアをオープンします。
バックエンドで Berkeley DB を使う場合は、あらかじめディレクトリを作成しておく必要があります（ensure-directories-exist を使えばいいと思います）。
永続化するクラスは elephant:defpclass で作成します。
クラスオプションの :index に t を指定するとインスタンスは自動的に永続化されます。
elephant:defpclass で作成したクラスはユニークな識別子となる oid スロットを持ちます。
永続化したクラスの全インスタンスを取得するには elephant:get-instances-by-class を使います。
データストアからインスタンスを削除するには elephant:drop-instances を使います。
以下、ソースです。メモリ上にリストで保持していたときよりも少しシンプルになりました。
(eval-when (:load-toplevel :compile-toplevel :execute)
(require :elephant) (unless (find-package :ucw)
(load (merge-pathnames "letter/lisp/ucw/ucw-boxset/start.lisp"
(user-homedir-pathname)))))
(in-package :it.bese.ucw-user)
(elephant:open-store `(:BDB ,(ensure-directories-exist #p"/tmp/todo/")))
(defvar *todo-list-application*
(make-instance 'cookie-session-application
:url-prefix "/todo/" :charset :utf-8 :debug-on-error t) "アプリケーションの作成。")
(register-application *default-server* *todo-list-application*)
(defentry-point "index.ucw" (:application *todo-list-application*)
()
(call 'top-window))
(elephant:defpclass todo ()
((content :initarg :content :accessor content)
(done :initform nil :accessor done))
(:index t) (:documentation "TODO クラス"))
(defmethod print-object ((todo todo) stream)
"debug のために"
(print-unreadable-object (todo stream :type t :identity t)
(format stream "~a: ~a" (elephant::oid todo) (content todo))))
(defun delete-todo (todo)
"TODO を削除します。"
(elephant:drop-instances (list todo)))
(defun get-all-todo ()
(elephant:get-instances-by-class 'todo))
(defcomponent top-window (simple-window-component)
((body :initarg :body
:accessor body
:component todo-list-view))
(:default-initargs :title "TODO リスト")
(:documentation "トップウィンドウ。
body に一覧や編集のコンポーネントをセットして画面表示を行う。"))
(defmethod render ((top top-window))
(<:h1 "TODO リスト")
(render (body top)))
(defcomponent todo-list-view ()
()
(:documentation "TODO の一覧コンポーネント"))
(defmethod render ((self todo-list-view))
"TODO の一覧を表示する。"
(<ucw:a :action (call 'todo-create-view) "新規作成")
(<:table
:border 1
(<:tr (<:th "完了") (<:th "TODO") (<:th "削除"))
(loop for each in (get-all-todo)
do (let* ((todo each))
(<:tr
(<:td (<:as-html
(if (done todo)
"済"
(<ucw:a
:action (done-todo-action self todo)
"完了する"))))
(<:td (<:as-html (content todo)))
(<:td (<ucw:a :action (delete-todo-action self todo)
"削除する")))))))
(defaction done-todo-action ((self todo-list-view) todo)
"TODO を完了する。"
(setf (done todo) t))
(defaction delete-todo-action ((self todo-list-view) id)
"TODO を1件削除する。"
(delete-todo id))
(defcomponent todo-create-view ()
((content
:accessor content
:initform (make-instance 'string-field)))
(:documentation "TODO を新規作成するためのコンポーネント"))
(defmethod render ((self todo-create-view))
"TODO 新規作成画面"
(<ucw:form
:action (create-todo self)
"TODO" (render (content self))
(<:submit :value "新規作成"))
(<ucw:a :action (ok self) "キャンセル"))
(defaction create-todo ((self todo-create-view))
"画面からの入力により TODO を新規作成する。"
(make-instance 'todo :content (value (content self)))
(ok self))