[elephant-cvs] CVS update: elephant/src/RUNTEST.lisp elephant/src/bdb-enable.lisp elephant/src/controller.lisp elephant/src/metaclasses.lisp elephant/src/serializer.lisp elephant/src/sql-collections.lisp elephant/src/sql-controller.lisp
Robert L. Read
rread at common-lisp.net
Wed Nov 23 03:42:19 UTC 2005
Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp.net:/tmp/cvs-serv32717/src
Modified Files:
Tag: SQL-BACK-END
RUNTEST.lisp bdb-enable.lisp controller.lisp metaclasses.lisp
serializer.lisp sql-collections.lisp sql-controller.lisp
Log Message:
Dan Knapp's patch applied, and other changes in preparation for 0.3 release.
Date: Wed Nov 23 04:42:15 2005
Author: rread
Index: elephant/src/RUNTEST.lisp
diff -u elephant/src/RUNTEST.lisp:1.1.2.1 elephant/src/RUNTEST.lisp:1.1.2.2
--- elephant/src/RUNTEST.lisp:1.1.2.1 Tue Oct 18 22:35:49 2005
+++ elephant/src/RUNTEST.lisp Wed Nov 23 04:42:15 2005
@@ -4,12 +4,22 @@
(asdf:operate 'asdf:load-op :ele-bdb)
(asdf:operate 'asdf:load-op :elephant-tests)
+(asdf:operate 'asdf:load-op :ele-sqlite3)
+
(in-package "ELEPHANT-TESTS")
(do-all-tests)
(do-all-tests-spec *testpg-path*)
(do-migrate-test-spec *testpg-path*)
(do-all-tests-spec *testdb-path*)
+(do-all-tests-spec *testsqlite3-path*)
+
+;; The primary and secondary test-paths are
+;; use for the migration tests.
+(setq *test-path-primary* *testpg-path*)
+(setq *test-path-primary* *testsqlite3-path*)
+(setq *test-path-secondary* *testdb-path*)
+(do-all-tests-spec *test-path-primary*)
(use-package :sb-profile)
Index: elephant/src/bdb-enable.lisp
diff -u elephant/src/bdb-enable.lisp:1.1.2.1 elephant/src/bdb-enable.lisp:1.1.2.2
--- elephant/src/bdb-enable.lisp:1.1.2.1 Tue Oct 18 22:35:49 2005
+++ elephant/src/bdb-enable.lisp Wed Nov 23 04:42:15 2005
@@ -68,7 +68,7 @@
(merge-pathnames
#p"libmemutil.so"
(asdf:component-pathname (asdf:find-system 'elephant)))
- "/usr/local/share/common-lisp/elephant-0.2/libmemutil.so")
+ "/usr/local/share/common-lisp/elephant-0.3/libmemutil.so")
:module "libmemutil")
(error "Couldn't load libmemutil.so!"))
@@ -86,6 +86,10 @@
#+(and (or bsd freebsd) (not darwin))
"/usr/local/lib/db43/libdb.so"
#+darwin
+ ;; for Fink (OS X) -- but I will assume Linux more common...
+ "/sw/lib/libdb-4.3.dylib"
+ ;; a possible manual install
+ #+linux
"/usr/local/BerkeleyDB.4.3/lib/libdb.dylib"
:module "sleepycat")
(error "Couldn't load libdb (Sleepycat)!"))
@@ -97,7 +101,7 @@
(merge-pathnames
#p"libsleepycat.so"
(asdf:component-pathname (asdf:find-system 'elephant)))
- "/usr/local/share/common-lisp/elephant-0.2/libsleepycat.so")
+ "/usr/local/share/common-lisp/elephant-0.3/libsleepycat.so")
:module "libsleepycat")
(error "Couldn't load libsleepycat!"))
Index: elephant/src/controller.lisp
diff -u elephant/src/controller.lisp:1.12.2.1 elephant/src/controller.lisp:1.12.2.2
--- elephant/src/controller.lisp:1.12.2.1 Tue Oct 18 22:41:27 2005
+++ elephant/src/controller.lisp Wed Nov 23 04:42:15 2005
@@ -48,7 +48,7 @@
;; controller from it.
(defvar *strategies* '())
-(defvar *elephant-lib-path* "/usr/local/share/common-lisp/elephant-0.2/")
+(defvar *elephant-lib-path* "/usr/local/share/common-lisp/elephant-0.3/")
(defun register-strategy (spec-to-controller)
(setq *strategies* (delete spec-to-controller *strategies*))
Index: elephant/src/metaclasses.lisp
diff -u elephant/src/metaclasses.lisp:1.7.2.1 elephant/src/metaclasses.lisp:1.7.2.2
--- elephant/src/metaclasses.lisp:1.7.2.1 Tue Oct 18 22:41:27 2005
+++ elephant/src/metaclasses.lisp Wed Nov 23 04:42:15 2005
@@ -58,7 +58,7 @@
(progn
(error "We can't default to *store-controller* in a multi-use enviroment."))
;; (setf (gethash spec *dbconnection-spec*)
- ;; (clsql:connect (:dbcn-spc sc)
+ ;; (clsql:connect (cdr (:dbcn-spc sc))
;; :database-type :postgresql-socket
;; :if-exists :old)))
(error "We don't know how to open a bdb-connection here!")
@@ -76,7 +76,7 @@
;; the connection spec (since the connection might be broken?)
;; It probably would be better to put a string in here in the case
;; of sleepycat...
- (dbonnection-spec-pst :type list :accessor :dbcn-spc-pst :initarg :dbconnection-spec-pst
+ (dbonnection-spec-pst :type (or list string) :accessor :dbcn-spc-pst :initarg :dbconnection-spec-pst
:initform '())
)
(:documentation
Index: elephant/src/serializer.lisp
diff -u elephant/src/serializer.lisp:1.10.2.1 elephant/src/serializer.lisp:1.10.2.2
--- elephant/src/serializer.lisp:1.10.2.1 Tue Oct 18 22:41:27 2005
+++ elephant/src/serializer.lisp Wed Nov 23 04:42:15 2005
@@ -365,18 +365,30 @@
(let ((typedesig (%deserialize bs)))
;; now, depending on what typedesig is, we might
;; or might not need to specify the store controller here..
- (let ((o
- (if (subtypep typedesig 'persistent)
- (make-instance typedesig :sc sc)
- (make-instance typedesig)
- )
- ))
- (setf (gethash id *circularity-hash*) o)
- (loop for i fixnum from 0 below (%deserialize bs)
- do
- (setf (slot-value o (%deserialize bs))
- (%deserialize bs)))
- o)))))
+ (let ((o
+ (or (ignore-errors
+ (if (subtypep typedesig 'persistent)
+ (make-instance typedesig :sc sc)
+ ;; if the this type doesn't exist in our object
+ ;; space, we can't reconstitute it, but we don't want
+ ;; to abort completely, we will return a special object...
+ ;; This behavior could be configurable; the user might
+ ;; prefer an abort here, but I prefer surviving...
+ (make-instance typedesig)
+ )
+ )
+ (list 'uninstantiable-object-of-type typedesig)
+ )
+ ))
+ (if (listp o)
+ o
+ (progn
+ (setf (gethash id *circularity-hash*) o)
+ (loop for i fixnum from 0 below (%deserialize bs)
+ do
+ (setf (slot-value o (%deserialize bs))
+ (%deserialize bs)))
+ o)))))))
((= tag +array+)
(let* ((id (buffer-read-fixnum bs))
(maybe-array (gethash id *circularity-hash*)))
Index: elephant/src/sql-collections.lisp
diff -u elephant/src/sql-collections.lisp:1.1.2.2 elephant/src/sql-collections.lisp:1.1.2.3
--- elephant/src/sql-collections.lisp:1.1.2.2 Wed Nov 2 20:58:11 2005
+++ elephant/src/sql-collections.lisp Wed Nov 23 04:42:15 2005
@@ -60,10 +60,7 @@
(con (controller-db sc)))
(let ((pk (sql-get-from-clcn (oid bt) key sc con)))
(if pk
-;; Can this be right?
- (let ((v (sql-get-from-clcn (oid (primary bt)) pk sc con)))
- (values v T))
- (values nil nil))
+ (sql-get-from-clcn (oid (primary bt)) pk sc con))
)))
(defmethod get-primary-key (key (bt sql-btree-index))
@@ -71,11 +68,7 @@
(let* ((sc (check-con (:dbcn-spc-pst bt)))
(con (controller-db sc))
)
- (let ((pk (sql-get-from-clcn (oid bt) key sc con)))
- (if pk
- (values pk T)
- (values nil nil))
- )))
+ (sql-get-from-clcn (oid bt) key sc con)))
;; My basic strategy is to keep track of a current key
Index: elephant/src/sql-controller.lisp
diff -u elephant/src/sql-controller.lisp:1.1.2.1 elephant/src/sql-controller.lisp:1.1.2.2
--- elephant/src/sql-controller.lisp:1.1.2.1 Tue Oct 18 22:35:50 2005
+++ elephant/src/sql-controller.lisp Wed Nov 23 04:42:15 2005
@@ -144,11 +144,8 @@
(defmethod get-value (key (bt sql-btree))
(let* ((sc (check-con (:dbcn-spc-pst bt)))
- (con (controller-db sc))
- (v (sql-get-from-clcn (oid bt) key sc con)))
- (if v
- (values v t)
- (values nil nil))))
+ (con (controller-db sc)))
+ (sql-get-from-clcn (oid bt) key sc con)))
(defmethod existsp (key (bt sql-btree))
@@ -374,15 +371,14 @@
(recover-fatal nil)
(thread t))
(the sql-store-controller
-
-
-
-
- (let ((con (clsql:connect (:dbcn-spc sc)
+ (let* ((dbtype (car (:dbcn-spc sc)))
+ (con (clsql:connect (cdr (:dbcn-spc sc))
;; WARNING: This line of code forces us to use postgresql.
;; If this were parametrized upwards we could concievably try
;; other backends.
- :database-type :postgresql
+ :database-type dbtype
+;; DNK :postgresql
+;; :database-type :postgresql
:if-exists :old)))
(setf (gethash (:dbcn-spc sc) *dbconnection-spec*) sc)
(setf (slot-value sc 'db) con)
@@ -449,7 +445,7 @@
(kbs
(serialize-to-base64-string key))
)
- (if (and (not insert-only) (sql-get-from-clcn clcn key sc con))
+ (if (and (not insert-only) (sql-from-clcn-existsp clcn key con))
(clsql::update-records [keyvalue]
:av-pairs `((key ,kbs)
(clctn_id ,clcn)
@@ -468,11 +464,7 @@
(defmethod sql-get-from-root (key sc con)
- (let ((v (sql-get-from-clcn 0 key sc con)))
- (if v
- (values v t)
- (values nil nil)))
- )
+ (sql-get-from-clcn 0 key sc con))
;; This is a major difference betwen SQL and BDB:
;; BDB plans to give you one value and let you iterate, but
@@ -512,14 +504,15 @@
;; that efficiently without changing the database structure;
;; but that's OK, I could add a column to support that
;; relatively easily later on.
- (if (< (length tuples) n)
- nil
- (nth n (sort
- (mapcar
- #'(lambda (x)
- (deserialize-from-base64-string (car x) :sc sc))
- tuples)
- #'my-generic-less-than)))))
+ (if (< n (length tuples))
+ (values (nth n (sort
+ (mapcar
+ #'(lambda (x)
+ (deserialize-from-base64-string (car x) :sc sc))
+ tuples)
+ #'my-generic-less-than))
+ t)
+ (values nil nil))))
(defmethod sql-get-from-clcn-cnt ((clcn integer) key con)
(let* (
@@ -544,7 +537,7 @@
tuples)))
(defmethod sql-from-root-existsp (key con)
- (sql-get-from-clcn 0 key con)
+ (sql-from-clcn-existsp 0 key con)
)
(defmethod sql-from-clcn-existsp ((clcn integer) key con)
@@ -637,21 +630,20 @@
;; to change, so I am implementing it only here.
(defmethod persistent-slot-reader-aux ((sc sql-store-controller) instance name)
(let* ((con (controller-db sc)))
- (let ((v
- (sql-get-from-root
- (form-slot-key (oid instance) name)
- sc con
- )))
- (if v
+ (multiple-value-bind (v existsp)
+ (sql-get-from-root
+ (form-slot-key (oid instance) name)
+ sc con)
+ (if existsp
v
(error 'unbound-slot :instance instance :name name))))
)
(defmethod persistent-slot-boundp-aux ((sc sql-store-controller) instance name)
(let* ((con (controller-db sc)))
- (if (sql-get-from-root
+ (if (sql-from-root-existsp
(form-slot-key (oid instance) name)
- sc con )
+ con )
t nil)))
More information about the Elephant-cvs
mailing list