[Common Lisp][UCW][Elephant] UCW で作った TODO リストアプリケーションに永続化機能を追加する

以前 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 を使います。

以下、ソースです。メモリ上にリストで保持していたときよりも少しシンプルになりました。

;; ucw がロードされていなければロードする。
(eval-when (:load-toplevel :compile-toplevel :execute)
  (require :elephant)                   ; Elephant
  (unless (find-package :ucw)
    ;; UCW の start.lisp をロードする。パスは環境にあわせて修正してください。
    (load (merge-pathnames "letter/lisp/ucw/ucw-boxset/start.lisp"
                           (user-homedir-pathname)))))

(in-package :it.bese.ucw-user)

;; Elephant のストアをオープンする。バックエンドは Berkeley DB を使います。
(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        ; 文字コードを UTF-8 に設定
                 :debug-on-error t)     ; エラー時にはデバッガを起動
  "アプリケーションの作成。")

;; アプリケーションをサーバに登録する。
(register-application *default-server* *todo-list-application*)

;; エントリポイントの作成。http://localhost:8080/todo/index.ucw
(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 リスト")
  ;; body の表示
  (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))