Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv22773/src/db-clsql

Modified Files: sql-collections.lisp sql-controller.lisp Log Message: Repairing the use of the serializer for the SQL side

--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/01/19 21:03:30 1.7 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/01/26 14:41:08 1.8 @@ -27,19 +27,17 @@

;; Somehow I suspect that what I am getting back here ;; is actually the main key... - (let* ((sc (get-con bt)) - (con (controller-db sc))) - (let ((pk (sql-get-from-clcn (oid bt) key sc con))) + (let* ((sc (get-con bt))) + (let ((pk (sql-get-from-clcn (oid bt) key sc))) (if pk - (sql-get-from-clcn (oid (primary bt)) pk sc con)) + (sql-get-from-clcn (oid (primary bt)) pk sc)) )))

(defmethod get-primary-key (key (bt sql-btree-index)) (declare (optimize (speed 3))) (let* ((sc (get-con bt)) - (con (controller-db sc)) ) - (sql-get-from-clcn (oid bt) key sc con))) + (sql-get-from-clcn (oid bt) key sc)))

;; My basic strategy is to keep track of a current key @@ -321,9 +319,8 @@ (let* ((cur-pk (aref (:sql-crsr-ks cursor) (:sql-crsr-ck cursor))) (sc (get-con (cursor-btree cursor))) - (con (controller-db sc)) (indexed-pk (sql-get-from-clcn-nth (cursor-oid cursor) cur-pk - sc con + sc (:dp-nmbr cursor)))) (if indexed-pk (let ((v (get-value indexed-pk (primary (cursor-btree cursor))))) @@ -533,8 +530,7 @@ (setf (:dp-nmbr cursor) (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) - (controller-db (get-con (cursor-btree cursor))) - + (get-con (cursor-btree cursor)) )))) (has-key-value-scnd cursor :returnpk returnpk)) (cursor-last-x cursor :returnpk returnpk))) @@ -600,7 +596,7 @@ (- (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) - (controller-db (get-con (cursor-btree cursor))) + (get-con (cursor-btree cursor)) ) 1)) (assert (>= (:dp-nmbr cursor) 0)) @@ -621,7 +617,7 @@ (setf (:dp-nmbr cursor) (- (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) - (controller-db (get-con (cursor-btree cursor))) + (get-con (cursor-btree cursor)) ) 1)) (has-key-value-scnd cursor :returnpk returnpk)) (cursor-last-x cursor :returnpk returnpk))) --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/11/11 18:41:11 1.12 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2007/01/26 14:41:08 1.13 @@ -59,33 +59,29 @@ )

(defmethod get-value (key (bt sql-btree)) - (let* ((sc (get-con bt)) - (con (controller-db sc))) - (sql-get-from-clcn (oid bt) key sc con) + (let* ((sc (get-con bt))) + (sql-get-from-clcn (oid bt) key sc) ) )

(defmethod (setf get-value) (value key (bt sql-btree)) - (let* ((sc (get-con bt)) - (con (controller-db sc))) - (sql-add-to-clcn (oid bt) key value sc con) + (let* ((sc (get-con bt))) + (sql-add-to-clcn (oid bt) key value sc) ) )

(defmethod existsp (key (bt sql-btree)) - (let* ((sc (get-con bt)) - (con (controller-db sc))) - (sql-from-clcn-existsp (oid bt) key con) + (let* ((sc (get-con bt))) + (sql-from-clcn-existsp (oid bt) key sc) ) )

(defmethod remove-kv (key (bt sql-btree)) - (let* ((sc (get-con bt)) - (con (controller-db sc))) + (let* ((sc (get-con bt))) (sql-remove-one-from-clcn (oid bt) key sc - con)) + )) )

@@ -129,8 +125,7 @@ )

(defmethod add-index ((bt sql-indexed-btree) &key index-name key-form populate) - (let* ((sc (get-con bt)) - (con (controller-db sc))) + (let* ((sc (get-con bt))) (if (and (not (null index-name)) (symbolp index-name) (or (symbolp key-form) (listp key-form))) (let ((indices (indices bt)) @@ -146,15 +141,15 @@ #'(lambda (k v) (multiple-value-bind (index? secondary-key) (funcall key-fn index k v) -;; This is a slow, DB cycle intensive operation. It could chunked somehow, -;; I think, probably making it 10 times faster. + ;; This is a slow, DB cycle intensive operation. It could chunked somehow, + ;; I think, probably making it 10 times faster. (when index? (unless (sql-from-clcn-key-and-value-existsp - (oid index) secondary-key k con) + (oid index) secondary-key k sc) (sql-add-to-clcn (oid index) secondary-key k - sc con :insert-only t)) + sc :insert-only t)) ))) bt)))) index) @@ -163,7 +158,6 @@ (defmethod (setf get-value) (value key (bt sql-indexed-btree)) "Set a key / value pair, and update secondary indices." (let* ((sc (get-con bt)) - (con (controller-db sc)) (indices (indices-cache bt))) (with-transaction (:store-controller sc) (maphash @@ -174,15 +168,15 @@ (when index? ;; This duplicates values that are already there... (unless (sql-from-clcn-key-and-value-existsp - (oid index) secondary-key key con) + (oid index) secondary-key key sc) (sql-add-to-clcn (oid index) secondary-key key - sc con :insert-only t)) + sc :insert-only t)) ))) indices) ;; Now we place the actual value - (sql-add-to-clcn (oid bt) key value sc con) + (sql-add-to-clcn (oid bt) key value sc) ) value))

@@ -191,7 +185,7 @@ (declare (optimize (speed 3))) (let* ( (sc (get-con bt)) - (con (controller-db sc))) + ) (with-transaction (:store-controller sc) (let ((value (get-value key bt))) (when value @@ -209,13 +203,13 @@ (sql-remove-key-and-value-from-clcn (oid index) secondary-key key - con) + sc) ;; And furthermore, we have to remove the index entry ;; (remove-kv secondary-key index) ))) indices) ;; Now we place the actual value - (sql-remove-from-clcn (oid bt) key sc con)) + (sql-remove-from-clcn (oid bt) key sc)) ) value))))

