Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv13575/src

Modified Files: controller.lisp Log Message: license, name changes, with-transaction* defaulters

Date: Fri Aug 27 10:31:59 2004 Author: blee

Index: elephant/src/controller.lisp diff -u elephant/src/controller.lisp:1.2 elephant/src/controller.lisp:1.3 --- elephant/src/controller.lisp:1.2 Thu Aug 26 19:58:09 2004 +++ elephant/src/controller.lisp Fri Aug 27 10:31:59 2004 @@ -1,12 +1,51 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;; +;;; controller.lisp -- Lisp interface to a Berkeley DB store +;;; +;;; Initial version 8/26/2004 by Ben Lee +;;; blee@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 +;;; +;;; This program is free software; you can redistribute it +;;; and/or modify it under the terms of the GNU General +;;; Public License as published by the Free Software +;;; Foundation; either version 2 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the +;;; implied warranty of MERCHANTABILITY or FITNESS FOR A +;;; PARTICULAR PURPOSE. See the GNU General Public License +;;; for more details. +;;; +;;; The GNU General Public License can be found in the file +;;; LICENSE which should have been distributed with this +;;; code. It can also be found at +;;; +;;; http://www.opensource.org/licenses/gpl-license.php +;;; +;;; You should have received a copy of the GNU General +;;; Public License along with this program; if not, write +;;; to the Free Software Foundation, Inc., 59 Temple Place, +;;; Suite 330, Boston, MA 02111-1307 USA +;;; + (in-package "ELEPHANT")

(defclass store-controller () ((path :type (or pathname string) - :reader path + :accessor controller-path :initarg :path) - (environment :type (or null pointer-void) :accessor environment) - (db :type (or null pointer-void) :accessor db) - (root :accessor root) + (environment :type (or null pointer-void) + :accessor controller-environment) + (db :type (or null pointer-void) :accessor controller-db) + (root :reader controller-root) (instance-cache :accessor instance-cache :initform (make-cache-table :test 'eql))) (:documentation "Class of objects responsible for handling @@ -20,11 +59,15 @@ persistables as well (though note collection key semantics!) N.B. this means it (and everything it points to) won't get gc'd." - (setf (get-value key (root sc)) value)) + (setf (get-value key (controller-root sc)) value))

(defmethod get-from-root ((sc store-controller) key) "Get a persistent thing from the root." - (get-value key (root sc))) + (get-value key (controller-root sc))) + +(defmethod remove-from-root ((sc store-controller) key) + "Get a persistent thing from the root." + (remove-kv key (controller-root sc)))

(defmethod cache-instance ((sc store-controller) obj) "Register an instance of a user persistent-class with the @@ -32,38 +75,41 @@ (setf (get-cache (oid obj) (instance-cache sc)) obj))

(defmethod get-cached-instance ((sc store-controller) oid class-name) - (let ((obj (get-cache oid (instance-cache sc) nil))) + (let ((obj (get-cache oid (instance-cache sc)))) (if obj obj ;; Should get cached since make-instance calls cache-instance (make-instance class-name :from-oid oid))))

-(defmethod open-controller ((sc store-controller)) +(defmethod open-controller ((sc store-controller) &key (recover nil) + (recover-fatal nil) (thread t)) "Opens the underlying environment and all the necessary database tables." (let ((env (db-env-create))) ;; thread stuff? - (setf (environment sc) env) - (db-env-open env (path sc) :create t :init-txn t :init-lock t - :init-mpool t :init-log t :thread t :recover-fatal t) + (setf (controller-environment sc) env) + (db-env-open env (controller-path sc) :create t :init-txn t :init-lock t + :init-mpool t :init-log t :thread thread + :recover recover :recover-fatal recover-fatal) (let ((db (db-create env))) - (setf (db sc) db) - (db-open db :auto-commit t :type DB-BTREE :create t :thread t) + (setf (controller-db sc) db) + (db-open db :file "%ELEPHANT" :database "%ELEPHANTDB" + :auto-commit t :type DB-BTREE :create t :thread thread) (let ((root (make-instance 'btree :from-oid -1))) - (setf (root sc) root) + (setf (slot-value sc 'root) root) sc))))

(defmethod close-controller ((sc store-controller)) "Close the db handles and environment. Tries to wipe out references to the db handles." ; no root - (setf (root sc) nil) + (setf (slot-value sc 'root) nil) ; clean instance cache (setf (instance-cache sc) (make-cache-table :test 'eql)) ; close environment - (db-close (db sc)) - (setf (db sc) nil) - (db-env-close (environment sc)) - (setf (environment sc) nil) + (db-close (controller-db sc)) + (setf (controller-db sc) nil) + (db-env-close (controller-environment sc)) + (setf (controller-environment sc) nil) nil)

(defmacro with-open-controller ((&optional (sc *store-controller*)) @@ -73,6 +119,43 @@ (open-controller ,sc) ,@body) (close-controller ,sc))) + +(defmacro with-transaction ((&key transaction + (environment (controller-environment + *store-controller*)) + (globally t) + (parent *current-transaction*) + dirty-read txn-nosync + txn-nowait txn-sync) + &body body) + `(sleepycat:with-transaction (:transaction ,transaction + :environment ,environment + :globally ,globally + :parent ,parent + :dirty-read ,dirty-read + :txn-nosync ,txn-nosync + :txn-nowait ,txn-nowait + :txn-sync ,txn-sync) + ,@body)) + +(defmacro with-transaction-retry ((&key transaction environment + (globally t) + (parent *current-transaction*) + (retries 100) + dirty-read txn-nosync + txn-nowait txn-sync) + &body body) + `(sleepycat:with-transaction-retry (:transaction ,transaction + :environment ,environment + :globally ,globally + :parent ,parent + :retries ,retries + :dirty-read ,dirty-read + :txn-nosync ,txn-nosync + :txn-nowait ,txn-nowait + :txn-sync ,txn-sync) + ,@body)) +

;; This stuff is all a hack until sequences appear in Sleepycat 4.3 (defconstant max-oid most-positive-fixnum)