[elephant-cvs] CVS elephant/src/contrib/eslick/db-acache

[ieslick]

Update of /project/elephant/cvsroot/elephant/src/contrib/eslick/db-acache
In directory clnet:/tmp/cvs-serv8664/src/contrib/eslick/db-acache

Added Files:
	README acache-collections.lisp acache-controller.lisp 
	acache-transactions.lisp package.lisp 
Log Message:
Cleaning up source directory, moving partial projects to contrib


--- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-acache/README	2007/02/04 10:17:20	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-acache/README	2007/02/04 10:17:20	1.1

This directory contains a quick and dirty sketch of an allegrocache
backend, mostly to test out the new backend abstraction.  

Basic btrees work fine but iteration (cursors) are very limited.
I think the best way to go is reverse engineer the db.btree API
and just implement the elephant backend on top of that API.  I
may do this at some point, but not today...

Or better yet, find someone willing to write a btree library in
lisp.  John Fedaro said it wasn't a huge amount of work and can
be done with very high performance in all Common Lisp.

Ian
--- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-acache/acache-collections.lisp	2007/02/04 10:17:20	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-acache/acache-collections.lisp	2007/02/04 10:17:20	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))



;; INDEXED BTREE

(defclass acache-indexed-btree (indexed-btree acache-btree)
  ((indices :accessor indices :initarg :indices :initform (make-hash-table))
   (indices-cache :accessor indices-cache :initarg :indicies-cache :initform nil :transient t))
  (:metaclass persistent-metaclass))

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

(defclass acache-btree-index (btree-index acache-btree) 
  ()
  (:metaclass persistent-metaclass))

(defmethod build-btree-index ((sc acache-store-controller) &key primary key-form)
  (make-instance 'acache-btree-index :primary primary :key-form :sc sc))

;;
;; CURSORS
;;

(defclass acache-cursor (cursor)
  ())

(defmethod make-cursor ((bt acache-btree))
  (make-instance 'acache-cursor))

--- /project/elephant/cvsroot/elephant/src/contrib/eslick/db-acache/acache-controller.lisp	2007/02/04 10:17:20	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-acache/acache-controller.lisp	2007/02/04 10:17:20	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))
  (incf (oid-record-counter (controller-oidrec sc))))

(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/contrib/eslick/db-acache/acache-transactions.lisp	2007/02/04 10:17:20	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-acache/acache-transactions.lisp	2007/02/04 10:17:20	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/contrib/eslick/db-acache/package.lisp	2007/02/04 10:17:20	NONE
+++ /project/elephant/cvsroot/elephant/src/contrib/eslick/db-acache/package.lisp	2007/02/04 10:17:20	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))