- elephant-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[elephant-cvs] CVS elephant/src/elephant
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv22948/src/elephant Modified Files: classindex.lisp Log Message: Fix for a problem during migration of persistent classes from one store to another. 0.6.0 is clean for BDB/Allegro on Mac OS X --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/04/26 17:53:44 1.9 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/04/26 19:19:12 1.10 @@ -425,7 +425,7 @@ (defun drop-instances (instances &key (sc *store-controller*)) (when instances - (assert (consp instances)) + (assert (and (consp instances) (< (length instances) 500))) (with-transaction (:store-controller sc) (mapc (lambda (instance) (remove-kv (oid instance) (find-class-index (class-of instance)))

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv12311/tests Modified Files: testindexing.lisp testmigration.lisp Log Message: Significant additions to the 0.6.0 release on the trunk. Updates to documentation, 0.5.0 compliance, final on 0.6.0 features. There are one or two BDB interactions on migration to work out but this should be a nearly code complete 0.6.0 release. Please start testing and evaluating this - especially the ability to open and tag 0.5.0 databases. Features: - Database version tagging - Support for 0.5.0 namespaces & databases - New migration system - class indexing without slot indexing - various bug fixes - reverted fast allegro/sbcl string support to allow 0.5.0 databases to work correctly. I couldn't find a good way to work around this without creating infinite headaches - validated that running db_deadlock will stop all lisp freezes that I've encountered. This has to be run each time a DB environment is opened/created so eventually should be made part of the open-controller functionality for the BDB backend --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/03/01 18:57:34 1.15 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/04/26 17:53:45 1.16 @@ -209,7 +209,8 @@ (values (eq (length r1) 1) (signals-error (get-instances-by-value 'idx-five-del 'slot1 1)) - (null (get-value 'idx-five-del (elephant::controller-class-root *store-controller*)))))) + (null (get-index (get-value 'idx-five-del (elephant::controller-class-root *store-controller*)) + 'slot1))))) t t t) (deftest indexing-reconnect-db @@ -368,24 +369,24 @@ ;; create 500 objects, write each object's slots +(defvar normal-index nil) + (defclass stress-normal () ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index nil) (stress2 :accessor stress2 :initarg :stress2 :initform nil :index nil)) (:metaclass persistent-metaclass)) +(defun normal-stress-setup (count class-name &rest inst-args) + (setf normal-index (make-btree)) + (dotimes (i count) + (setf (get-value i normal-index) (apply #'make-instance class-name :stress1 i inst-args)))) + (defclass stress-index () ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index t) (stress2 :accessor stress2 :initarg :stress2 :initform 2 :index t) (stress3 :accessor stress3 :initarg :stress3 :initform 3 :index nil)) (:metaclass persistent-metaclass)) -(defvar normal-index nil) - -(defun normal-stress-setup (count class-name &rest inst-args) - (setf normal-index (make-btree)) - (dotimes (i count) - (setf (get-value i normal-index) (apply #'make-instance class-name :stress1 i inst-args)))) - (defun indexed-stress-setup (count class-name &rest inst-args) (dotimes (i count) (apply #'make-instance class-name :stress1 i inst-args))) --- /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/03/07 14:12:22 1.11 +++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/04/26 17:53:45 1.12 @@ -13,14 +13,6 @@ (in-package :ele-tests) -;; TEST TODO: -;; - inhibited slot copy & user overloading of migrate methodss -;; - proper use of clearing the tracking of copies -;; (oids not same over two copys of same object) -;; - whole repository migration (write comparison method to sanity check) -;; - transient slot migration is correct (online transfer of state to new repos) -;; - - (deftest remove-element (if (or (not (boundp '*test-spec-secondary*)) (null *test-spec-secondary*)) @@ -173,14 +165,15 @@ ;; (format t "Opening store~%") (let ((*auto-commit* nil) (sc2 (open-store *test-spec-secondary* :recover t)) - (sc1 (open-store *test-spec-primary* :recover t))) - (declare (special *auto-commit*)) + (sc1 (open-store *test-spec-primary* :recover t)) + (*store-controller* nil)) + (declare (special *auto-commit* *store-controller*)) (unwind-protect ;; ensure class index is initialized in sc1 (progn (setf (elephant::%index-cache (find-class 'ipfoo)) nil) (find-class-index 'ipfoo :sc sc1) -;; (format t "Making objects~%") + (format t "Making objects~%") (with-transaction (:store-controller sc2) (drop-instances (get-instances-by-class 'ipfoo) :sc sc2)) (with-transaction (:store-controller sc1) @@ -188,12 +181,12 @@ (make-instance 'ipfoo :slot1 1 :sc sc1) (make-instance 'ipfoo :slot1 10 :sc sc1) (make-instance 'ipfoo :slot1 20 :sc sc1)) -;; (format t "Migrating~%") + (format t "Migrating~%") (migrate sc2 sc1) ;; Make sure our ipfoo class now points at a cache in sc2! (assert (equal (elephant::controller-spec sc2) (:dbcn-spc-pst (elephant::%index-cache (find-class 'ipfoo))))) -;; (format t "Fetching~%") + (format t "Fetching~%") (let ((fm1 (get-instances-by-value 'ipfoo 'slot1 1)) (fm2 (get-instances-by-value 'ipfoo 'slot1 10)) (fm3 (get-instances-by-value 'ipfoo 'slot1 20))

1 0

[elephant-cvs] CVS elephant/src/memutil
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv12311/src/memutil Modified Files: memutil.lisp Log Message: Significant additions to the 0.6.0 release on the trunk. Updates to documentation, 0.5.0 compliance, final on 0.6.0 features. There are one or two BDB interactions on migration to work out but this should be a nearly code complete 0.6.0 release. Please start testing and evaluating this - especially the ability to open and tag 0.5.0 databases. Features: - Database version tagging - Support for 0.5.0 namespaces & databases - New migration system - class indexing without slot indexing - various bug fixes - reverted fast allegro/sbcl string support to allow 0.5.0 databases to work correctly. I couldn't find a good way to work around this without creating infinite headaches - validated that running db_deadlock will stop all lisp freezes that I've encountered. This has to be run each time a DB environment is opened/created so eventually should be made part of the open-controller functionality for the BDB backend --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/02/19 20:06:04 1.4 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/04/26 17:53:45 1.5 @@ -56,6 +56,10 @@ #:*c-library-extension* )) +;; --REMOVE HACK-- +(defpackage elephant + (:use :cl)) + (in-package "ELEPHANT-MEMUTIL") #+cmu @@ -323,11 +327,13 @@ #+(and allegro ics) ;; old: `(let ((l (length ,s))) (+ l l)) `(etypecase ,s - (base-string (length ,s)) + (base-string (excl:native-string-sizeof ,s :external-format :unicode)) + ;; fast 0.6.1 (length ,s) (string (excl:native-string-sizeof ,s :external-format :unicode))) #+(or (and sbcl sb-unicode) lispworks) `(etypecase ,s - (base-string (length ,s)) + (base-string (* (length ,s) #+sbcl 4 #+lispworks 2) ) + ;; (length ,s))) (string (* (length ,s) #+sbcl 4 #+lispworks 2))) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) `(length ,s)) @@ -570,10 +576,11 @@ (resize-buffer-stream bs needed)) ;; I wonder if the basic problem here is that we are using this ;; routine instead of something like "copy-ub8-from-system-area"? -;; #-allegro + #-allegro (copy-str-to-buf buf size s 0 str-bytes) -;; #+allegro -;; (excl:string-to-native s :address (offset-char-pointer buf size) :external-format :unicode) + #+allegro + (excl:string-to-native s :address (offset-char-pointer buf size) :external-format :unicode) + ;; v0.6.0 (copy-str-to-buf buf size s 0 str-bytes) (setf size needed) nil)))

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv12311/src/elephant Modified Files: classes.lisp classindex-utils.lisp classindex.lisp collections.lisp controller.lisp metaclasses.lisp migrate.lisp serializer.lisp transactions.lisp variables.lisp Added Files: package.lisp Removed Files: elephant.lisp Log Message: Significant additions to the 0.6.0 release on the trunk. Updates to documentation, 0.5.0 compliance, final on 0.6.0 features. There are one or two BDB interactions on migration to work out but this should be a nearly code complete 0.6.0 release. Please start testing and evaluating this - especially the ability to open and tag 0.5.0 databases. Features: - Database version tagging - Support for 0.5.0 namespaces & databases - New migration system - class indexing without slot indexing - various bug fixes - reverted fast allegro/sbcl string support to allow 0.5.0 databases to work correctly. I couldn't find a good way to work around this without creating infinite headaches - validated that running db_deadlock will stop all lisp freezes that I've encountered. This has to be run each time a DB environment is opened/created so eventually should be made part of the open-controller functionality for the BDB backend --- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2006/03/01 18:57:34 1.8 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2006/04/26 17:53:44 1.9 @@ -45,6 +45,28 @@ ;; METACLASS INITIALIZATION AND CHANGES ;; ================================================ +(defmethod ensure-class-using-class :around ((class (eql nil)) name &rest args &key index) + "Support the :index class option" + (let ((result (apply #'call-next-method class name (remove-index-keyword args)))) + (when (and index (subtypep (type-of result) 'persistent-metaclass)) + (update-indexed-record result nil :class-indexed t)) + result)) + +(defmethod ensure-class-using-class :around ((class persistent-metaclass) name &rest args &key index) + "Support the :index class option on redefinition" + (let ((result (apply #'call-next-method class name (remove-index-keyword args)))) + (when index + (update-indexed-record result nil :class-indexed t)) + result)) + +(defun remove-index-keyword (list) + (cond ((null list) + nil) + ((eq (car list) :index) + (cddr list)) + (t + (cons (car list) (remove-index-keyword (cdr list)))))) + (defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses) "Ensures we inherit from persistent-object." (let* ((persistent-metaclass (find-class 'persistent-metaclass)) @@ -58,14 +80,13 @@ (call-next-method)))) (defmethod finalize-inheritance :around ((instance persistent-metaclass)) - "Update the persistent slot records in the metaclass" + "Update the persistent slot records in the metaclass." (prog1 (call-next-method) (when (not (slot-boundp instance '%persistent-slots)) (setf (%persistent-slots instance) (cons (persistent-slot-names instance) nil))) - (when (not (slot-boundp instance '%indexed-slots)) - (update-indexed-record instance (indexed-slot-names-from-defs instance))))) + (update-indexed-record instance (indexed-slot-names-from-defs instance)))) (defmethod reinitialize-instance :around ((instance persistent-metaclass) &rest initargs &key &allow-other-keys) (declare (ignore initargs)) @@ -130,7 +151,6 @@ ;; situation where we write the class or index page that we are currently reading ;; via a cursor without going through the cursor abstraction. There has to be a ;; better way to do this. - (when (and (indexed class) (not from-oid)) (let ((class-index (find-class-index class))) (when class-index --- /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp 2006/03/01 18:57:34 1.2 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp 2006/04/26 17:53:44 1.3 @@ -1,4 +1,14 @@ - +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;; +;;; classindex-untils.lisp -- support for classindex.lisp and +;;; class re-definition synchronization +;;; +;;; Initial version 1/24/2006 Ian Eslick +;;; eslick at alum mit edu +;;; +;;; License: Lisp Limited General Public License +;;; http://www.franz.com/preamble.html +;;; (in-package :elephant) @@ -46,7 +56,7 @@ ;; Differentiate derived indices from slot-based ones ;; -(defparameter *derived-index-marker* "%%derived%%-") +(defparameter *derived-index-marker* "%%DERIVED%%-") (defun make-derived-name (name) (intern (format nil "~A~A" *derived-index-marker* name))) @@ -58,7 +68,8 @@ *derived-index-marker*)) (defun get-derived-name-root (dname) - (when (symbolp dname) (symbol-name dname)) + (when (symbolp dname) + (setf dname (symbol-name dname))) (intern (subseq dname (length *derived-index-marker*)))) ;; @@ -116,6 +127,180 @@ (error (e) (warn "Error ~A computing derived index for on instance ~A" e instance) (values nil nil)))) + + +;; ============================= +;; CLASS / DB SYNCHRONIZATION +;; ============================= + +;; TO READER: I got really tired of trying to figure out all +;; the messy conditionals and I figure default behaviors are something +;; others might want to modify, so here's what determines the rule +;; behavior.. +;; +;; Rules match on the following states of the metaclass and current +;; database class-index for each slotname currently in either of +;; those sources. Actions are taken, typically when a slot exists +;; in one but not the other or features like indexed/persistent +;; differ between the slots +;; +;; class state: +;; class-indexed - the slot is marked as indexed +;; class-persistent - the slot is marked as persistent (not indexed) +;; class-transient - the slot is marked transient +;; class-derived - the slot is in the derived list of the class +;; +;; database +;; db-slot - the database has a slot index +;; db-derived - the database has a derived index +;; +;; The inversions of any of these terms are also available as +;; (not indexed-slot) for example, to cover more than one feature +;; combination +;; +;; Each rule should apply uniquely to a given feature set. +;; +;; Actions taken when rules match can include: +;; +;; add-slot-index - add a new index with the slotname to the db +;; remove-slot-index - remove a slot with the slotname from the db +;; add-derived-index - xxx this makes no sense! xxx +;; remove-derived-index - remove a derived index from the db +;; unregister-indexed-slot - remove an indexed slot from the class metaobject +;; unregister-derived - remove a derived index from the class metaobject +;; register-indexed-slot - register a slot with the class metaobject +;; register-derived-index - register a derived index with the class metaobject +;; + +;; DEFINE THE SYNCHRONIZATION RULES +(eval-when (:compile-toplevel :load-toplevel) + + (defclass synch-rule () + ((lhs :accessor synch-rule-lhs :initarg :lhs :initform nil) + (rhs :accessor synch-rule-rhs :initarg :rhs :initform nil))) + + (defun make-synch-rule (rule-spec) + (let ((lhs (subseq rule-spec 0 (position '=> rule-spec))) + (rhs (subseq rule-spec (1+ (position '=> rule-spec))))) + (make-instance 'synch-rule :lhs lhs :rhs rhs))) + + (defparameter *synchronize-rules* + (mapcar #'(lambda (rule-specs) + (cons (car rule-specs) + (mapcar #'make-synch-rule (cdr rule-specs)))) + '((:class ;; class changes db + ((not db-slot) class-indexed => add-slot-index) + (db-slot (not class-indexed) => remove-slot-index) + (db-derived (not class-indexed) (not class-persistent) + (not class-transient) => register-derived-index)) + (:union ;; merge both sides + (db-slot (not class-indexed) => register-indexed-slot) + ((not db-slot) class-indexed => add-slot-index) + (db-derived (not class-derived) => register-derived-index) + (db-derived class-persistent => remove-derived-index warn)) + ;; NOTE: What about cases where we need to remove things as below? + (:db ;; db changes class + ((not db-slot) class-indexed => unregister-indexed-slot) + ((not db-derived) class-derived => unregister-derived-index) + (db-slot class-persistent => register-indexed-slot) + (db-slot class-transient => remove-indexed-slot) + (db-derived class-transient => remove-derived-index warn) + (db-derived class-persistent => remove-derived-index warn) + (db-derived class-indexed => remove-derived-index warn) + (db-derived (not class-derived) (not class-indexed) + (not class-persistent) (not class-transient) + => register-derived-index))))) + ) + +;; TOP LEVEL METHOD + +(defun synchronize-class-to-store (class &key (sc *store-controller*) + (method *default-indexed-class-synch-policy*)) + (let ((slot-records (compute-class-and-ele-status class sc)) + (rule-set (cdr (assoc method *synchronize-rules*)))) + (apply-synch-rules class slot-records rule-set))) + +;; COMPUTING RULE APPLICABILITY AND FIRING + +(defun synch-rule-applicable? (rule features) + (simple-match-set (synch-rule-lhs rule) features)) + +(defun simple-match-set (a b) + (declare (optimize (speed 3) (safety 1))) + (cond ((null a) t) + ((and (not (null a)) (null b)) nil) + ((member (first a) b :test #'equal) + (simple-match-set (cdr a) (remove (first a) b :test #'equal))) + (t nil))) + +(defparameter *print-synch-messages* nil) + +(defun apply-synch-rule (rule class name) + (when *print-synch-messages* + (format t "Class/DB Synch: converting state ~A using ~A for ~A~%" + (synch-rule-lhs rule) (synch-rule-rhs rule) name)) + (loop for action in (synch-rule-rhs rule) do + (case action + (add-slot-index (add-class-slot-index class name :update-class nil)) + (remove-slot-index (remove-class-slot-index class name :update-class nil)) + (add-derived-index (add-class-derived-index class name :update-class nil)) + (remove-derived-index (remove-class-derived-index class name :update-class nil)) + (unregister-indexed-slot (unregister-indexed-slot class name)) + (unregister-derived-index (unregister-derived-index class name)) + (register-indexed-slot (register-indexed-slot class name)) + (register-derived-index (register-derived-index class name)) + (warn (warn "Performing slot synchronization actions: ~A" (synch-rule-rhs rule)))))) + +(defun apply-synch-rules (class records rule-set) + (declare (optimize (speed 3) (safety 1))) + (labels ((slotname (rec) (car rec)) + (feature-set (rec) (cdr rec))) + (loop for record in records do + (loop for rule in rule-set + when (synch-rule-applicable? rule (feature-set record)) + do + (apply-synch-rule rule class (slotname record)))))) + +;; COMPUTE CURRENT STATE OF CLASS OBJECT AND DATABASE AFTER CHANGES + +(defun compute-class-and-ele-status (class &optional (store-controller *store-controller*)) + (let* ((*store-controller* store-controller) + ;; db info + (db-indices (find-inverted-index-names class)) + (db-derived (mapcar #'get-derived-name-root + (remove-if-not #'derived-name? db-indices))) + (db-slot (set-difference db-indices db-derived)) + ;; class info + (marked-slots (indexing-record-slots (indexed-record class))) + (marked-derived (indexing-record-derived (indexed-record class))) + (persistent-slots (set-difference (persistent-slots class) marked-slots)) + (other-slots (set-difference + (set-difference (class-slots class) persistent-slots) + marked-slots)) + (all-names (union (mapcar #'slot-definition-name (class-slots class)) db-indices)) + ;; [order matters in traversal] + (all-sets `((class-indexed . ,marked-slots) + (class-derived . ,marked-derived) + (class-persistent . ,persistent-slots) + (class-transient . ,other-slots) + (db-slot . ,db-slot) + (db-derived . ,db-derived)))) + (labels ((compute-features (slotname) + (let ((features nil)) + (loop for set in all-sets do + (push (compute-feature slotname (cdr set) (car set)) + features)) + (cons slotname features))) + (compute-feature (name set label) + (if (member name set) + label + `(not ,label)))) + (mapcar #'compute-features all-names)))) + +;; ================================== +;; TOOLS +;; ================================== + ;; ;; This has turned out to be useful for debugging @@ -139,10 +324,10 @@ (disable-class-indexing name) (flush-instance-cache *store-controller*) (setf (find-class name) nil))) - - + + ;; Rob created this just for some debugging. -;; It seesm theoretically possible that we could make +;; It seems theoretically possible that we could make ;; a function that fully checks the consinstency of the index; ;; that is, that the indexed classes indeed exist in the store. (defun dump-class-index (c) @@ -150,7 +335,8 @@ (dump-btree idx) ) -) + ) + (defun report-indexed-classes (&key (class nil) (sc *store-controller*)) (format t "indexed-classes:~%") (let ((bt (controller-class-root sc))) --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/03/27 20:36:27 1.8 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/04/26 17:53:44 1.9 @@ -1,7 +1,7 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; classindex.lisp -- use btree collections to track objects by slot values -;;; via metaclass options or accessor :after methods +;;; via metaclass options or accessor :after methods ;;; ;;; Initial version 1/24/2006 Ian Eslick ;;; eslick at alum mit edu @@ -98,7 +98,7 @@ (defmethod find-class-index ((class-name symbol) &key (sc *store-controller*) (errorp t)) (find-class-index (find-class class-name) :sc sc :errorp errorp)) -(defmethod class-indexedp-by-name ((class-name symbol) &key (sc *store-controller*) (errorp t)) +(defmethod class-indexedp-by-name ((class-name symbol) &key (sc *store-controller*)) (get-value class-name (controller-class-root sc))) (defmethod find-class-index ((class persistent-metaclass) &key (sc *store-controller*) (errorp t)) @@ -145,9 +145,8 @@ (defmethod find-inverted-index ((class persistent-metaclass) slot &key (null-on-fail nil)) (let* ((cidx (find-class-index class)) - (dslot (make-derived-name slot)) (idx (or (get-index cidx slot) - (get-index cidx dslot)))) + (get-index cidx (make-derived-name slot))))) (if idx idx (if null-on-fail @@ -166,26 +165,27 @@ (defmethod close-controller :before ((sc store-controller)) "Ensure the classes don't have stale references to closed stores!" (when (controller-class-root sc) - (map-btree (lambda (class-name index) - (declare (ignore index)) - (let ((class (find-class class-name nil))) - (when class - (setf (%index-cache class) nil)))) - (controller-class-root sc)))) + (with-transaction (:store-controller sc :txn-sync t :retries 2) + (map-btree (lambda (class-name index) + (declare (ignore index)) + (let ((class (find-class class-name nil))) + (when class + (setf (%index-cache class) nil)))) + (controller-class-root sc))))) + ;; ============================= ;; INDEXING INTERFACE ;; ============================= (defmethod enable-class-indexing ((class persistent-metaclass) indexed-slot-names &key (sc *store-controller*)) - (assert (not (= 0 (length indexed-slot-names)))) (let ((croot (controller-class-root sc))) (multiple-value-bind (btree found) (get-value (class-name class) croot) (declare (ignore btree)) (when found (error "Class is already enabled for indexing! Run disable class indexing to clean up."))) ;; Put class instance index into the class root & cache it in the class object - (update-indexed-record class indexed-slot-names) + (update-indexed-record class indexed-slot-names :class-indexed t) (with-transaction (:store-controller sc) (let ((class-idx (build-indexed-btree sc))) (setf (get-value (class-name class) croot) class-idx) @@ -283,7 +283,7 @@ (when update-class (register-derived-index class name)) (with-transaction (:store-controller sc) (add-index class-idx - :index-name name + :index-name (make-derived-name name) :key-form (make-derived-key-form derived-defun) :populate populate)))))) @@ -340,6 +340,7 @@ ;; ========================= (defgeneric get-instances-by-class (persistent-metaclass)) +(defgeneric get-instance-by-value (persistent-metaclass slot-name value)) (defgeneric get-instances-by-value (persistent-metaclass slot-name value)) (defgeneric get-instances-by-range (persistent-metaclass slot-name start end)) @@ -384,6 +385,16 @@ (push val instances) (return-from get-instances-by-value instances))))))))) +(defmethod get-instance-by-value ((class symbol) slot-name value) + (let ((list (get-instances-by-value (find-class class) slot-name value))) + (when (consp list) + (car list)))) + +(defmethod get-instance-by-value ((class persistent-metaclass) slot-name value) + (let ((list (get-instances-by-value class slot-name value))) + (when (consp list) + (car list)))) + (defmethod get-instances-by-range ((class symbol) slot-name start end) (get-instances-by-range (find-class class) slot-name start end)) @@ -417,174 +428,9 @@ (assert (consp instances)) (with-transaction (:store-controller sc) (mapc (lambda (instance) - (remove-kv (oid instance) (find-class-index (class-of instance)))) + (remove-kv (oid instance) (find-class-index (class-of instance))) + (drop-pobject instance)) instances)))) -;; ============================= -;; CLASS / DB SYNCHRONIZATION -;; ============================= - -;; TO READER: I got really tired of trying to figure out all -;; the messy conditionals and I figure default behaviors are something -;; others might want to modify, so here's what determines the rule -;; behavior. -;; -;; Rules match on the following states of the metaclass and current -;; database class-index for each slotname currently in either of -;; those sources. Actions are taken, typically when a slot exists -;; in one but not the other or features like indexed/persistent -;; differ between the slots -;; -;; class state: -;; class-indexed - the slot is marked as indexed -;; class-persistent - the slot is marked as persistent (not indexed) -;; class-transient - the slot is marked transient -;; class-derived - the slot is in the derived list of the class -;; -;; database -;; db-slot - the database has a slot index -;; db-derived - the database has a derived index -;; -;; The inversions of any of these terms are also available as -;; (not indexed-slot) for example, to cover more than one feature -;; combination -;; -;; Each rule should apply uniquely to a given feature set. -;; -;; Actions taken when rules match can include: -;; -;; add-slot-index - add a new index with the slotname to the db -;; remove-slot-index - remove a slot with the slotname from the db -;; add-derived-index - xxx this makes no sense! xxx -;; remove-derived-index - remove a derived index from the db -;; unregister-indexed-slot - remove an indexed slot from the class metaobject -;; unregister-derived - remove a derived index from the class metaobject -;; register-indexed-slot - register a slot with the class metaobject -;; register-derived-index - register a derived index with the class metaobject -;; - -;; DEFINE THE SYNCHRONIZATION RULES -(eval-when (:compile-toplevel :load-toplevel) - - (defclass synch-rule () - ((lhs :accessor synch-rule-lhs :initarg :lhs :initform nil) - (rhs :accessor synch-rule-rhs :initarg :rhs :initform nil))) - - (defun make-synch-rule (rule-spec) - (let ((lhs (subseq rule-spec 0 (position '=> rule-spec))) - (rhs (subseq rule-spec (1+ (position '=> rule-spec))))) - (make-instance 'synch-rule :lhs lhs :rhs rhs))) - - (defparameter *synchronize-rules* - (mapcar #'(lambda (rule-specs) - (cons (car rule-specs) - (mapcar #'make-synch-rule (cdr rule-specs)))) - '((:class ;; class changes db - ((not db-slot) class-indexed => add-slot-index) - (db-slot (not class-indexed) => remove-slot-index) - (db-derived (not class-derived) => remove-derived-index)) - (:union ;; merge both sides - (db-slot (not class-indexed) => register-indexed-slot) - ((not db-slot) class-indexed => add-slot-index) - (db-derived (not class-derived) => register-derived-index) - (db-derived class-persistent => remove-derived-index warn)) - ;; NOTE: What about cases where we need to remove things as below? - (:db ;; db changes class - ((not db-slot) class-indexed => unregister-indexed-slot) - ((not db-derived) class-derived => unregister-derived-index) - (db-slot class-persistent => register-indexed-slot) - (db-slot class-transient => remove-indexed-slot) - (db-derived class-transient => remove-derived-index warn) - (db-derived class-persistent => remove-derived-index warn) - (db-derived class-indexed => remove-derived-index warn) - (db-derived (not class-derived) (not class-indexed) - (not class-persistent) (not class-transient) => - register-derived-slot))))) - ) - -;; TOP LEVEL METHOD - -(defun synchronize-class-to-store (class &key (sc *store-controller*) - (method *default-indexed-class-synch-policy*)) - (let ((slot-records (compute-class-and-ele-status class sc)) - (rule-set (cdr (assoc method *synchronize-rules*)))) - (apply-synch-rules class slot-records rule-set))) - -;; COMPUTING RULE APPLICABILITY AND FIRING - -(defun synch-rule-applicable? (rule features) - (simple-match-set (synch-rule-lhs rule) features)) - -(defun simple-match-set (a b) - (declare (optimize (speed 3) (safety 1))) - (cond ((null a) t) - ((and (not (null a)) (null b)) nil) - ((member (first a) b :test #'equal) - (simple-match-set (cdr a) (remove (first a) b :test #'equal))) - (t nil))) - -(defparameter *print-synch-messages* nil) - -(defun apply-synch-rule (rule class name) - (when *print-synch-messages* - (format t "Class/DB Synch: converting state ~A using ~A for ~A~%" - (synch-rule-lhs rule) (synch-rule-rhs rule) name)) - (loop for action in (synch-rule-rhs rule) do - (case action - (add-slot-index (add-class-slot-index class name :update-class nil)) - (remove-slot-index (remove-class-slot-index class name :update-class nil)) - (add-derived-index (add-class-derived-index class name :update-class nil)) - (remove-derived-index (remove-class-derived-index class name :update-class nil)) - (unregister-indexed-slot (unregister-indexed-slot class name)) - (unregister-derived-index (unregister-derived-index class name)) - (register-indexed-slot (register-indexed-slot class name)) - (register-derived-index (register-derived-index class name)) - (warn (warn "Performing slot synchronization actions: ~A" (synch-rule-rhs rule)))))) - -(defun apply-synch-rules (class records rule-set) - (declare (optimize (speed 3) (safety 1))) - (labels ((slotname (rec) (car rec)) - (feature-set (rec) (cdr rec))) - (loop for record in records do - (loop for rule in rule-set - when (synch-rule-applicable? rule (feature-set record)) - do - (apply-synch-rule rule class (slotname record)))))) - -;; COMPUTE CURRENT STATE OF CLASS OBJECT AND DATABASE AFTER CHANGES - -(defun compute-class-and-ele-status (class &optional (store-controller *store-controller*)) - (let* ((*store-controller* store-controller) - ;; db info - (db-indices (find-inverted-index-names class)) - (db-derived (mapcar #'get-derived-name-root - (remove-if-not #'derived-name? db-indices))) - (db-slot (set-difference db-indices db-derived)) - ;; class info - (marked-slots (indexing-record-slots (indexed-record class))) - (marked-derived (indexing-record-derived (indexed-record class))) - (persistent-slots (set-difference (persistent-slots class) marked-slots)) - (other-slots (set-difference - (set-difference (class-slots class) persistent-slots) - marked-slots)) - (all-names (union (mapcar #'slot-definition-name (class-slots class)) db-indices)) - ;; [order matters in traversal] - (all-sets `((class-indexed . ,marked-slots) - (class-derived . ,marked-derived) - (class-persistent . ,persistent-slots) - (class-transient . ,other-slots) - (db-slot . ,db-slot) - (db-derived . ,db-derived)))) - (labels ((compute-features (slotname) - (let ((features nil)) - (loop for set in all-sets do - (push (compute-feature slotname (cdr set) (car set)) - features)) - (cons slotname features))) - (compute-feature (name set label) - (if (member name set) - label - `(not ,label)))) - (mapcar #'compute-features all-names)))) --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2006/02/20 21:21:42 1.3 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2006/04/26 17:53:44 1.4 @@ -332,6 +332,17 @@ (unless more (return nil)) (funcall fn k v))))) +(defmethod empty-btree-p ((btree btree)) + (with-transaction (:store-controller (get-con btree)) + (with-btree-cursor (cur btree) + (multiple-value-bind (valid k) (cursor-next cur) + (cond ((not valid) ;; truly empty + t) + ((eq k *elephant-properties-label*) ;; has properties + (not (cursor-next cur))) + (t nil)))))) + + (defun dump-btree (bt) (format t "DUMP ~A~%" bt) (map-btree #'(lambda (k v) (format t "k ~A / v ~A~%" k v)) bt) --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/03/27 20:36:28 1.8 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/04/26 17:53:44 1.9 @@ -117,8 +117,9 @@ "Conveniently open a store controller." (assert (consp spec)) (setq *store-controller* (get-controller spec)) - (open-controller *store-controller* :recover recover - :recover-fatal recover-fatal :thread thread)) + (ensure-marked-version + (open-controller *store-controller* :recover recover + :recover-fatal recover-fatal :thread thread))) (defun close-store (&optional sc) "Conveniently close the store controller." @@ -131,12 +132,12 @@ (defmacro with-open-store ((spec) &body body) "Executes the body with an open controller, unconditionally closing the controller on exit." - `(let ((*store-controller* (get-controller ,spec))) + `(let ((*store-controller* nil)) (declare (special *store-controller*)) - (open-controller *store-controller*) + (open-store spec) (unwind-protect (progn ,@body) - (close-controller *store-controller*)))) + (close-store *store-controller*)))) ;; ;; COMMON STORE CONTROLLER FUNCTIONALITY @@ -163,6 +164,96 @@ (for garbage collection,) et cetera.")) ;; +;; VERSIONING AND UPGRADES +;; + +;; Need to tag databases +;; Need to handle untagged db's +;; Need to provide upgrade hooks + +(defvar *restricted-properties* '(:version) + "Properties that are not user manipulable") + +(defmethod controller-properties ((sc store-controller)) + (get-from-root *elephant-properties-label* :store-controller sc)) + +(defmethod set-ele-property (property value &key (sc *store-controller*)) + (assert (and (symbolp property) (not (member property *restricted-properties*)))) + (let ((props (get-from-root *elephant-properties-label* :store-controller sc))) + (setf (get-value *elephant-properties-label* (controller-root sc)) + (if (assoc property props) + (progn (setf (cdr (assoc property props)) value) + props) + (acons property value props))))) + +(defmethod get-ele-property (property &key (sc *store-controller*)) + (assert (symbolp property)) + (let ((entry (assoc property + (get-from-root *elephant-properties-label* + :store-controller sc)))) + (when entry + (cdr entry)))) + +(defmethod ensure-marked-version ((sc store-controller)) + "Not sure this test is right (empty root)" + (let ((props (controller-properties sc)) + (empty? (and (empty-btree-p (controller-root sc)) + (empty-btree-p (controller-class-root sc))))) + ;; marked - continue + (unless (assoc :version props) + (if empty? + ;; empty so new database - mark with current code version + (setf (get-value *elephant-properties-label* (controller-root sc)) + (acons :version *elephant-code-version* props)) + ;; has stuff in it but not marked - mark as prior + (setf (get-value *elephant-properties-label* (controller-root sc)) + (acons :version *elephant-unmarked-code-version* props))))) + sc) + +(defmethod controller-version ((sc store-controller)) + (let ((alist (controller-properties sc))) + (let ((result (assoc :version alist))) + (if result + (cdr result) + nil)))) + +(defmethod up-to-date-p ((sc store-controller)) + (equal (controller-version sc) *elephant-code-version*)) + +(defparameter *elephant-upgrade-table* + '( ((0 6 0) (0 5 0)) + )) + +(defun prior-version-p (v1 v2) + "Is v1 an equal or earlier version than v2" + (cond ((and (null v1) (null v2)) t) + ((and (null v1) (not (null v2))) t) + ((and (not (null v1)) (null v2)) nil) + ((< (car v1) (car v2)) t) + ((> (car v1) (car v2)) nil) + ((= (car v1) (car v2)) + (prior-version-p (cdr v1) (cdr v2))) + (t (error "Version problem!")))) + +(defmethod upgradable-p ((sc store-controller)) + "Determine if this store can be brought up to date using the upgrade function" + (unwind-protect + (let ((row (assoc *elephant-code-version* *elephant-upgrade-table* :test #'equal)) + (ver (controller-version sc))) + (when (member ver (rest row) :test #'equal)) t) + nil)) + +(defmethod upgrade ((sc store-controller)) + (unless (upgradable-p sc) + (error "Cannot upgrade ~A from version ~A to version ~A~%Valid upgrades are:~%~A" + (controller-spec sc) + (controller-version sc) + *elephant-code-version* + *elephant-upgrade-table*)) + (warn "Upgrade by migrating your old repository to a clean repository created using the current code base. i.e. (migrate new old)")) + + +;; ;; OBJECT CACHE ;; @@ -178,7 +269,7 @@ (let ((obj (get-cache oid (instance-cache sc)))) (if obj obj ;; Should get cached since make-instance calls cache-instance - (make-instance (handle-legacy-classes class-name) + (make-instance (handle-legacy-classes class-name nil) :from-oid oid :sc sc)))) (defmethod flush-instance-cache ((sc store-controller)) @@ -188,7 +279,13 @@ (setf (instance-cache sc) (make-cache-table :test 'eql))) -(defun handle-legacy-classes (name) +(defparameter *legacy-conversions-db* + '((("elephant" . "bdb-btree") . ("sleepycat" . "bdb-btree")) + (("elephant" . "bdb-indexed-btree") . ("sleepycat" . "bdb-indexed-btree")) + (("elephant" . "bdb-btree-index") . ("sleepycat" . "bdb-btree-index")))) + +(defun handle-legacy-classes (name version) + (declare (ignore version)) (let ((entry (assoc (symbol->string-pair name) *legacy-conversions-db* :test #'equal))) (if entry (string-pair->symbol (cdr entry)) @@ -201,10 +298,6 @@ (defun string-pair->symbol (name) (intern (string-upcase (cdr name)) (car name))) -(defparameter *legacy-conversions-db* - '((("elephant" . "bdb-btree") . ("sleepycat" . "bdb-btree")) - (("elephant" . "bdb-indexed-btree") . ("sleepycat" . "bdb-indexed-btree")) - (("elephant" . "bdb-btree-index") . ("sleepycat" . "bdb-btree-index")))) ;; ;; STORE CONTROLLER PROTOCOL @@ -264,6 +357,7 @@ retrieve it in a later session. N.B. this means it (and everything it points to) won't get gc'd." (declare (type store-controller store-controller)) + (assert (not (eq key *elephant-properties-label*))) (setf (get-value key (controller-root store-controller)) value)) (defun get-from-root (key &key (store-controller *store-controller*)) @@ -293,12 +387,9 @@ (defmethod drop-pobject ((inst persistent-object)) "Reclaim persistent object storage by unbinding slot values. - This also drops references to the instance from any index - it partipates in. This does not delete the cached object - instance or any serialized references still in the db. + This does not delete the cached object instance or any + serialized references still in the db. Need a migration or GC for that!" - (when (indexed (class-of inst)) - (drop-instances (list inst))) (let ((pslots (persistent-slots (class-of inst)))) (dolist (slot pslots) (slot-makunbound inst slot)))) --- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2006/02/25 22:05:08 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2006/04/26 17:53:44 1.7 @@ -40,16 +40,16 @@ ;; Top level defclass form - hide metaclass option ;; -(defmacro defpclass (cname parents slot-defs &optional class-opts) +(defmacro defpclass (cname parents slot-defs &rest class-opts) `(defclass ,cname ,parents ,slot-defs - ,(add-persistent-metaclass-argument class-opts))) + ,@(add-persistent-metaclass-argument class-opts))) (defun add-persistent-metaclass-argument (class-opts) (when (assoc :metaclass class-opts) (error "User metaclass specification not allowed in defpclass")) - (append (list :metaclass 'persistent-metaclass) class-opts)) - + (append class-opts (list (list :metaclass 'persistent-metaclass)))) + ;; ;; Persistent slot maintenance ;; @@ -105,7 +105,7 @@ ;; This just encapsulates record keeping a bit (defclass indexing-record () - ((class :accessor indexing-record-class :initarg :class :initform t) + ((class :accessor indexing-record-class :initarg :class :initform nil) (slots :accessor indexing-record-slots :initarg :slots :initform nil) (derived-count :accessor indexing-record-derived :initarg :derived :initform 0))) @@ -125,16 +125,21 @@ (when (slot-boundp class '%indexed-slots) (cdr (%indexed-slots class)))) -(defmethod update-indexed-record ((class persistent-metaclass) new-slot-list) +(defmethod update-indexed-record ((class persistent-metaclass) new-slot-list &key class-indexed) (let ((oldrec (if (slot-boundp class '%indexed-slots) (indexed-record class) nil))) (setf (%indexed-slots class) - (cons (make-instance 'indexing-record - :slots new-slot-list - :derived (when oldrec (indexing-record-derived oldrec))) + (cons (make-new-indexed-record new-slot-list oldrec class-indexed) (if oldrec oldrec nil))))) +(defmethod make-new-indexed-record (new-slot-list oldrec class-indexed) + (make-instance 'indexing-record + :class (or class-indexed + (when oldrec (indexing-record-class oldrec))) + :slots new-slot-list + :derived (when oldrec (indexing-record-derived oldrec)))) + (defmethod removed-indexing? ((class persistent-metaclass)) (and (not (indexed class)) (previously-indexed class))) @@ -191,9 +196,10 @@ (setf (indexing-record-derived record) (remove name (indexing-record-derived record))))) (defmethod indexed ((class persistent-metaclass)) - (and (slot-boundp class '%indexed-slots ) + (and (slot-boundp class '%indexed-slots) (not (null (%indexed-slots class))) - (or (indexing-record-slots (indexed-record class)) + (or (indexing-record-class (indexed-record class)) + (indexing-record-slots (indexed-record class)) (indexing-record-derived (indexed-record class))))) (defmethod previously-indexed ((class persistent-metaclass)) @@ -201,7 +207,8 @@ (not (null (%indexed-slots class))) (let ((old (old-indexed-record class))) (when (not (null old)) - (or (indexing-record-slots old) + (or (indexing-record-class old) + (indexing-record-slots old) (indexing-record-derived old)))))) (defmethod indexed ((slot standard-slot-definition)) nil) --- /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2006/02/21 19:40:06 1.3 +++ /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2006/04/26 17:53:44 1.4 @@ -28,17 +28,17 @@ ;; - Migrate currently will not handle circular list objects ;; - Migrate does not support arrays with nested persistent objects ;; -;; ;; - Indexed classes only have their class index copied if you use the ;; top level migration. Objects will be copied without slot data if you ;; try to migrate an object outside of a store-to-store migration due to ;; the class object belonging to one store or another +;; ;; - Migrate assumes that after migration, indexed classes belong to the ;; target store. ;; ;; - In general, migration is a one-time activity and afterwards (or after ;; a validation test) the source store should be closed. Any failures -;; in migration should then be easy to catch +;; in migration should then be easy to catch. ;; ;; - Each call to migration will be good about keeping track of already ;; copied objects to avoid duplication. Duplication _shouldn't_ screw @@ -46,9 +46,16 @@ ;; However this information is not saved between calls and there's no ;; other way to do comparisons between objects across stores (different ;; oid namespaces) so user beware of the pitfalls of partial migrations... +;; +;; - Migrate keeps a memory-resident hash of all objects; this means +;; you cannot currently migrate a store that has more data than your +;; main memory. (This could be fixed by keeping the oid table in +;; the target store and deleting it on completion) +;; ;; - Migration does not maintain OID equivalence so any datastructures which ;; index into those will have to have a way to reconstruct themselves (better -;; to keep the object references themselves rather than oids) +;; to keep the object references themselves rather than oids in general) +;; but they can overload the migrate method to accomplish this cleanly ;; ;; CUSTOMIZE MIGRATION: ;; - To customize migration overload a version of migrate to specialize on @@ -149,8 +156,9 @@ ;; Copy all other reachable objects (map-btree (lambda (key value) (let ((newval (migrate dst value))) - (with-transaction (:store-controller dst :txn-nosync t) - (add-to-root key newval :store-controller dst)))) + (unless (eq key *elephant-properties-label*) + (with-transaction (:store-controller dst :txn-nosync t) + (add-to-root key newval :store-controller dst))))) (controller-root src)) dst) @@ -302,7 +310,7 @@ (defmethod migrate ((dst store-controller) (src array)) "NOTE: We need to handle arrays that might contain persistent objects!" - (warn "Arrays with persistent objects will fail migration!") + (warn "Arrays containing persistent objects will fail migration!") src) --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/03/01 18:57:34 1.2 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/04/26 17:53:44 1.3 @@ -50,7 +50,7 @@ (defconstant +ucs4-string+ 21) (defconstant +ucs4-pathname+ 22) -(defconstant +persistent+ 15) +(defconstant +persistent+ 15) ;; stored by id+classname (defconstant +cons+ 16) (defconstant +hash-table+ 17) (defconstant +object+ 18) @@ -59,7 +59,6 @@ (defconstant +fill-pointer-p+ #x40) (defconstant +adjustable-p+ #x80) - (defun serialize (frob bs) "Serialize a lisp value into a buffer-stream." (declare (optimize (speed 3) (safety 0)) @@ -81,12 +80,13 @@ (buffer-write-byte #+(and allegro ics) (etypecase s - (base-string +ucs1-symbol+) + (base-string +ucs2-symbol+) ;; +ucs1-symbol+ (string +ucs2-symbol+)) #+(or (and sbcl sb-unicode) lispworks) (etypecase s - (base-string +ucs1-symbol+) - (string #+sbcl +ucs4-symbol+ #+lispwoks +ucs2-symbol+)) + (base-string #+sbcl +ucs4-symbol+ #+lispworks +ucs2-symbol+ ) + ;; +ucs1-symbol+) + (string #+sbcl +ucs4-symbol+ #+lispworks +ucs2-symbol+)) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) +ucs1-symbol+ bs) @@ -101,11 +101,12 @@ (buffer-write-byte #+(and allegro ics) (etypecase frob - (base-string +ucs1-string+) + (base-string +ucs2-string+) ;; +ucs1-string+ (string +ucs2-string+)) #+(or (and sbcl sb-unicode) lispworks) (etypecase frob - (base-string +ucs1-string+) + (base-string #+sbcl +ucs4-string+ #+lispworks +ucs2-string+ ) + ;; +ucs1-string+ (string #+sbcl +ucs4-string+ #+lispworks +ucs2-string+)) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) +ucs1-string+ @@ -143,11 +144,12 @@ (buffer-write-byte #+(and allegro ics) (etypecase s - (base-string +ucs1-pathname+) + (base-string +ucs2-pathname+) ;; +ucs1-pathname+ (string +ucs2-pathname+)) #+(or (and sbcl sb-unicode) lispworks) (etypecase s - (base-string +ucs1-pathname+) + (base-string #+sbcl +ucs4-pathname+ #+lispwoks +ucs2-pathname+ ) + ;; +ucs1-pathname+ (string #+sbcl +ucs4-pathname+ #+lispwoks +ucs2-pathname+)) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) +ucs1-pathname+ --- /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2006/02/19 04:53:00 1.1 +++ /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2006/04/26 17:53:44 1.2 @@ -52,6 +52,7 @@ :txn-nowait ,txn-nowait :txn-sync ,txn-sync)) + ;; ;; An interface to manage transactions explicitely ;; --- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/02/19 04:53:00 1.1 +++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/04/26 17:53:44 1.2 @@ -27,6 +27,22 @@ (defvar *cachesize* 100 "Size of the OID sequence cache.") +;;;;;;;;;;;;;;;; +;;;; Versioning Support + +(defvar *elephant-code-version* '(0 6 0) + "The current database version supported by the code base") + +(defvar *elephant-unmarked-code-version* '(0 5 0) + "If a database is opened with existing data but no version then + we assume it's version 0.5.0") + +(defvar *elephant-properties-label* 'elephant::*database-properties* + "This is the symbol used to store properties associated with the + database in the controller-root through the new properties interface. + Users attempting to directly write this variable will run into an + error") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Thread-local specials --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2006/04/26 17:53:45 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2006/04/26 17:53:45 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; package.lisp -- package definition ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; <blee(a)common-lisp.net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html) also known as the LLGPL. ;;; (in-package :cl-user) (defpackage elephant (:use common-lisp elephant-memutil) (:nicknames ele :ele) (:documentation "Elephant: an object-oriented database for Common Lisp with multiple backends for Berkeley DB, SQL and others.") (:export #:*store-controller* #:*current-transaction* #:*auto-commit* #:*elephant-lib-path* #:store-controller #:open-store #:close-store #:with-open-store #:add-to-root #:get-from-root #:remove-from-root #:root-existsp #:flush-instance-cache #:with-transaction #:start-ele-transaction #:commit-transaction #:abort-transaction #:persistent #:persistent-object #:persistent-metaclass #:persistent-collection #:defpclass #:btree #:make-btree #:get-value #:remove-kv #:existp #:map-btree #:indexed-btree #:make-indexed-btree #:add-index #:get-index #:remove-index #:map-indices #:btree-index #:get-primary-key #:primary #:key-form #:key-fn #:btree-differ #:migrate #:*inhibit-slot-copy* #:cursor #:secondary-cursor #:make-cursor #:with-btree-cursor #:cursor-close #:cursor-init #:cursor-duplicate #:cursor-current #:cursor-first #:cursor-last #:cursor-next #:cursor-next-dup #:cursor-next-nodup #:cursor-prev #:cursor-prev-nodup #:cursor-set #:cursor-set-range #:cursor-get-both #:cursor-get-both-range #:cursor-delete #:cursor-put #:cursor-pcurrent #:cursor-pfirst #:cursor-plast #:cursor-pnext #:cursor-pnext-dup #:cursor-pnext-nodup #:cursor-pprev #:cursor-pprev-nodup #:cursor-pset #:cursor-pset-range #:cursor-pget-both #:cursor-pget-both-range #:run-elephant-thread ;; Class indexing management API #:*default-indexed-class-synch-policy* #:find-class-index #:find-inverted-index #:enable-class-indexing #:disable-class-indexing #:add-class-slot-index #:remove-class-slot-index #:add-class-derived-index #:remove-class-derived-index #:describe-db-class-index #:report-indexed-classes #:class-indexedp-by-name ;; Low level cursor API #:make-inverted-cursor #:make-class-cursor #:with-inverted-cursor #:with-class-cursor ;; Instance query API #:get-instances-by-class #:get-instance-by-value #:get-instances-by-value #:get-instances-by-range #:drop-instances ) #+cmu (:import-from :pcl compute-class-precedence-list validate-superclass standard-slot-definition standard-direct-slot-definition standard-effective-slot-definition direct-slot-definition-class effective-slot-definition-class slot-definition-name slot-definition-initform slot-definition-initfunction compute-effective-slot-definition class-slots slot-value-using-class slot-boundp-using-class slot-makunbound-using-class slot-definition-allocation slot-definition-initargs class-finalized-p finalize-inheritance ensure-class-using-class compute-slots initialize-internal-slot-functions compute-effective-slot-definition-initargs slot-definition-reader-function slot-definition-writer-function slot-definition-boundp-function slot-definition-allocation-class class-slot-cells plist-value +slot-unbound+) #+cmu (:import-from :ext make-weak-pointer weak-pointer-value finalize) #+cmu (:import-from :bignum %bignum-ref) #+sbcl (:import-from :sb-mop compute-class-precedence-list validate-superclass standard-slot-definition standard-direct-slot-definition standard-effective-slot-definition direct-slot-definition-class effective-slot-definition-class slot-definition-name slot-definition-initform slot-definition-initfunction compute-effective-slot-definition class-slots slot-value-using-class slot-boundp-using-class slot-makunbound-using-class slot-definition-allocation slot-definition-initargs class-finalized-p finalize-inheritance ensure-class-using-class compute-slots) #+sbcl (:import-from :sb-pcl initialize-internal-slot-functions compute-effective-slot-definition-initargs slot-definition-reader-function slot-definition-writer-function slot-definition-boundp-function slot-definition-allocation-class class-slot-cells plist-value +slot-unbound+) #+sbcl (:import-from :sb-ext make-weak-pointer weak-pointer-value finalize) #+sbcl (:import-from :sb-bignum %bignum-ref) #+allegro (:import-from :clos compute-class-precedence-list validate-superclass standard-slot-definition standard-direct-slot-definition standard-effective-slot-definition direct-slot-definition-class effective-slot-definition-class slot-definition-name slot-definition-initform slot-definition-initfunction compute-effective-slot-definition class-slots slot-value-using-class slot-boundp-using-class slot-makunbound-using-class slot-definition-allocation slot-definition-initargs class-finalized-p finalize-inheritance ensure-class-using-class compute-slots slot-definition-readers slot-definition-writers class-direct-slots ) #+allegro (:import-from :excl compute-effective-slot-definition-initargs) #+openmcl (:import-from :ccl class-finalized-p finalize-inheritance ensure-class-using-class compute-class-precedence-list validate-superclass standard-slot-definition standard-direct-slot-definition standard-effective-slot-definition direct-slot-definition-class effective-slot-definition-class slot-definition-name slot-definition-initform slot-definition-initfunction compute-effective-slot-definition class-slots slot-value-using-class slot-boundp-using-class slot-makunbound-using-class slot-definition-allocation slot-definition-initargs compute-slots ;; This stuff we need until we resolve the :transient ;; slot specifier stuff make-effective-slot-definition slots-class %slot-definition-initfunction %slot-definition-documentation %slot-definition-initargs %slot-definition-initform %slot-definition-allocation %slot-definition-class %slot-definition-type) #+lispworks (:import-from :clos compute-class-precedence-list validate-superclass ensure-class-using-class standard-slot-definition standard-direct-slot-definition standard-effective-slot-definition direct-slot-definition-class effective-slot-definition-class slot-definition-name slot-definition-initform slot-definition-initfunction compute-effective-slot-definition class-slots slot-value-using-class slot-boundp-using-class slot-makunbound-using-class slot-definition-allocation slot-definition-initargs compute-slots) ) (in-package "ELE") #+cmu (eval-when (:compile-toplevel) (proclaim '(optimize (ext:inhibit-warnings 3))))

1 0

[elephant-cvs] CVS elephant/src/contrib/eslick
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick In directory clnet:/tmp/cvs-serv12311/src/contrib/eslick Added Files: tools.lisp Log Message: Significant additions to the 0.6.0 release on the trunk. Updates to documentation, 0.5.0 compliance, final on 0.6.0 features. There are one or two BDB interactions on migration to work out but this should be a nearly code complete 0.6.0 release. Please start testing and evaluating this - especially the ability to open and tag 0.5.0 databases. Features: - Database version tagging - Support for 0.5.0 namespaces & databases - New migration system - class indexing without slot indexing - various bug fixes - reverted fast allegro/sbcl string support to allow 0.5.0 databases to work correctly. I couldn't find a good way to work around this without creating infinite headaches - validated that running db_deadlock will stop all lisp freezes that I've encountered. This has to be run each time a DB environment is opened/created so eventually should be made part of the open-controller functionality for the BDB backend --- /project/elephant/cvsroot/elephant/src/contrib/eslick/tools.lisp 2006/04/26 17:53:44 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/tools.lisp 2006/04/26 17:53:44 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; tools.lisp -- use btree collections to track objects by slot values ;;; via metaclass options or accessor :after methods ;;; ;;; Initial version 3/29/2006 Ian Eslick ;;; eslick at alum mit edu ;;; ;;; License: Lisp Limited General Public License (LLGPL) ;;; http://www.franz.com/preamble.html ;;; (in-package :elephant) ;; ;; Messy method to see what's in a btree ;; (defmethod summarize-btree-contents ((btree btree) &key (print-depth 100) (search-depth nil) (dump nil) (recurse nil)) (let ((count 0) (record (make-btree-summary-record))) (catch 'max-depth (map-btree (lambda (key val) (incf count) (when (and search-depth (> count search-depth)) (throw 'max-depth nil)) (update-stats-for-value val record) (when (and dump (< count print-depth)) (format t "key: ~A value: ~A~%" key val)) (when (and recurse (subtypep (type-of val) 'btree) (< count print-depth)) (format t "Recursing into ~A:~A...~%" key val) (summarize-btree-contents val :search-depth search-depth :print-depth print-depth :dump dump :recurse recurse) (format t "...completing recursion into ~A:~A~%" key val))) btree)) (format t "Summary:~%") (loop for pair in record do (cond ((eq (car pair) 'array) (format t "~A (~A)~%" (symbol-name (car pair)) (- (cdr pair) (cdr (assoc 'string record))))) (t (format t "~A (~A)~%" (symbol-name (car pair)) (cdr pair))))))) (defparameter *base-types* '(persistent-object persistent-collection structure-object standard-object number string array hash-table)) (defun make-btree-summary-record () (let ((record nil)) (loop for type in *base-types* do (push (cons (intern type (find-package 'keyword)) 0) record)) record)) (defmethod update-stats-for-value (value record) (loop for type in *base-types* do (when (subtypep (type-of value) type) (incf (cdr (assoc (intern type (find-package 'keyword)) record))))))

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv12311/src/db-bdb Modified Files: bdb-collections.lisp bdb-controller.lisp sleepycat.lisp Log Message: Significant additions to the 0.6.0 release on the trunk. Updates to documentation, 0.5.0 compliance, final on 0.6.0 features. There are one or two BDB interactions on migration to work out but this should be a nearly code complete 0.6.0 release. Please start testing and evaluating this - especially the ability to open and tag 0.5.0 databases. Features: - Database version tagging - Support for 0.5.0 namespaces & databases - New migration system - class indexing without slot indexing - various bug fixes - reverted fast allegro/sbcl string support to allow 0.5.0 databases to work correctly. I couldn't find a good way to work around this without creating infinite headaches - validated that running db_deadlock will stop all lisp freezes that I've encountered. This has to be run each time a DB environment is opened/created so eventually should be made part of the open-controller functionality for the BDB backend --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/02/22 21:03:47 1.5 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/04/26 17:53:44 1.6 @@ -56,7 +56,8 @@ (defmethod (setf get-value) (value key (bt bdb-btree)) (declare (optimize (speed 3) (safety 0) (space 0))) - (with-transaction (:store-controller (get-con bt)) + (assert (or *auto-commit* (not (eq *current-transaction* 0)))) +;; (with-transaction (:store-controller (get-con bt)) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid bt) key-buf) (serialize key key-buf) @@ -64,16 +65,17 @@ (db-put-buffered (controller-btrees (get-con bt)) key-buf value-buf :auto-commit *auto-commit*) - value))) + value)) (defmethod remove-kv (key (bt bdb-btree)) (declare (optimize (speed 3) (space 0) (safety 0))) - (with-transaction (:store-controller (get-con bt)) + (assert (or *auto-commit* (not (eq *current-transaction* 0)))) +;; (with-transaction (:store-controller (get-con bt)) (with-buffer-streams (key-buf) (buffer-write-int (oid bt) key-buf) (serialize key key-buf) (db-delete-buffered (controller-btrees (get-con bt)) - key-buf :auto-commit *auto-commit*)))) + key-buf :auto-commit *auto-commit*))) ;; Secondary indices --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/03/07 14:12:22 1.6 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/04/26 17:53:44 1.7 @@ -59,9 +59,12 @@ (let ((env (db-env-create))) ;; thread stuff? (setf (controller-environment sc) env) - (db-env-open env (second (controller-spec sc)) :create t :init-txn t :init-lock t + (db-env-open env (second (controller-spec sc)) + :create t :init-txn t :init-lock t :init-mpool t :init-log t :thread thread :recover recover :recover-fatal recover-fatal) + (db-env-set-timeout env 100000 :set-transaction-timeout t) + (db-env-set-timeout env 100000 :set-lock-timeout t) (let ((db (db-create env)) (btrees (db-create env)) (indices (db-create env)) --- /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/02/19 20:06:03 1.3 +++ /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/04/26 17:53:44 1.4 @@ -300,7 +300,7 @@ ((= ,errno 0) (values ,@(rest out-args))) ,@(if transaction (list `((or (= ,errno DB_LOCK_DEADLOCK) - (= ,errno DB_LOCK_NOTGRANTED)) + (= ,errno DB_LOCK_NOTGRANTED)) (throw 'transaction ,transaction))) (values)) (t (error 'db-error :errno ,errno))))))))

1 0

[elephant-cvs] CVS elephant
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv12311 Modified Files: NOTES TODO elephant.asd Log Message: Significant additions to the 0.6.0 release on the trunk. Updates to documentation, 0.5.0 compliance, final on 0.6.0 features. There are one or two BDB interactions on migration to work out but this should be a nearly code complete 0.6.0 release. Please start testing and evaluating this - especially the ability to open and tag 0.5.0 databases. Features: - Database version tagging - Support for 0.5.0 namespaces & databases - New migration system - class indexing without slot indexing - various bug fixes - reverted fast allegro/sbcl string support to allow 0.5.0 databases to work correctly. I couldn't find a good way to work around this without creating infinite headaches - validated that running db_deadlock will stop all lisp freezes that I've encountered. This has to be run each time a DB environment is opened/created so eventually should be made part of the open-controller functionality for the BDB backend --- /project/elephant/cvsroot/elephant/NOTES 2006/01/25 21:52:54 1.6 +++ /project/elephant/cvsroot/elephant/NOTES 2006/04/26 17:53:43 1.7 @@ -3,10 +3,9 @@ GENERAL ------- -this has been optimized for use with CMUCL / SBCL. it has -been tested and somewhat optimized for allegro. OpenMCL is -definitely also a target. Lispworks is a target as well but -less so: i don't have access to it. +this has been optimized for use with CMUCL / SBCL / Allegro. +OpenMCL has been minimally supported. Lispworks is a target as well +but less so as the developers don't have access to it. Theoretically one can port this to any lisp with a decent FFI and MOP. However since those are two of the less @@ -19,7 +18,7 @@ persistent meta-object, persistent collections controller serializer -SLEEPYCAT package +memutils package UFFI / implementation specific stuff libsleepycat.so Sleepycat 4.2/3 --- /project/elephant/cvsroot/elephant/TODO 2006/03/07 14:12:22 1.21 +++ /project/elephant/cvsroot/elephant/TODO 2006/04/26 17:53:43 1.22 @@ -1,13 +1,27 @@ -Feb 23, 2006 +April 23, 2006 -Release plan in-discussion with Robert and Ian +Ongoing release plan notes + +Features completed in 0.6.0: +----------------------------------- +x Add a class-indexing class option to the metaclass so we can maintain class instances + index without any secondary indices or indexed slots +x Upgrade solution to 0.6.0, DB properties & version tag for future upgrades +x Validate migration +x Documentation update +x Indexing tutorial and tutorial review -0.6.0 - Adding default class/slot indexing; modularize backends -- Documentation update -- Tutorial review 0.6.1 - performance, safety and portability +-------------------------------------------------- + +Bugs or Observations: +- BDB overwrite of values makes DB grow + [So far I can only find that it grows on the 2nd write, but not after that...artifact of + page allocation or caching of memory pools?] +- FEATURE: Investigate BDB record size; it's 2x larger than expected? + [Need a good test for this to follow up] Multi-threading operation: - Make elephant thread bound variables dynamic and modifiable by backends @@ -21,55 +35,63 @@ stored only as OIDs, and we should have a separate OID->class table. This way change-class can be handled correctly. This also non-trivially compresses storage in the database as we only need to store oids rather than serialized class names. + [Ian comment: only problem with this is an extra access to oid table each time a + class is deserialized and overall storage is constant. Would make it easy to + invalidate objects though!] - Delete persistent slot values from the slot store with remove-kv to ensure that there's no data left lying around if you define then redefine a class and add back a persistent slot name that you thought was deleted and it gets the old - value + value by default. Stores: +- Think through default *store-controller* vs. explicit parameter passing + referencing all over the APIs - Think about dynamic vs. object based store & transaction resolution? - - Error checking when mixed + - Perform error checking when mixed - Current store specific *current-transaction* stack -- Think through default vs. explicit store referencing all over the APIs (Both) - Throw condition when store spec is invalid, etc Transactionalism: - Cleaner failure modes if operations are performed without repository or without transaction or auto-commit (Both) + +BDB Features: - Trace all paths to db-put or db-delete and ensure that there is a check or a default with-transaction around the primitive components - write a document clarifying transaction design & assumptions in the backend] Add asserts if *auto-index* is false and we're not in a transaction to help users avoid lockups in bdb? Should be able to turn off for performance but it will help catch missing with-transaction statemetns in user code. (Both) -- BDB: determine how to detect deadlock conditions as an optional run-safe mode? (?) - Does BDB have timeouts enabled on select? (Ian) +- Determine how to detect deadlock conditions as an optional run-safe mode? +- Automatically run db_deadlock when opening a bdb backend? Requires path to + functions and ability to launch shell command. Closing the store stops the + sub-process. +- Always support locks that timeout? Tradeoffs? Performance: - Metering and understanding locking issues. Large transactions seem to use a lot of locks. In general understanding how to use Sleepycat efficiently seems like a good thing. (From Ben) -- Reclaim table storage on index drop (Ian) - Add dependency information into secondary index callback functions so that we can more easily compute which indices need to be updated to avoid the global remove/add in order to maintain consistency (Ian) +- Improve SQL serializer performance (Robert) Indexing features: -- Add a class-indexing class option to the metaclass so we can maintain class instances - index without any secondary indices or indexed slots (Ian) - Add :inverse-reader to slot options to create a named method that indexes into objects based on slot values. Is this a GF or defun? Do we dispatch on class name or bake it in? -Bugs: -- anything else reported against 0.5.0/0.6.0 - 0.6.3 - Query & indexing expansion +-------------------------------------------------- - simple object query language (Ian - orthogonal, on main branch) - Add needed support (if any) for persistent graph structures & queries (Ian on a branch) - A wrapper around migration that emulates a stop-and-copy GC 0.6.4 - Compliance & Documentation +-------------------------------------------------- - Update to support BDB 4.4 + - Add ability from within lisp to reclaim DB space after deleting btree key-value pairs + - Reclaim table storage on index drop - Tutorial example rethink: update the blog tutorial using indexed objects to create different views as well as integrating something like logging for admin or version control purposes. @@ -83,12 +105,14 @@ what state they're in...useful for long-lived repositories) 0.6.5 - Additional datastructures? +-------------------------------------------------- - Native BDB persistent hashes (easy; can do on SQL backends?) - Support for cheap persistent sets (medium? can do on SQL?) Some placeholders & dreams features below... :) 0.7+: Major features +-------------------------------------------------- - A backend controller for AllegroCache (Ian) - Prevalence-like in-memory database system (Robert?) - Richer controller modes: @@ -101,9 +125,13 @@ - NoSynch - allow transactions to be lost on failure but maintains consistency instead of performance 0.8 - Lisp Backend? +-------------------------------------------------- - A native BTree implementation in CommonLisp (prototype on Allegro's BTree implementation for ACache) +======================================================== +======================================================== + Resolved issues: - On class change, new slots should have their initform values pushed into the slot value as if the slot was being created the first time --- /project/elephant/cvsroot/elephant/elephant.asd 2006/02/22 20:18:51 1.16 +++ /project/elephant/cvsroot/elephant/elephant.asd 2006/04/26 17:53:43 1.17 @@ -94,7 +94,7 @@ :serial t) (:module elephant :components - ((:file "elephant") + ((:file "package") (:file "config" :pathname "../../config.lisp") (:file "variables") #+cmu (:file "cmu-mop-patches")

1 0

[elephant-cvs] CVS elephant/doc
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/doc In directory clnet:/tmp/cvs-serv12311/doc Modified Files: installation.texinfo intro.texinfo reference.texinfo tutorial.texinfo Log Message: Significant additions to the 0.6.0 release on the trunk. Updates to documentation, 0.5.0 compliance, final on 0.6.0 features. There are one or two BDB interactions on migration to work out but this should be a nearly code complete 0.6.0 release. Please start testing and evaluating this - especially the ability to open and tag 0.5.0 databases. Features: - Database version tagging - Support for 0.5.0 namespaces & databases - New migration system - class indexing without slot indexing - various bug fixes - reverted fast allegro/sbcl string support to allow 0.5.0 databases to work correctly. I couldn't find a good way to work around this without creating infinite headaches - validated that running db_deadlock will stop all lisp freezes that I've encountered. This has to be run each time a DB environment is opened/created so eventually should be made part of the open-controller functionality for the BDB backend --- /project/elephant/cvsroot/elephant/doc/installation.texinfo 2006/01/24 20:37:43 1.1 +++ /project/elephant/cvsroot/elephant/doc/installation.texinfo 2006/04/26 17:53:43 1.2 @@ -12,7 +12,6 @@ * Extention Status:: The current status of the SQL back-end extention. * Multi-repository Operation:: Specifying repositories * Setting up PostGres:: An example -* Repository Migration:: How to move objects from one repository to another @end menu @node Installation Basics @@ -28,11 +27,11 @@ (asdf:operate 'asdf:load-op :elephant) @end lisp - - However, Elephant cannot function without a back-end repository. Elephant presents exactly the same API no matter what you choose -as a repository. However, you have to use asdf to load the +as a repository. In most cases Elephant will automatically load +the backend you refer to with your controller spec when you call +open store. However, you may have to use asdf to load the code that interfaces to particular repository system. The basic choices are to use the BerkeleyDB system or @@ -53,7 +52,6 @@ (asdf:oos 'asdf:load-op :clsql-postgresql-socket) @end lisp - You will have to have the CL-SQL package installed. Following the documentation for CL-SQL under the section ``How CLSQL finds and loads foreign libraries'' you may need to do something like: @@ -81,10 +79,10 @@ same time. More particularly, you can seamlessly migrate your data from one repository to a different one at a later date. In a long duration project, this might occur because of a licensing -or performance issue with a particular respository. - - - +or performance issue with a particular respository. Migrating to +a new repository of the same type is a cheap form of GC although +migration is limited to the total size of main memory to store +a hash table that tracks all copied object ID's. @node Test-Suites @comment node-name, next, previous, up @@ -200,14 +198,14 @@ As of Elephant 0.3, Elephant has been tested to work with both Postgres, and SQLite 3, thanks do Dan Knapp. -@node Extention Status +@node Extension Status @comment node-name, next, previous, up -@section Extention Status +@section Extension Status As far as is known at this writing, all functionality except nested transaction -support and cursor-put's that is supported by the BerkeleyDB backend is supported by the CL-SQL -based back-end. Concurrency and transaction atomicity has not been tested well -for the CL-SQL based system. +support and cursor-puts supported by the BerkeleyDB backend is supported by the +CL-SQL back-end. Concurrency and transaction atomicity have not been stress tested +well for the CL-SQL based system. Additionally, it is NOT the case that the Elephant system currently provides transaction support across multiple repositories; it provides the transaction @@ -223,11 +221,7 @@ The SQL back-end is as easy to use as the BerkeleyDB back-end. However, the multi-repository version somewhat complicates the underlying -persistent object management. At the time of this writing, the -community has not decided if this extention will be a part of -Elephant proper or a separate branch; if it is not made a part of -Elephant proper, a user might prefer the simpler (and better maintained?) -system if they only want to use the BerkeleyDB back-end. +persistent object management. @node Multi-repository Operation @comment node-name, next, previous, up @@ -247,7 +241,6 @@ ELE-TESTS> @end lisp - The tests now have a function @code{do-all-tests-spec} that take a spec and based on its type attempt to open the correct kind of store controller and perform the tests. @@ -366,42 +359,7 @@ support but have not yet been tested. The basic pattern of the ``path'' specifiers is (cons clsqal-database-type-symbol (normal-clsql-connection-specifier)). -@node Repository Migration -@comment node-name, next, previous, up -@section Repository Migration - - -This version of Elephant supports migration betwen store controllers, -whether of the same implementation strategy or not. - -The tests @code{migrate1} - @code{migrate5} are demonstrations of this techinque. - -The functions for performing these migrations are: - -@code{migraten-pobj} - -The name of this function is meant to imply that it is -destructive of the object in question, mutating it to -point at the new repository. - -Which requies that you provide a copy-function to copy whatever -slots you want from the persistent object as deeply or as shallowly -as you desire. - -Data collections (btree's) can be move with the function: - -@code{migrate} - -A simple object that does not inherit from ``persistent'' but is -attached to a key (on the root) can be copied with the routine -@code{copy-from-key} -It is hoped that these routines would allow, with some labor, -a user to use one repository, and later decide to start using -a different implementation strategy, and easily migrate the -objects to the the new repository. The old repository could -then be abandoned, or multiple repositories could be used -at the same time. --- /project/elephant/cvsroot/elephant/doc/intro.texinfo 2006/03/02 14:44:49 1.3 +++ /project/elephant/cvsroot/elephant/doc/intro.texinfo 2006/04/26 17:53:43 1.4 @@ -5,52 +5,66 @@ @chapter Introduction @cindex Introduction -Elephant is an object database for Common Lisp. It supports -storing CLOS objects and most lisp primitives, and access to -BTrees. It can use the Sleepycat / Berkeley DB, a -widely-distributed embedded database; many unix systems have -it installed by default. Sleepycat is server-less, ACID -compliant, transactional, process and thread safe, and fast -relative to relational databases; hopefully Elephant -inherits these properties. - -It also provieds support for relational backends. -It has been tested with Postgres and SQLite 3. -It supports simultaneous multi-repository -operation and convenient migration of data between repositories. -This hopefully allows decisions about the prefered back-end -storage mechanism to be delayed and changed, even after -an application that uses Elephant is mature. +Elephant is a persistent object database for Common Lisp that +supports storing CLOS objects and most lisp primitives. +It supports persistent collections via a BTree interface. + +Elephant was originally developed as an interface layer on top +of the Sleepycat / Berkeley DB library, a widely-distributed +embedded database. Many unix systems have it installed by default. +Berkeley DB is ACID compliant, transactional, process and +thread safe, and fast relative to relational databases. Recently, +Elephant was extended to provide support for relational database backends. +It has been tested with Postgres and SQLite 3. It supports, with some +care, simultaneous multi-repository operation and enables convenient +migration of data between repositories. + +The support for relational backends and migration to the LLGPL was to +allow for broader use of Elephant in both not-for-profit and commercial +settings. -Goals: +Elephant goals: @itemize @item Transparency: most Lisp values are easy to persist without -much effort or special syntax. Talk to the DB with Lisp code, not SQL -or another domain-specific language. No additional server to run. - -@item Safety: ACID, transactions. Concurrent with good -multi-user and -thread semantics / isolation, locking and deadlock -detection. - -@item Simplicity: be a small library with few surprises for the -programmer. Lisp and Berkeley DB together are an excellent substrate, -try to use their features as much as possible. +signifcant effort or special syntax. Talk to the DB entirely from Lisp; +not requirement for domain-specific languages (such as SQL) to access persistent +resources. Enable interactive control of the database with no external +server dependencies. + +@item Safety: ACID, transactions. Concurrent with good multi-user and +multi-threaded semantics, isolation, locking and deadlock detection. +(Deadlock detection does require an external process to be launched) + +@item Simplicity: a small library with few surprises for the +programmer. Lisp and Berkeley DB together are an excellent substrate; +Elephant tries to leverage their features as much as possible. +Support for multiple backends should be load-time options and mostly +transparent to the user. @item Performance: leverage Sleepycat performance and reliability. In addition to fast concurrent / transactional modes, -elephant will (eventually) offer an accellerated single-user mode. +elephant will (eventually) offer an accellerated single-user as +well as in-memory modes that should be comparable to prevalence +style solutions, but leverage a common interface. + +@item Historical continuity: Elephant does not try to innovate +significantly over prior Lisp persistent object stores such as +AllegroStore (also based on Berkeley DB), the new AllegroCache, +the Symbolics system Statice and PLOB. Anyone familiar with +those systems will recognize the Elephant interface. @item License Flexibility: Elephant is released under the LLGPL. Because it supports multiple implementation of the backend, one -can choose a backend with licensing and other features appropriate to your needs. -@end itemize - +can choose a backend with licensing and other features appropriate +to your needs. +@end itemize Join the Elephant mailing lists to ask your questions and -receive updates. They're on the Elephant website at +receive updates. Pointers can be found on the Elephant website at @uref{http://www.common-lisp.net/project/elephant}. Installation documents can be found in the file @file{INSTALL}. +Opportunities to contribute can be found in the file @file{TODO}. --- /project/elephant/cvsroot/elephant/doc/reference.texinfo 2005/11/23 17:51:34 1.2 +++ /project/elephant/cvsroot/elephant/doc/reference.texinfo 2006/04/26 17:53:43 1.3 @@ -56,6 +56,23 @@ @include includes/class-elephant-persistent.texinfo @include includes/class-elephant-persistent-object.texinfo +@node Persistent Slot Indexing +@comment node-name, next, previous, up +@section Persistent Slot Indexing +@cindex Persistent Slot Indexing + +@include includes/get-instances-by-class +@include includes/get-instance-by-value +@include includes/get-instances-by-value +@include includes/get-instances-by-range + +@include includes/fun-elephant-enable-class-indexing +@include includes/fun-elephant-disable-class-indexing +@include includes/fun-add-class-slot-index +@include includes/fun-remove-class-slot-index +@include includes/fun-add-class-derived-index +@include includes/fun-remove-class-derived-index + @node Collections @comment node-name, next, previous, up @section Collections --- /project/elephant/cvsroot/elephant/doc/tutorial.texinfo 2006/03/02 14:44:49 1.5 +++ /project/elephant/cvsroot/elephant/doc/tutorial.texinfo 2006/04/26 17:53:43 1.6 @@ -16,9 +16,10 @@ * Using Transactions:: Using ACID. * Using BTrees:: Storing lots of things. * Using Cursors:: Tranversing BTrees. +* Secondary Indices:: By any other name... * Class Indices:: Speed and Convenience. -* Secondary Indices:: by any other name... -* The Store Controller:: behind the curtain. +* The Store Controller:: Behind the curtain. +* Repository Migration:: How to move objects from one repository to another * Threading:: Playing nice with others. * Performance Tips:: Bogoflops for your buck. @end menu @@ -27,43 +28,33 @@ @comment node-name, next, previous, up @section Preliminaries -Elephant isa Common Lisp OODB. It solves the problem of -making Lisp data persistent. It does this through two mechanisms: -a very simple API, and the ability to declare a CLOS class to be -persistent. It offers simple and powerful functional indexes -as well as convenient slot-based indexes. It represents - -Elephant is an Common Lisp OODB, as opposed to a language-neutral -(e.g. language-unspecific) RDBMS. This means it can store and efficient index -most Lisp values without programmer intervention, special syntax or laborious -conversion. In that way it is similar to prevalence, but it is -actually a database: it is not in-memory (though it can be.) - -When someone says "database," most people think of SQL RDBMSs (oracle, -postgresql, mysql). Elephant uses RDBMSs or Berekely DB (Sleepycat) as -a data repository, but simply uses LISP as its data manipulation system. -Unlike systems such as Hibernate for Java, the user does not need to -construct or worry about a mapping from the object space into -the database. Elephant is a very convenient system for the -programmer. - -Elephant can employ several different data repositories as a ``back-ends''. -It also supports easy migration of data between these repositories, -which allows the user to flexibly choose, or to late-bind, which -repository will use at a particular point in time. - - -Berkeley DB/Sleepycat is a very fast database that is well-matched -to Elephant. -Berkeley DB is a C library, not a server. On -the other hand it is quite robust, and has many features, like -transactions and replication. While you don't need to understand -a specific backend to use Elephant, reading the docs will certainly help you. -For the Sleepycat backend, they can be found at @uref{http://www.sleepycat.com}. - -Elephant can also employ relational databases, based on the excellent CL-SQL -package. It has been tested with Postgres and SQLite3, and can probably easily -work with others. +Elephant is a Common Lisp OODB. It provides a partial solution to the +problem of making Lisp data persistent. It does this through two mechanisms: +a simple API for storing and retrieving lisp values from a persistent store, +and the ability to make CLOS class slot values be persistent. + +When someone says "database," most people think of SQL Relation Data Base +Management Systems (e.g. Oracle, Postgresql, MySql). Elephant can use either +RDBMSs or Berkeley DB (Sleepycat) as a backend repository, but relies on +LISP as its data manipulation system. Unlike systems such as Hibernate +for Java, the user does not need to construct or worry about a mapping +from the object space into the database. Elephant is designed to be a +simple and convenient tool for the programmer. + +Elephant supports easy migration of data between different repositories and +different backends, allowing the user to choose which repository backend they +will use at a particular point in time. + +Berkeley DB/Sleepycat is a database library that was the initial inspiration for Elephant's +design and is well-matched to Elephant's data model. BDB is implemented as a C library, +not a client/server model, so access can be very fast. Berkeley DB is also quite mature, +robust and has many features, such as transactions and replication. While we hope +that you won't need to understand a specific backend to use Elephant, reading the +docs will certainly help you when things go wrong. For the Sleepycat backend, +they can be found at @uref{http://www.sleepycat.com}. + +Elephant can also use RDBMS backends via the excellent CL-SQL package. +It has been tested with Postgres and SQLite3, and can probably easily work with others. @node Running the Tests @comment node-name, next, previous, up @@ -107,11 +98,7 @@ @section Getting Started In order to use Elephant, you have to have an open store controller. -To obtain an open store controller, you have to decide which back-end -you will use and properly install that back-end system. The actual -use of Elephant once you have an open store controller is almost -completely independent of what the actual back-end choice is; Elephant -attempts to abstract away all such details. +To obtain an open store controller you call @code{open-store} The chapter ``SQL back-end'' has information about setting up a SQL based backend; this tutorial will assume that you are using @@ -159,9 +146,12 @@ @section The Root Liveness in a store is determined by reachability from the root -object. (When garbage collection is implemented, dead objects will be -collected on gc's.) The root object is a BTree which is like a -hash-table with sorted keys. @xref{Using BTrees}. +object. Technically, liveness also applies to indexed +classes, as described in @xref{Class Indices}, which live in a +separate class-root namespace. When garbage collection is +implemented, dead objects will be collected on gc's.) The root and +class-root objects are BTrees, effectively a table with sorted keys +and log(N) access time. @xref{Using BTrees}. You can put something into the root object by @@ -220,7 +210,7 @@ => NIL @end lisp -@item Changing substructures is not automatically saved: +@item Mutated substructure does not persist @lisp * (setf (car foo) T) @@ -230,7 +220,9 @@ @end lisp This will affect all aggregate types: objects, conses, hash-tables, et -cetera. (You can of course manually re-store the cons.) +cetera. (You can of course manually re-store the cons.) In this sense +elephant does not automatically provide persistent collections. If you +want to persist a collection on every access see @xref{Using BTrees}. @item Serialization and deserialization are pretty fast, but it is still expensive to store large aggregate objects wholesale. Also, since @@ -244,7 +236,7 @@ on this later. @end enumerate -But don't despair, we'll solve these problems in the next section..... +But don't despair, we'll solve most of these problems in the next section..... @node Persistent Classes @comment node-name, next, previous, up @@ -328,14 +320,14 @@ instrumented, so override these with care. Because @code{slot-value, slot-unboundp, slot-makunbound} are not generic functions, they are not guaranteed to work properly with persistent slots. Use the -@code{*-using-class} versions. +@code{*-using-class} versions or the @code{closer-to-mop} MOP compliance +layer by Pascal Costanza (we may integrate this in later versions). Persistent classes may inherit from other classes. Slots inherited from persistent classes remain persistent. Transient slots and slots inherited from ordinary classes remain transient. Ordinary classes cannot inherit from persistent classes -- persistent slots need to get -stored! Likewise, once a slot is declared persistent, it cannot later -be changed to a transient slot. +stored! Note that the database is read every time you access a slot. This is a feature, not a bug, especially in concurrent situations: you want @@ -351,14 +343,14 @@ which already exists in the database, @code{initargs} take precedence over values in the database, which take precedences over @code{initforms}. Also currently there is a bug where -@code{initforms} are always evaluated, so beware. (This will be fixed -soon.) +@code{initforms} are always evaluated, so beware. +(What is the current model here?) @node Using Transactions @comment node-name, next, previous, up @section Using Transactions -Elephant by default uses the Berkeley DB Transactional Data Store. +Elephant uses the Berkeley DB Transactional Data Store. This means most destructive operations need to be protected by transactions. By default Elephant does this: @@ -367,7 +359,12 @@ => T @end lisp -Most real applications will want to control their own transactions. +Most real applications will want to control their own transactions because +you will want one or more read-modify-update operations to happen as an +atomic unit. This is guaranteed by the use of a transaction, but auto +commits will only protect each individual update irrespective of whether +the read value has changed. + If, for some reason, you want to turn off an implicit transaction when no explicit transactions are in effect, you can do @@ -427,19 +424,18 @@ @lisp * (setq *current-transaction* - (db-transaction-begin (controller-environment - *store-controller*))) + (controller-transaction-begin store-controller )) @end lisp To commit: @lisp -* (db-transaction-commit *current-transaction*) +* (controller-transaction-commit store-controller *current-transaction*) NIL @end lisp If for some reason (like db error) you decide to abort, you can do so -via @code{(db-transaction-abort *current-transaction*)}. +via @code{(controller-transaction-abort store-controller *current-transaction*)}. @node Using BTrees @comment node-name, next, previous, up @@ -557,89 +553,6 @@ @code{map-btree} function, which functions analogously to the @code{maphash} CL function. - -@node Class Indices -@comment node-name, next, previous, up -@section Class Indices - -Class indices are a very convenient way of gaining the efficiency -that indexes provide. If a given object is most often sought by -the value of one of its slots, which is of course quite common, -it is convenient to define a class index on that slot, although -the same functionality can be gained in a more complicated way through -the use fo secondary indices. - -The file @file{tests/testindexing.lisp} provides many useful examples -of both declaring class indexes and using the API to seek objects using them. - -The following code from that file in the test ``indexing-range'' demonstrates -the convenience of a class indexes and the function ``get-instances-by-range''. -Note in the definiton of the ``slot1'' the keyword ``:index'' is used to -specify that this slot should be indexed. - -@lisp - (defclass idx-four () - ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) - (:metaclass persistent-metaclass)) - - - (defun make-idx-four (val) - (make-instance 'idx-four :slot1 val)) - - (with-transaction () - (mapc #'make-idx-four '(1 1 1 2 2 4 5 5 5 6 10))) - - (let ((x1 (get-instances-by-range 'idx-four 'slot1 2 6)) - (x2 (get-instances-by-range 'idx-four 'slot1 0 2)) - (x3 (get-instances-by-range 'idx-four 'slot1 6 15)) - ) - (format t " x1 = ~A~%" (mapcar #'slot1 x1)) - (format t " x2 = ~A~%" (mapcar #'slot1 x2)) - (format t " x3 = ~A~%" (mapcar #'slot1 x3)) -@end lisp - -Additionally, the test -@lisp -(do-test 'INDEXING-TIMING) -@end lisp -Can be used to judge the performance of indexing a large dataset. - -The file @file{src/elephant/classindex.lisp} provides the source code and -some crisp documentation of the class indexing system. - -Note that for retrieving items, the API is provided by three functions: - -@lisp -(defgeneric get-instances-by-class (persistent-metaclass)) -(defgeneric get-instances-by-value (persistent-metaclass slot-name value)) -(defgeneric get-instances-by-range (persistent-metaclass slot-name start end)) -@end lisp - -By using these functions, any class that is a subclass of persistent-metaclass -can also be thought of a as a container of all of its instances, which are -persistent in the database between lisp invocations. Morover an individual -object can be looked up on O(log n) time via a value which is indexed. - -At the top of this same file, you will find the a description of the API -which can be used to dynamically add and remove indexes. (Adding and -removing indexes can also be performed by a re-execution of the ``defclass'' -macro with different values.) - -Thus, the question of if and how a given class should be indexed is -very flexible and dynamic, and does not need to be determined at the -beginning of your development. This represents the ability to ``late bind'' -the and change the decision of what to index for efficiencty. - -In general, there is always a tradeoff: an index makes reads in a -particular way fast, but makes writes slower. The Elephant system -makes it simple to choose where and when one wants to utilize this tradeoff. - -Finally, that file @file{src/elephant/classindex-utils.lisp} documents -tools for handling class redefinitions and the policy that should be -used for synchronizing the classes with the database. - -Thanks to Ian Eslick for this functionality. - @node Secondary Indices @comment node-name, next, previous, up @section Secondary Indices @@ -756,6 +669,119 @@ There are also @code{cursor-p*} functions like @code{pcurrent, pnext}, et cetera which also return the primary key. @xref{Cursors}. + + +@node Class Indices +@comment node-name, next, previous, up +@section Class Indices + +Class indices are a very convenient way of gaining the efficiency +that BTree indices provide. If a given object is most often sought by +the value of one of its slots, which is of course quite common, +it is convenient to define a class index on that slot, although +the same functionality can be gained in a more complicated way through +the use of secondary indices. + +The file @file{tests/testindexing.lisp} provides many useful examples +of both declaring class indexes and using the API to seek objects using them. + +The following code from that file in the test ``indexing-range'' demonstrates +the convenience of a class indexes and the function ``get-instances-by-range''. +Note in the definition of the ``slot1'' the keyword ``:index'' is used to +specify that this slot should be indexed. + +@lisp + (defclass idx-four () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) + (:metaclass persistent-metaclass)) + + + (defun make-idx-four (val) + (make-instance 'idx-four :slot1 val)) + + (with-transaction () + (mapc #'make-idx-four '(1 1 1 2 2 4 5 5 5 6 10))) + + (let ((x1 (get-instances-by-range 'idx-four 'slot1 2 6)) + (x2 (get-instances-by-range 'idx-four 'slot1 0 2)) + (x3 (get-instances-by-range 'idx-four 'slot1 6 15)) + ) + (format t " x1 = ~A~%" (mapcar #'slot1 x1)) + (format t " x2 = ~A~%" (mapcar #'slot1 x2)) + (format t " x3 = ~A~%" (mapcar #'slot1 x3)) +@end lisp + +Additionally, the test +@lisp +(do-test 'INDEXING-TIMING) +@end lisp +Can be used to judge the performance of indexing a medium sized dataset. + +The file @file{src/elephant/classindex.lisp} provides the source code and +some crisp documentation of the class indexing system. + +Note that for retrieving items, the API is provided by three functions: + +@lisp +(defgeneric get-instances-by-class (persistent-metaclass)) +(defgeneric get-instances-by-value (persistent-metaclass slot-name value)) +(defgeneric get-instances-by-range (persistent-metaclass slot-name start end)) +@end lisp + +By using these functions, any class that is a subclass of persistent-metaclass +can also be thought of as a container of all of its instances, which are +persistent in the database between lisp invocations. Moreover an individual +object can be looked up on O(log n) time via a value on which it is indexed. + +At the top of this same file, you will find the a description of the API +which can be used to dynamically add and remove indexes. (Adding and +removing indexes can also be performed by a re-execution of the ``defclass'' +macro with different values.) + +You can enable/disable class indexing for an entire class. When you disable +indexing all references to instances of that class are lost. If you re-enable +class indexing only newly created classes will be stored in the class index. +You can manually restore them by using @code{find-class-index} to get the +clas index BTree if you have an alternate in-memory index. + +You can add/remove a secondary index for a slot. So long as the class index +remains, this can be done multiple times without losing any data. + +There is also a facility for defining 'derived slots'. These can be non-slot +parameters which are a function of the class's persistent slot values. For +example you can use an index to keep an alternate representation available +for fast indexing. If an object has an x,y coordinate, you could define a +derived index for r,theta which stored references in polar coordinates. +These would be ordered so you could iterate over a class-index to get objects +in order of increasing radius from the origin or over a range of theta. + +Beware, however, that derived indices have to compute their result every +time you update any persistent instance's slot. This is because there is +no way to know which persistent slots the derived index value(s) depends [142 lines skipped]

1 0

[elephant-cvs] CVS elephant/src/contrib/eslick
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick In directory clnet:/tmp/cvs-serv12253/eslick Log Message: Directory /project/elephant/cvsroot/elephant/src/contrib/eslick added to the repository

1 0

[elephant-cvs] CVS elephant/src/contrib
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/contrib In directory clnet:/tmp/cvs-serv12200/contrib Log Message: Directory /project/elephant/cvsroot/elephant/src/contrib added to the repository

1 0