[elephant-cvs] CVS elephant/src/db-clsql
ieslick
ieslick at common-lisp.net
Sun Feb 19 16:22:41 UTC 2006
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)))
More information about the Elephant-cvs
mailing list