LISPUSER

LISPMEMOQ: How can you tell when you've reached Lisp Enlightenment?
A: The parentheses disappear. -- Anonymous

(top)  (memo)  (rss)

CL-Prevalence : Common Lisp で Object Prevalence

データを保存したくて CFFI 使って GDBM とのインターフェースを書いていた んですが,オブジェクトを保存したいケースにでくわして,CL-Store 使うか… とおもったところで,CL-Prevalence の事を思いだしました.インストールし ただけで使ってなかったんですが,使ってみたら非常に便利でした.

CL-PREVALENCE 概要 (翻訳)

CL-PREVALENCE とは Sven Van Caekenberghe 氏による ObjectPrevalence _ の Common Lisp 実装です. CL-PREVALENCES-XML を使用した XML シリアライズプロトコルを用いています.また,よ り Lisp ライクな S 式ベースのシリアライズプロトコルも存在します.

Object Prevalence 2001 年に Klaus Wuestefeld によって提案された,シンプ ルでかつ興味深いコンセプトを持った技術です.IBM developerWorks にわかり やすい 入門記事 があります.Java による主な実装は Prevayler と呼 ばれており,Wiki サイト(雑然としています)に多くの情報と活発な議論があ ります.Object Prevalence の主要な特徴のほとんどは学術論文 A Simple and Efficient Implementation for Small Databases (Birrell, Jones, and Wobber 1987 ) で説明されています. 基本的なアイデアは以下のようなものです.

  • ほとんどのデータベースは,数百メガバイト程度のサイズしかないか,それよりも小さい
  • ほとんどのコンピュータは数百メガバイトのデータを RAM 上で操作できる.(大きなサーバなら数ギガバイト程度のデータを扱える)
  • オブジェクトをデータベースにマッピングするのは退屈で時間の無駄であるばかりか,複雑になったりエラーがでたりしやすい
  • データベースを捨てて,ドメインモデルオブジェクトをデーターベースとして使用することにしましょう
  • オブジェクトをファイルシステムのような永続領域にシリアライズしたり,デシリアライズして永続領域からオブジェクトを取り出せるようにしましょう
  • もしドメインモデルオブジェクトの完全な集合を永続領域の保存したいなら,スナップショットを作りましょう
  • クエリーとしてプログラム言語のデータ構造操作機能を使います.RAM 内のデータに対しては非常に高速ですから.
  • データとトランザクションを実行する関数を結びつけたトランザクションオブジェクトを使ったオブジェクトモデルを理解してください
  • ACID 属性を確保するために,それぞれのトランザクションを実行した後に,シリアライズして永続化します.これを **トランザクションログ** と呼びます.
  • 意図したか意図していないかに関わらず,システムがシャットダウンした時には,最初に最新のスナップショットをロードし,それぞれのトランザクションログを再実行してリストアします
  • トランザクションは決定的で,かつ,リエントラントでなければなりません (そして,必要ならば時刻を記録しておく必要があります)
  • マルチスレッドシステムでは,トランザクションはグローバルにシリアライズされます

これで Object Prevalence のコンセプトはすべてです.利点と制限事項の詳細は以下の通りです.

  • 最近のコンピュータの実装は優れているため,一秒間に数千トランザクションを実施し,また同じ速度でそれをリカバリーできます
  • トランザクションはシステムをブロックするため,短時間で完了しなければなりません - 全てが RAM 上にある間は対した問題ではありません
  • 完全に一貫したシテム状態を必要とするクエリーは,システムをブロックしなければなりません - さほどクリティカルでないクエリーは並列に実行できます
  • 実用上,トランザクションを実行する時にはまずシステムの状態をチェックし,必要ならエラーを返す必要があります.全てが一貫している時にのみシステムに変更を加えるようにします.トランザクション中は単独のスレッドのみがアクティブにならなければなりません.クエリーは可能なかぎり高速にデータを取得できます.この実装ではトランザクションは実行が成功した後に記録されます.
  • この実装ではトランザクション中に予期しないエラーに遭遇した場合に,(システムをリストアする事による)ロールバックが選択できます.トランザクション中でエラーが発生した場合に false を返す( もしくは no-rollback-error や,それを継承する事により)ロールバックするかどうかの条件を指定する事ができます.
  • 長時間に渡るトランザクションは問題となります
  • マスタとなるトランザクションログをレプリカに送ることにより,簡単にレプリケーションやクエリーのロードバランシングが可能です.また,バックアップやフェイルオーバーも実現できます.しかし,この実装はレプリケーションをまだ含んでいません.

