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

Modified Files: sql-collections.lisp sql-controller.lisp sql-transaction.lisp Log Message: Further reorg, added auto build of memutil

--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2006/02/19 04:53:00 1.1 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2006/02/19 16:22:40 1.2 @@ -17,8 +17,7 @@ ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;

-(in-package "ELEPHANT") - +(in-package "ELEPHANT-CLSQL")

(defclass sql-btree-index (btree-index sql-btree) () @@ -80,10 +79,10 @@ :oid (cursor-oid cursor) ;; Do we need to so some kind of copy on this collection? :keys (:sql-crsr-ks cursor) - :curkey (:sql-crsr-ck cursor) - :handle (db-cursor-duplicate - (cursor-handle cursor) - :position (cursor-initialized-p cursor)))) + :curkey (:sql-crsr-ck cursor))) +;; :handle (db-cursor-duplicate +;; (cursor-handle cursor) +;; :position (cursor-initialized-p cursor))))

(defmethod cursor-current ((cursor sql-cursor)) (declare (optimize (speed 3))) --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/02/19 05:13:02 1.2 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/02/19 16:22:40 1.3 @@ -19,13 +19,14 @@ (in-package "ELEPHANT")

(defpackage elephant-clsql - (:use :common-lisp :elephant :elephant-memutil :uffi :elephant-backend :cl-base64)) + (:use :common-lisp :uffi :cl-base64 + :elephant :elephant-memutil :elephant-backend ))

(in-package "ELEPHANT-CLSQL")

;;; other clsql packages would have to be added for ;;; non-postgresql databases, see the CL-SQL documentation -(eval-when ( :compile-toplevel :load-toplevel) +(eval-when (:compile-toplevel :load-toplevel) ;; NOTE: Integrate into load process ;; Probably must be customized ... see documentation on installin postgres. (defvar *clsql-foreign-lib-path* "/usr/lib") @@ -40,22 +41,15 @@ ;; to the database called "test" under the user postgress ;; with the psql console first. Then study the authorization ;; and configuration files. - :initform '("localhost.localdomain" "test" "postgres" "") - ) - ) + :initform '("localhost.localdomain" "test" "postgres" "")) + (db :accessor controller-db :initarg :db :initform nil)) (:documentation "Class of objects responsible for the -book-keeping of holding DB handles, the cache, table -creation, counters, locks, the root (for garbage collection,) -et cetera. This is the Postgresql-specific subclass of store-controller.") - ) + book-keeping of holding DB handles, the cache, table + creation, counters, locks, the root (for garbage collection,) + et cetera. This is the Postgresql-specific subclass of store-controller."))

(defmethod build-btree ((sc sql-store-controller)) - (make-sql-btree sc) - ) - -(defmethod get-transaction-macro-symbol ((sc sql-store-controller)) - 'with-transaction-sql - ) + (make-sql-btree sc))

(defun sql-store-spec-p (spec) (and (listp spec) @@ -171,7 +165,7 @@ (when populate (let ((key-fn (key-fn index)) ) - (with-transaction-sql (:store-controller-sql sc) + (with-transaction (:store-controller sc) (map-btree #'(lambda (k v) (multiple-value-bind (index? secondary-key) @@ -193,7 +187,7 @@ (let* ((sc (get-con bt)) (con (controller-db sc)) (indices (indices-cache bt))) - (with-transaction-sql (:store-controller-sql sc) + (with-transaction (:store-controller sc) (maphash #'(lambda (k index) (multiple-value-bind (index? secondary-key) @@ -216,7 +210,7 @@ (let* ( (sc (get-con bt)) (con (controller-db sc))) - (with-transaction-sql (:store-controller-sql sc) + (with-transaction (:store-controller sc) (let ((value (get-value key bt))) (when value (let ((indices (indices-cache bt))) @@ -342,7 +336,8 @@ ;; can put it in a function.... (unless (keyvalue-table-exists con) (create-keyvalue-table con)) - (setf (slot-value sc 'root) (make-sql-btree sc)) + (setf (slot-value sc 'root) (build-btree sc)) + (setf (slot-value sc 'class-root) (build-indexed-btree sc)) ;; Actaully, it would seem here that we must further set the oid ;; of the root tree to 0 to ensure that we read the correct thing ;; when we next opent he controller... --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-transaction.lisp 2006/02/19 04:53:00 1.1 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-transaction.lisp 2006/02/19 16:22:40 1.2 @@ -17,14 +17,14 @@ ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;

+(in-package "ELEPHANT-CLSQL")

-(defun execute-transaction ((sc sql-store-controller) txn-fn args) +(defmethod execute-transaction ((sc sql-store-controller) txn-fn &key &allow-other-keys) "Execute a body with a transaction in place. On success, the transaction is committed. Otherwise, the transaction is aborted. If the body deadlocks, the body is re-executed in a new transaction, retrying a fixed number of iterations. *auto-commit* is false for the body of the transaction." - (declare (ignore args)) ;; SQL doesn't support nested transaction so we lump it all ;; together (if (clsql::in-transaction-p :database (controller-db sc)) @@ -36,8 +36,12 @@ (funcall txn-fn)) (clsql::set-autocommit t)))))

-;; NOTE: Implement this! -(defmethod controller-start-transaction ((sc sql-store-controller) &rest args)) -(defmethod controller-commit-transaction ((sc sql-store-controller)) -(defmethod controller-abort-transaction ((sc sql-store-controller))) +(defmethod controller-start-transaction ((sc sql-store-controller) &key &allow-other-keys) + (clsql:start-transaction :database (controller-db sc))) + +(defmethod controller-commit-transaction ((sc sql-store-controller) &key &allow-other-keys) + (clsql:commit :database (controller-db sc))) + +(defmethod controller-abort-transaction ((sc sql-store-controller) &key &allow-other-keys) + (clsql:rollback :database (controller-db sc)))