LISPUSER

CL-PREVALENCE 概要 (翻訳)

CL-PREVALENCE とは Sven Van Caekenberghe 氏による ObjectPrevalence _ の Common Lisp 実装です． CL-PREVALENCE は S-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 ¹⁹⁸⁷ ) で説明されています． 基本的なアイデアは以下のようなものです．

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

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

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

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

日本語コンテンツ

(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 "１６進数：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))))))

;; 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")
 

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

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 "１６進数：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)))

(執筆中)