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)))