CL-PREVALENCE のコードは Sven Van Caekenberghe によって書かれました.

日本語コンテンツ

CL-PREVALENCE サンプルコード

(defparameter *prevalence-directory* (merge-pathnames #p"./Local Settings/Temp/" (user-homedir-pathname)))
(defclass <Entry> ()
  ((id :initarg :id)
   (name :initarg :name)
   (link :initarg :link)))
(defun test-1 ()
  (let* ((system (cl-prevalence:make-prevalence-system *prevalence-directory*)))
    (setf (cl-prevalence:get-root-object system :entries) (make-hash-table :test #'equal))
    (let ((entries (cl-prevalence:get-root-object system :entries)))
      (dotimes (i 100)
        (setf (gethash i entries) (make-instance '<Entry>
                                                 :id i
                                                 :name (format nil "16進数:0x~X" i)
                                                 :link (gethash (- i 1) entries)))))
    (cl-prevalence:snapshot system)))
(defun test-2 ()
  (let* ((system (cl-prevalence:make-prevalence-system *prevalence-directory*))
         (entries (cl-prevalence:get-root-object system :entries))
         (keys (loop for k being the hash-keys of entries collect k)))
    (dolist (k (sort keys #'<))
      (let ((v (gethash k entries)))
        (with-slots (id name link)
            v
          (format t "~&key: ~A => object: ~A (id:~A, name: ~A, link: ~A)~%" k v id name link))))))

test-1 関数でルートオブジェクトとしてハッシュを容易し,そのハッシュに 登録しておくだけで DBM ライクな使い方ができるようになります.しかも,文 字列以外のオブジェクトを簡単に登録できます.

LispWorks 4.4.6 for Windows での Object Prevalence のサンプルを作成してみます.

サンプルに最低限必要なライブラリをロードした lispworks.exe を用意してお きます.普段の環境はもっと使用するライブラリが多いため (use ...) が 増えていますが,興味のある方は LispWorks のページ を参照してください. 以下に Cl-Prevalence を使うのに最低限必要なライブラリだけをロードしたイ メージを作るためのファイルを示します.

make-lispworks-image.lisp

;; make-lispworks-image.lisp
;; 4.4.5 -> 4.4.6 へのパッチ
(load-all-patches)
;; HOME 以下にライブラリが配置されている場合 ~/lisp/lib/base, ~/lisp/lib/common
(defparameter *default-package-root* (list (enviroment-variable "HOME")))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (let ((root (find-if #'probe-file *default-package-root*)))
    (compile-file (merge-pathnames "lib/base/asdf/asdf" root))
    (load (merge-pathnames "lib/base/asdf/asdf" root))))
(defmacro use (&key path abs-path name type)
  (let* ((root (find-if #'probe-file *default-package-root*))
   (path (if path (merge-pathnames path root) abs-path)))
    (case type
      (:path-expand        path)
      (:compile-and-load `(progn (compile-file ,path) (load ,path)))
      (:load-only        `(load ,path))
      (t                 `(progn (load ,path) (asdf:oos 'asdf:load-op ,name))))))

;; 必要なライブラリのロード
(use :path "lib/common/s-utils/s-utils.asd" :name :s-utils)
(use :path "lib/common/s-sysdeps/s-sysdeps.asd" :name :s-sysdeps)
(use :path "lib/common/s-xml/s-xml.asd" :name :s-xml)
(use :path "lib/common/cl-prevalence/cl-prevalence.asd" :name :cl-prevalence)

(save-image
 (merge-pathnames (make-pathname :name "lispworks-full") (lisp-image-name))
 ;; :restart-function #'mp:initialize-multiprocessing
 ;; :console t
 :remarks "LispWorks 4.4.6")
 
(quit)

上記のファイルを -init オプションで指定してイメージを作成します.

lispworks-4450.exe -init make-lispworks-image.lisp

これで,lispworks-full.exe という名前でライブラリをロード済の環境が用意 できました.

prevalence-demo.lisp

(defpackage :prevalence-demo (:use :cl :capi :cl-prevalence)
  (:shadow cl-prevalence::destroy))
(in-package :prevalence-demo)

(defvar *prevalence-directory* nil)
(defvar *system* nil)
(defvar *entries* nil)

(defclass <Entry> ()
  ((id     :initarg :id)
   (name   :initarg :name)
   (random :initarg :random)
   (prev   :initarg :prev)
   (next   :initarg :next)))


(defun create-entries (interface)
  (flet ((gen-id (n)
           (format nil "Object ID: ~4,'0D" n)))
    (setf (cl-prevalence:get-root-object *system* :entries) (make-hash-table :test #'equal))
    (setf *entries* (cl-prevalence:get-root-object *system* :entries))
    (dotimes (i 1000)
      (let ((id (gen-id i)))
        (setf (gethash id *entries*) (make-instance '<Entry>
                                                    :id     id
                                                    :name   (format nil "16進数:0x~4,'0X" i)
                                                    :random (random 100000)
                                                    :prev   (gen-id (1- i))
                                                    :next   (gen-id (1+ i))))))
    (setf (capi:collection-items (slot-value interface 'Object-List)) (list-object-id))))

(defun list-object-id (&aux lst)
  (if (or (null *entries*) (= (hash-table-count *entries*) 0))
      '("NO ITEM")
    (progn
      (setf lst (loop for k being the hash-keys of *entries* collect k))
      (sort lst #'string<)
      lst)))

(defun object-selection-callback (id interface)
  (let ((pane (slot-value interface 'object-viewer))
        (obj  (and *entries* (gethash id *entries*))))
    ;; (capi:display-message (format nil "~S" (capi:collection-items pane)))
    (setf (capi:collection-items pane)
          (if (null obj)
              ()
            (let ((slots (mapcar #'hcl:slot-definition-name (hcl:class-slots (class-of obj)))))
              (flet ((slot->multicolum (slot)
                       (list slot (slot-value obj slot))))
                (mapcar #'slot->multicolum slots)))))))

(defun operation-dispatch (button interface)
  (cond ((string= button "Create")
         (create-entries interface)
         (capi:display-message "Create Objects"))
        ((string= button "Snapshot")
         (cl-prevalence:snapshot *system*)
         (capi:display-message "Snapshot Objects"))
        (t
         (when *entries*
           (loop for k being the hash-keys of *entries*
                 do (remhash k *entries*))
           (setf (capi:collection-items (slot-value interface 'object-list)) (list-object-id)
                 (capi:collection-items (slot-value interface 'object-viewer)) '(("         " "         "))))
                  (capi:display-message "Destroy All Objects"))))

(capi:define-interface object-prevalence-demo ()
  ()
  (:panes
   (object-list
    capi:list-panel
    :items '("NO ITEM")
    :selection-callback #'object-selection-callback
    :selection 0)
   (object-viewer
    capi:multi-column-list-panel
    :columns '((:title "SLOT NAME") (:title "SLOT VALUE"))
    :items '(("          " "           "))
    :selection 0)
   (operation-panel
    capi:push-button-panel
    :items '("Create" "Snapshot" "Destroy")
    :selection-callback #'operation-dispatch
    :max-height t
    :max-width t))
  (:layouts
   (basic-layout
    capi:column-layout
    '(object-list object-viewer operation-panel)))
  (:default-initargs
   :best-height 300
   :best-width 307
   :layout 'basic-layout
   :title "Object Prevalence Demo"))

(defun main ()
  (setf *prevalence-directory* #p"./"
        *system* (cl-prevalence:make-prevalence-system *prevalence-directory*)
        *entries* (cl-prevalence:get-root-object *system* :entries))
  (let ((interface (make-instance 'object-prevalence-demo)))
    (when *entries*
      (setf (capi:collection-items (slot-value interface 'object-list)) (list-object-id)))
    (capi:contain interface)))

(執筆中)

posted: 2006/04/26 03:02 | permanent link to this entry | Tags: LISP

(top)  (memo)  (rss)