@@ -233,6 +227,22 @@ ;; way to recover from that automatically. If it ;; does not exist, return nil so we can create it later!

+ +(defun version-table-exists (con) + ;; we want to use ":owner :all" because we don't really care who created + ;; the table, as long as we have the rights we need! + (clsql:table-exists-p [version] :database con :owner :all) + ) + +(defun create-version-table (con) + ;; ALL OF THIS needs to be inside a transaction. + (clsql::create-table [version] + '( + ([serializerversion] text :not-null) + ) :database con + ) + ) + ;; These functions are probably not cross-database portable... (defun keyvalue-table-exists (con) ;; we want to use ":owner :all" because we don't really care who created @@ -240,6 +250,7 @@ (clsql:table-exists-p [keyvalue] :database con :owner :all) )

+ ;; This is just an initial version; it is possible that ;; we might someday wish to use blobs instead; certainly, I am ;; storing blobs now in the Berkeley-db and we meed to make sure @@ -260,12 +271,15 @@

;; ALL OF THIS needs to be inside a transaction. (clsql::create-table [keyvalue] - '( - ([clctn_id] integer :not-null) - ([key] text :not-null) - ([value] text) - ) :database con - ) + + ;; This is most likely to work with any database system.. + '( + ([clctn_id] integer :not-null) + ([key] text :not-null) + ([value] text) + ) + :database con) + ;; :constraints '("PRIMARY KEY (clctn_id key)" ;; "UNIQUE (clctn_id,key)")

@@ -278,22 +292,46 @@ ;;) ;; (unless (index-exists-p [idx_clctn_id]) (clsql::create-index [idx_clctn_id] :on [keyvalue] - :attributes '([clctn_id]) - :database con) + :attributes '([clctn_id]) + :database con) ;; ) ;; (unless (index-exists-p [idx_key]) (clsql::create-index [idx_key] :on [keyvalue] - :attributes '([key]) - :database con) + :attributes '([key]) + :database con) ;;) ;; This is actually unique ;; (unless (index-exists-p [idx_both]) (clsql:create-index [idx_both] :on [keyvalue] - :attributes '([clctn_id] [key]) - :database con) + :attributes '([clctn_id] [key]) + :database con) ;;) )

