[elephant-cvs] CVS elephant/src/elephant
ieslick
ieslick at common-lisp.net
Sat Apr 21 17:23:02 UTC 2007
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 at common-lisp.net> <blee at 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
))
More information about the Elephant-cvs
mailing list