Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv3920/src/elephant
Modified Files: classes.lisp controller.lisp package.lisp serializer2.lisp Added Files: data-store-api.lisp Removed Files: backend.lisp Log Message: Check for cross-store loading errors in multi-store operation; more documentation; backend language to data store language
--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/04/12 02:47:31 1.27 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/04/21 17:22:50 1.28 @@ -252,6 +252,30 @@ (indexed-slot-makunbound class instance slot-def) (persistent-slot-makunbound (get-con instance) instance (slot-definition-name slot-def))))
+;; =================================== +;; Multi-store error checking +;; =================================== + +(defun valid-persistent-reference-p (object sc) + "Ensures that object can be written as a reference into store sc" + (eq (dbcn-spc-pst object) (controller-spec sc))) + +(define-condition cross-store-reference () + ((object :accessor cross-store-reference-object :initarg :object) + (home-controller :accessor cross-store-reference-home-controller :initarg :home-ctrl) + (foreign-controller :accessor cross-store-reference-foreign-controller :initarg :foreign-ctrl)) + (:documentation "An error condition raised when an object is being written into a data store other + than its home store")) + +(defun raise-cross-store-condition (object sc) + (cerror "Proceed and patch later" + 'cross-store-reference + :format-control "Attempted to write object ~A with home store ~A into store ~A" + :format-arguments (list object (get-con object) sc) + :object object + :home-ctrl (get-con object) + :foreign-ctrl sc)) + ;; ====================================================== ;; Handling metaclass overrides of normal slot operation ;; ====================================================== --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/04/12 02:47:32 1.46 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/04/21 17:22:50 1.47 @@ -26,26 +26,26 @@ ;; TRACKING OBJECT STORES ;;
-(defvar *elephant-backends* +(defvar *elephant-data-stores* '((:bdb (:ele-bdb)) (:clsql (:ele-clsql)) ) "Tells the main elephant code the tag used in a store spec to - refer to a given backend. The second argument is an asdf - dependency list. Entries have the form of (backend-type + refer to a given data store. The second argument is an asdf + dependency list. Entries have the form of (data store type asdf-depends-list")
(defvar *elephant-controller-init* (make-hash-table))
-(defun register-backend-con-init (name controller-init-fn) - "Backends must call this function during the +(defun register-data-store-con-init (name controller-init-fn) + "Data stores must call this function during the loading/compilation process to register their initialization - function for the tag name in *elephant-backends*. The + function for the tag name in *elephant-data-stores*. The initialization function returns a fresh instance of the - backends store-controller subclass" + data stores store-controller subclass" (setf (gethash name *elephant-controller-init*) controller-init-fn))
-(defun lookup-backend-con-init (name) +(defun lookup-data-store-con-init (name) (gethash name *elephant-controller-init*))
(defvar *dbconnection-spec* (make-hash-table :test 'equal)) @@ -86,19 +86,19 @@ (defun build-controller (spec) "Actually construct the controller & load dependencies" (assert (and (consp spec) (symbolp (first spec)))) - (load-backend (first spec)) - (let ((init (lookup-backend-con-init (first spec)))) - (unless init (error "Store controller init function not registered for backend ~A." (car spec))) + (load-data-store (first spec)) + (let ((init (lookup-data-store-con-init (first spec)))) + (unless init (error "Store controller init function not registered for data store ~A." (car spec))) (let ((sc (funcall (symbol-function init) spec))) (ele-with-lock (*dbconnection-lock*) (setf (gethash spec *dbconnection-spec*) sc)) sc)))
-(defun load-backend (type) +(defun load-data-store (type) (assert (find-package :asdf)) - (let ((record (assoc type *elephant-backends*))) + (let ((record (assoc type *elephant-data-stores*))) (when (or (null record) (not (consp record))) - (error "Unknown backend type ~A, cannot load" type)) + (error "Unknown data store type ~A, cannot load" type)) (satisfy-asdf-dependencies (second record))))
(defun satisfy-asdf-dependencies (dep-list) @@ -115,7 +115,7 @@
(defun get-user-configuration-parameter (name) "This function pulls a value from the key-value pairs stored in - my-config.sexp so backends can have their own pairs for appropriate + my-config.sexp so data stores can have their own pairs for appropriate customization after loading." (elephant-system::get-config-option name @@ -129,24 +129,24 @@ ((spec :type list :accessor controller-spec :initarg :spec - :documentation "Backend initialization functions are + :documentation "Data store initialization functions are expected to initialize :spec on the call to make-instance") ;; Generic support for the object, indexing and root protocols (root :reader controller-root - :documentation "This is an instance of the backend + :documentation "This is an instance of the data store persistent btree. It should have an OID that is fixed in the code and does not change between sessions. Usually it this is something like 0, 1 or -1") (class-root :reader controller-class-root :documentation "This is another root for class indexing that is - also a backend specific persistent btree instance + also a data store specific persistent btree instance with a unique OID that persists between sessions.") (instance-cache :accessor instance-cache :initform (make-cache-table :test 'eql) :documentation "This is an instance cache and part of the - metaclass protocol. Backends should not + metaclass protocol. Data stores should not override the default behavior.") (instance-cache-lock :accessor instance-cache-lock :initform (ele-make-lock) :documentation "Protection for updates to @@ -157,12 +157,12 @@ :documentation "Governs the default behavior regarding which serializer version the current elephant core is - using. Backends can override by creating + using. Data stores can override by creating a method on initialize-serializer.") (serialize :accessor controller-serialize :initform nil :documentation "Accessed by elephant::serialize to get the entry point to the default serializer or to - a backend-specific serializer") + a data store specific serializer") (deserialize :accessor controller-deserialize :initform nil :documentation "Contains the entry point for the specific serializer to be called by @@ -175,6 +175,9 @@ the superclass and subclasses. See slot documentation for details."))
+(defmethod print-object ((sc store-controller) stream) + (format stream "#<~A ~A>" (type-of sc) (second (controller-spec sc)))) + ;; ;; Per-controller instance caching ;; @@ -208,8 +211,8 @@ ;;
(defgeneric database-version (sc) - (:documentation "Backends implement this to store the serializer version. - The protocol requires that backends report their database + (:documentation "Data stores implement this to store the serializer version. + The protocol requires that data stores report their database version. On new database creation, the database is written with the *elephant-code-version* so that is returned by database-version. If a legacy database does not have a version according to the method @@ -280,9 +283,9 @@ ;;
(defmethod initialize-serializer ((sc store-controller)) - "Establish serializer version on controller startup. Backends call this before + "Establish serializer version on controller startup. Data stores call this before they need the serializer to be valid and after they enable their database-version - call. If the backend shadows this, it has to keep track of serializer versions + call. If the data store shadows this, it has to keep track of serializer versions associated with the database version that is opened." (cond ((prior-version-p (database-version sc) '(0 6 0)) (setf (controller-serializer-version sc) 1) @@ -367,19 +370,19 @@
;; ================================================================================ ;; -;; BACKEND STORE CONTROLLER PROTOCOL +;; DATA STORE CONTROLLER PROTOCOL ;; ;; ================================================================================
(defgeneric open-controller (sc &key recover recover-fatal thread &allow-other-keys) (:documentation "Opens the underlying environment and all the necessary -database tables. Different backends may use different keys so +database tables. Different data stores may use different keys so all methods should &allow-other-keys. There are three standard keywords: :recover, :recover-fatal and :thread. Recover means that recovery should be checked for or performed on startup. Recover fatal means a full rebuild from log files is requested. -Thread merely indicates to the backend that it is a threaded +Thread merely indicates to the data store that it is a threaded application and any steps that need to be taken (for example transaction implementation) are taken. :thread is usually true.")) @@ -407,7 +410,7 @@ (defgeneric optimize-layout (sc &key &allow-other-keys) (:documentation "If supported, speed up the index and allocation by freeing up any available storage and return it to the free list. See the - methods of backends to determine what options are valid. Supported + methods of data stores to determine what options are valid. Supported both on stores (all btrees and persistent slots) and specific btrees"))
;; @@ -416,19 +419,19 @@
(defgeneric persistent-slot-reader (sc instance name) (:documentation - "Backend specific slot reader function")) + "Data store specific slot reader function"))
(defgeneric persistent-slot-writer (sc new-value instance name) (:documentation - "Backend specific slot writer function")) + "Data store specific slot writer function"))
(defgeneric persistent-slot-boundp (sc instance name) (:documentation - "Backend specific slot bound test function")) + "Data store specific slot bound test function"))
(defgeneric persistent-slot-makunbound (sc instance name) (:documentation - "Backend specific slot makunbound handler")) + "Data store specific slot makunbound handler"))
;; ================================================================================ @@ -439,7 +442,7 @@
;; -;; Opening and closing backend stores +;; Opening and closing data stores ;;
(defun open-store (spec &rest args) --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/04/12 02:47:33 1.30 +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/04/21 17:22:50 1.31 @@ -265,6 +265,9 @@
#:struct-constructor
+ ;; Various error conditions + #:cross-store-reference + #:map-class-query #:get-query-instances ) --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/04/12 02:47:33 1.38 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/04/21 17:22:51 1.39 @@ -40,7 +40,9 @@ array-type-from-byte byte-from-array-type database-version - translate-and-intern-symbol)) + translate-and-intern-symbol + valid-persistent-reference-p + raise-cross-store-condition))
(in-package :elephant-serializer2)
@@ -198,6 +200,8 @@ (string (serialize-string frob bs)) (persistent + (unless (valid-persistent-reference-p frob sc) + (raise-cross-store-condition frob sc)) (buffer-write-byte +persistent+ bs) (buffer-write-int32 (oid frob) bs) ;; This circumlocution is necessitated by
--- /project/elephant/cvsroot/elephant/src/elephant/data-store-api.lisp 2007/04/21 17:23:02 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/data-store-api.lisp 2007/04/21 17:23:02 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; backend.lisp -- Namespace support for data store packages ;;; ;;; By Ian Eslick <ieslick common-lisp net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; ablumberg@common-lisp.net blee@common-lisp.net ;;; ;;; Portions Copyright (c) 2005-2007 by Robert Read and Ian Eslick ;;; <rread common-lisp net> <ieslick 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)
(defmacro defpackage-import-exported (name source-package &rest args) "Define an export list, a source package and this macro will automatically import from that package the exported symbol names." (let* ((exports (find :export args :key #'car)) (imports `(:import-from ,source-package ,@(cdr exports)))) `(defpackage ,name ,@(append args (list imports)))))
(defpackage-import-exported :elephant-data-store :elephant (:documentation "Data stores should use this to get access to internal symbols of elephant that importers of elephant shouldn't see. Backends should also import elephant to get use-api generic function symbols, classes and globals") (:use #:elephant) (:export ;; Variables #:*dbconnection-spec* #:connection-is-indeed-open
;; Persistent objects #:oid #:get-con #:next-oid #:persistent-slot-writer #:persistent-slot-reader #:persistent-slot-boundp #:persistent-slot-makunbound
;; Controllers #:*elephant-code-version* #:open-controller #:close-controller #:database-version #:controller-spec #:controller-serializer-version #:controller-serialize #:controller-deserialize #:root #:spec #:class-root
;; Collections #:build-btree #:build-indexed-btree
;; Serializer tools/api's #:serialize #:deserialize #:deserialize-from-base64-string #:serialize-to-base64-string #:initialize-serializer #:serialize-database-version-key #:serialize-database-version-value #:deserialize-database-version-value
;; Cursor accessors #:cursor-btree #:cursor-oid #:cursor-initialized-p
;; Transactions #:*current-transaction* #:make-transaction-record #:transaction-store #:transaction-object #:execute-transaction #:controller-start-transaction #:controller-abort-transaction #:controller-commit-transaction
;; Registration #:register-data-store-con-init #:lookup-data-store-con-init #:get-user-configuration-parameter
;; Misc #:slot-definition-name #:slots-and-values #:struct-slots-and-values ))