Update of /project/elephant/cvsroot/elephant/src/db-acache In directory common-lisp:/tmp/cvs-serv10634/src/db-acache

Added Files: README acache-collections.lisp acache-controller.lisp acache-transactions.lisp package.lisp Log Message: A quick AllegroCache backend based on the allegrocache map and compound keys - functionality is only partial but the basics work

--- /project/elephant/cvsroot/elephant/src/db-acache/README 2006/02/20 21:21:41 NONE +++ /project/elephant/cvsroot/elephant/src/db-acache/README 2006/02/20 21:21:41 1.1

This directory contains a quick and dirty sketch of an allegrocache backend, mostly to test out the new backend abstraction. Too bad we can't use allegroserve directly behind the metaclass protocol...the apis are a little too different for that. --- /project/elephant/cvsroot/elephant/src/db-acache/acache-collections.lisp 2006/02/20 21:21:41 NONE +++ /project/elephant/cvsroot/elephant/src/db-acache/acache-collections.lisp 2006/02/20 21:21:41 1.1

(in-package :elephant-acache)

;; BTREE

(defclass acache-btree (btree) ())

(defmethod build-btree ((sc acache-store-controller)) (make-instance 'acache-btree :sc sc))

(defmethod get-value (key (bt acache-btree)) (map-value (controller-btrees (get-con bt)) (cons (oid bt) key)))

(defmethod (setf get-value) (value key (bt acache-btree)) (setf (map-value (controller-btrees (get-con bt)) (cons (oid bt) key)) value))

(defmethod existsp (key (bt acache-btree)) (when (get-value key bt) t))

(defmethod remove-kv (key (bt acache-btree)) (remove-from-map (controller-btrees (get-con bt)) (cons (oid bt) key)))

(defmethod map-btree (fn (bt acache-btree)) (map-map fn bt))

;; ;; Cursors need to have their own model of where they are ;;

;; INDEXED BTREE

;; How to handle add-index? Have to hack it up on btrees just like slot ;; values...which means solving the complex key problem--- /project/elephant/cvsroot/elephant/src/db-acache/acache-controller.lisp 2006/02/20 21:21:41 NONE +++ /project/elephant/cvsroot/elephant/src/db-acache/acache-controller.lisp 2006/02/20 21:21:41 1.1

(in-package :elephant-acache)

(defclass acache-store-controller (store-controller) ((db :accessor controller-db :initform nil) (slots :accessor controller-slots :initform nil) (btrees :accessor controller-btrees :initform nil) (oidrec :accessor controller-oidrec :initform nil)))

(defun acache-constructor (spec) (make-instance 'acache-store-controller :spec spec))

(eval-when (:compile-toplevel :load-toplevel) (register-backend-con-init :acache 'acache-constructor))

(defclass oid-record () ((counter :accessor oid-record-counter :initform 0)) (:metaclass db.allegrocache:persistent-class))

(defmethod open-controller ((sc acache-store-controller) &key (recover t) (recover-fatal nil) (thread nil)) (declare (ignore recover thread recover-fatal)) (let ((db (db.allegrocache:open-file-database (second (controller-spec sc)) :if-does-not-exist :create :if-exists :open :use :memory))) (when (not db) (error "Unable to open astore database for ~A" (controller-spec sc))) ;; Main DB ref (setf (controller-db sc) db) ;; Slots and Btree storage (let ((slotmap (retrieve-from-index 'ac-map 'ac-map-name "slots"))) (setf (controller-slots sc) (if slotmap slotmap (make-instance 'db.allegrocache:ac-map :ac-map-name "slots")))) (let ((btreemap (retrieve-from-index 'ac-map 'ac-map-name "btrees"))) (setf (controller-btrees sc) (if btreemap btreemap (make-instance 'db.allegrocache:ac-map :ac-map-name "btrees")))) ;; OIDS (let ((oidrec (doclass (inst (find-class 'oid-record) :db db) (when inst (return inst))))) (setf (controller-oidrec sc) (if oidrec oidrec (make-instance 'oid-record)))) ;; Construct the roots (setf (slot-value sc 'root) (make-instance 'acache-btree :from-oid -1)) (setf (slot-value sc 'class-root) (make-instance 'acache-btree :from-oid -2)) sc))

(defmethod next-oid ((sc acache-store-controller)) (db.allegrocache:with-transaction-restart () (incf (oid-record-counter (controller-oidrec sc))) (commit)))

(defmethod close-controller ((sc acache-store-controller)) ;; Ensure deletion of common (setf (slot-value sc 'class-root) nil) (setf (slot-value sc 'root) nil) (db.allegrocache:close-database :db (controller-db sc)))

(defmethod connection-is-indeed-open ((sc acache-store-controller)) (db.allegrocache::database-open-p (controller-db sc)))

;; Slot writing

;; This is not thread-safe, but could be a thread-local when we fix that... ;; to avoid extra consing. Is consing less/more expensive than dynamic ;; var lookups?

(defvar *index-cons* (cons nil nil))

(defmacro fast-key (oid name) `(rplacd (rplaca *index-cons* ,oid) ,name))

(defmethod persistent-slot-reader ((sc acache-store-controller) instance name) (declare (optimize (speed 3) (safety 1))) (multiple-value-bind (val valid?) (map-value (controller-slots sc) (fast-key (oid instance) name)) (if valid? val (error "Slot ~A unbound in ~A" name instance))))

(defmethod persistent-slot-writer ((sc acache-store-controller) value instance name) (declare (optimize (speed 3) (safety 1))) (setf (map-value (controller-slots sc) (fast-key (oid instance) name)) value))

(defmethod persistent-slot-boundp ((sc acache-store-controller) instance name) (declare (optimize (speed 3) (safety 1))) (when (map-value (controller-slots sc) (fast-key (oid instance) name)) t))

(defmethod persistent-slot-makunbound ((sc acache-store-controller) instance name) (declare (optimize (speed 3) (safety 1))) (remove-from-map (controller-slots sc) (fast-key (oid instance) name)))

--- /project/elephant/cvsroot/elephant/src/db-acache/acache-transactions.lisp 2006/02/20 21:21:41 NONE +++ /project/elephant/cvsroot/elephant/src/db-acache/acache-transactions.lisp 2006/02/20 21:21:41 1.1

(in-package :elephant-acache)

(defmethod controller-start-transaction ((sc acache-store-controller) &key parent &allow-other-keys) "Allegrocache has implicit transactions whenever there's a write" (when parent (error "ACache backend does not allow nested transactions...a commit will commit everything since the last commit")) t)

(defmethod controller-commit-transaction ((sc acache-store-controller) &key &allow-other-keys) (db.allegrocache:commit :db (controller-db sc)))

(defmethod controller-abort-transaction ((sc acache-store-controller) &key &allow-other-keys) (db.allegrocache:rollback :db (controller-db sc)))

(defmethod execute-transaction ((sc acache-store-controller) closure &key parent retries &allow-other-keys) (db.allegrocache:with-transaction-restart (:count retries) (funcall closure) (db.allegrocache:commit :db sc)))--- /project/elephant/cvsroot/elephant/src/db-acache/package.lisp 2006/02/20 21:21:41 NONE +++ /project/elephant/cvsroot/elephant/src/db-acache/package.lisp 2006/02/20 21:21:41 1.1

(in-package :cl-user)

(eval-when (:load-toplevel :compile-toplevel) (require :acache))

(eval-when (:load-toplevel) (warn "Allegrocache support is incomplete and should be considered as an example only"))

(defpackage elephant-acache (:documentation "A low-level UFFI-based interface to Berkeley DB / Sleepycat to implement the elephant front-end framework. Uses the libsleepycat.c wrapper. Partly intended to be usable outside Elephant, but with some magic for Elephant. In general there is a 1-1 mapping from functions here and functions in Sleepycat, so refer to their documentation for details.") (:use common-lisp elephant elephant-backend) (:import-from #:db.allegrocache #:ac-map #:ac-map-name #:doclass #:commit #:retrieve-from-index #:map-map #:map-value #:remove-from-map))