+(defmethod database-version ((sc sql-store-controller)) + "A version determination for a given store + controller that is independant of the serializer as the + serializer is dispatched based on the code version which is a + list of the form '(0 6 0)" + (let* ((con (controller-db sc)) + (version (elephant::controller-version-cached sc))) + (if version version + (let ((tuples + (clsql::select [serializerversion] + :from [version] + :database con))) + ;; The table should exists, but there may or may not be a record there... + (setf (elephant::controller-version-cached sc) + (if tuples + (read-from-string (caar tuples)) + (clsql::insert-records :into [version] + :attributes '(serializerversion) + :values (list (format nil "~A" *elephant-code-version*)) + :database con) + ) + ))))) + + (defmethod open-controller ((sc sql-store-controller) ;; At present these three have no meaning &key @@ -304,14 +342,18 @@ (the sql-store-controller (let* ((dbtype (car (second (controller-spec sc)))) (con (clsql:connect (cdr (second (controller-spec sc))) - :database-type dbtype - :if-exists :old))) + :database-type dbtype + :if-exists :old))) (setf (slot-value sc 'db) con) ;; Now we should make sure that the KEYVALUE table exists, and, if ;; it does not, we need to create it.. (unless (keyvalue-table-exists con) (with-transaction (:store-controller sc) (create-keyvalue-table con))) + (unless (version-table-exists con) + (with-transaction (:store-controller sc) + (create-version-table con))) + (elephant::initialize-serializer sc) ;; These should get oid 0 and 1 respectively (setf (slot-value sc 'root) (make-instance 'sql-btree :sc sc :from-oid 0)) (setf (slot-value sc 'class-root) (make-instance 'sql-indexed-btree :sc sc :from-oid 1)) @@ -322,7 +364,7 @@ (defmethod reconnect-controller ((sc sql-store-controller)) (setf (controller-db sc) (clsql:reconnect :database (controller-db sc))) -) + ) (defmethod close-controller ((sc sql-store-controller)) (when (slot-value sc 'db) ;; close the connection @@ -337,7 +379,7 @@ (defmethod next-oid ((sc sql-store-controller )) (let ((con (controller-db sc))) (clsql:sequence-next [persistent_seq] - :database con)) + :database con)) )

;; if add-to-root is a method, then we can make it class dependent... @@ -348,39 +390,39 @@ ;; a proper method myself, but I will give it a name so it doesn't ;; conflict with 'add-to-root. 'add-to-root can remain a convenience symbol, ;; that will end up calling this routine! -(defun sql-add-to-root (key value pgsc con) - (sql-add-to-clcn 0 key value pgsc con) +(defun sql-add-to-root (key value sc) + (sql-add-to-clcn 0 key value sc) )

-(defun sql-add-to-clcn (clcn key value sc con - &key (insert-only nil)) +(defun sql-add-to-clcn (clcn key value sc + &key (insert-only nil)) (declare (ignore sc)) (assert (integerp clcn)) - (let ( + (let ((con (controller-db sc)) (vbs - (serialize-to-base64-string value)) + (serialize-to-base64-string value sc)) (kbs - (serialize-to-base64-string key)) + (serialize-to-base64-string key sc)) ) - (if (and (not insert-only) (sql-from-clcn-existsp clcn key con)) + (if (and (not insert-only) (sql-from-clcn-existsp clcn key sc)) (clsql::update-records [keyvalue] - :av-pairs `((key ,kbs) - (clctn_id ,clcn) - (value ,vbs)) - :where [and [= [clctn_id] clcn] [= [key] kbs]] - :database con) + :av-pairs `((key ,kbs) + (clctn_id ,clcn) + (value ,vbs)) + :where [and [= [clctn_id] clcn] [= [key] kbs]] + :database con) (clsql::insert-records :into [keyvalue] - :attributes '(key clctn_id value) - :values (list kbs clcn vbs) - :database con - )) + :attributes '(key clctn_id value) + :values (list kbs clcn vbs) + :database con + )) ) value )

-(defun sql-get-from-root (key sc con) - (sql-get-from-clcn 0 key sc con) +(defun sql-get-from-root (key sc) + (sql-get-from-clcn 0 key sc) )

;; This is a major difference betwen SQL and BDB: @@ -399,22 +441,29 @@ ;; To do that I have to read in all of the values and deserialized them ;; This could be a good reason to keep the oids out, and separte, in ;; a separate column. -(defun sql-get-from-clcn (clcn key sc con) +(defun sql-get-from-clcn (clcn key sc) (assert (integerp clcn)) - (sql-get-from-clcn-nth clcn key sc con 0) + (sql-get-from-clcn-nth clcn key sc 0) )

-(defun sql-get-from-clcn-nth (clcn key sc con n) +(defun sql-get-from-clcn-nth (clcn key sc n) (assert (and (integerp clcn) (integerp n))) - (let* ( + (let* ((con (controller-db sc)) (kbs - (serialize-to-base64-string key)) + (serialize-to-base64-string key sc)) + (offsetquery (format nil "select value from keyvalue where clctn_id = ~A and key = '~A' order by value offset ~A limit 1 " + clcn + kbs + n)) (tuples - (clsql::select [value] - :from [keyvalue] - :where [and [= [clctn_id] clcn] [= [key] kbs]] - :database con - ))) +;; (clsql::query offsetquery :database con) + (clsql::select [value] + :from [keyvalue] + :where [and [= [clctn_id] clcn] [= [key] kbs]] + :database con + ) + ) + ) ;; Get the lowest value by sorting and taking the first value; ;; this isn't a very good way to do things... ;; Note also that this will be extremely inefficient if @@ -424,95 +473,101 @@ ;; that efficiently without changing the database structure; ;; but that's OK, I could add a column to support that ;; relatively easily later on. +;; (if (and (> (length tuples) 1)) +;; (format t "l = ~A~%" (length tuples)) +;; ) (if (< n (length tuples)) +;; (values (deserialize-from-base64-string (car (nth n tuples)) sc) +;; t) (values (nth n (sort (mapcar #'(lambda (x) - (deserialize-from-base64-string (car x) :sc sc)) + (deserialize-from-base64-string (car x) sc)) tuples) #'my-generic-less-than)) t) (values nil nil))))

-(defun sql-get-from-clcn-cnt (clcn key con) +(defun sql-get-from-clcn-cnt (clcn key sc) (assert (integerp clcn)) - (let* ( - (kbs (serialize-to-base64-string key)) + (let* ((con (controller-db sc)) + (kbs (serialize-to-base64-string key sc)) (tuples (clsql::select [count [value]] - :from [keyvalue]

[244 lines skipped]