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

Modified Files: sql-collections.lisp sql-controller.lisp Log Message: More robust upgrade mechanism, one bug fix, better user of PK

--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/02/02 23:51:58 1.9 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/02/08 22:33:35 1.10 @@ -526,7 +526,7 @@ (let ((cur-pk (get-current-key cursor))) (decf (:sql-crsr-ck cursor)) (if (equal cur-pk (get-current-key cursor)) - (decf (:dp-nmbr cursor)) + (setf (:dp-nmbr cursor) (max 0 (- (:dp-nmbr cursor) 1))) (setf (:dp-nmbr cursor) (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) @@ -593,12 +593,13 @@ (setf (:sql-crsr-ck cursor) (- (length (:sql-crsr-ks cursor)) 1)) (setf (:dp-nmbr cursor) + (max 0 (- (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) (get-con (cursor-btree cursor)) ) - 1)) + 1))) (assert (>= (:dp-nmbr cursor) 0)) (setf (cursor-initialized-p cursor) t) (has-key-value-scnd cursor :returnpk returnpk) @@ -615,10 +616,11 @@ (progn (setf (:sql-crsr-ck cursor) (- (:sql-crsr-ck cursor) (+ 1 (:dp-nmbr cursor)))) (setf (:dp-nmbr cursor) + (max 0 (- (sql-get-from-clcn-cnt (cursor-oid cursor) (get-current-key cursor) (get-con (cursor-btree cursor)) -) 1)) + ) 1))) (has-key-value-scnd cursor :returnpk returnpk)) (cursor-last-x cursor :returnpk returnpk)))

--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2007/02/07 22:54:12 1.17 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2007/02/08 22:33:35 1.18 @@ -34,13 +34,13 @@ ( ;; (db :accessor controller-db :initarg :db :initform nil) (dbcons :accessor controller-db-table :initarg :db :initform nil) + (uses-pk :accessor uses-pk-of :initarg :uses-pk) ) (: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."))

- ;; This should be much more elegant --- but as of Feb. 6, SBCL 1.0.2 has a weird, ;; unpleasant bug when ASDF tries to load this stuff. ;; (defvar *thread-table-lock* nil) @@ -300,6 +300,20 @@ (clsql:table-exists-p [keyvalue] :database con :owner :all) )

+;; Our goal here is to see if the "pk" column exists.... +;; if it does, we can use a certain optimization the sql-get-from-clcn-nth. +;; Post 6.1 versions should have it, but 6.0 versions won't. +;; My goal here is to be as robust as possible; there is no portable way +;; to add a column nicely. If you want to upgrade (which will really only +;; help if you use duplicate keys), then do a migration from your old repository +;; to a new repository. +(defun query-uses-pk (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! + (member "pk" (clsql:list-attributes [keyvalue] :database con :owner :all) + :test 'equal) + ) +

;; This is just an initial version; it is possible that ;; we might someday wish to use blobs instead; certainly, I am @@ -320,6 +334,8 @@ ;; CREATE-SEQUENCE and SEQUENCE-NEXT. That would solve our problem!

;; ALL OF THIS needs to be inside a transaction. + +;; At one time this was conditional, but all NEW repositories should have this. (clsql::create-sequence [serial] :database con) (clsql::query (format nil "create table keyvalue ( @@ -329,19 +345,17 @@ value varchar )") :database con) +;; (clsql::create-table [keyvalue] +;; ;; This is most likely to work with any database system.. +;; '( +;; ([clctn_id] integer :not-null) +;; ([key] text :not-null) +;; ([value] text) +;; ) +;; :database con)

- ;; (clsql::create-table [keyvalue] - - ;; ;; 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)") +;; :constraints '("PRIMARY KEY (clctn_id key)" +;; "UNIQUE (clctn_id,key)")

;; apparently in postgres this is failing pretty awfully because ;; sequence-exists-p return nil and then we get an error that the sequence exists! @@ -412,8 +426,9 @@ ;; 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))) + (with-transaction (:store-controller sc) + (create-keyvalue-table con))) + (setf (uses-pk-of sc) (query-uses-pk con)) (unless (version-table-exists con) (with-transaction (:store-controller sc) (create-version-table con))) @@ -450,8 +465,6 @@

(defmethod reconnect-controller ((sc sql-store-controller)) (clsql:reconnect :database (controller-db sc) :force nil) -;; (setf (controller-db sc) -;; (clsql:reconnect :database (controller-db sc))) )

(defmethod close-controller ((sc sql-store-controller)) @@ -543,17 +556,21 @@ (let* ((con (controller-db sc)) (kbs (serialize-to-base64-string key sc)) - (offsetquery (format nil "select value from keyvalue where clctn_id = ~A and key = '~A' order by pk offset ~A limit 1 " - clcn - kbs - n)) + (offsetquery (if (uses-pk-of sc) + (format nil "select value from keyvalue where clctn_id = ~A and key = '~A' order by pk offset ~A limit 1 " + clcn + kbs + n) + nil)) (tuples - (clsql::query offsetquery :database con) -;; (clsql::select [value] -;; :from [keyvalue] -;; :where [and [= [clctn_id] clcn] [= [key] kbs]] -;; :database con -;; ) + (if (uses-pk-of sc) + (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; @@ -565,21 +582,22 @@ ;; that efficiently without changing the database structure; ;; but that's OK, I could add a column to support that ;; relatively easily later on. - (if tuples - (values (deserialize-from-base64-string (caar tuples) sc) - t) - (values nil nil)) - -;; (if (< n (length tuples)) -;; (values (nth n (sort -;; (mapcar -;; #'(lambda (x) -;; (deserialize-from-base64-string (car x) sc)) -;; tuples) -;; #'my-generic-less-than)) -;; t) -;; (values nil nil)) -)) + (if (uses-pk-of sc) + (if tuples + (values (deserialize-from-base64-string (caar tuples) sc) + t) + (values nil nil)) + (if (< n (length tuples)) + (values (nth n (sort + (mapcar + #'(lambda (x) + (deserialize-from-base64-string (car x) sc)) + tuples) + #'my-generic-less-than)) + t) + (values nil nil)) + ) + ))

(defun sql-get-from-clcn-cnt (clcn key sc) (assert (integerp clcn)) @@ -597,11 +615,20 @@ (assert (integerp clcn)) (let* ((con (controller-db sc)) (tuples - (clsql::select [pk] [key] [value] + (if (uses-pk-of sc) + (clsql::select [pk] [key] [value] :from [keyvalue] :where [and [= [clctn_id] clcn]] :database con - ))) + ) + (clsql::select [key] [value] + :from [keyvalue] + :where [and [= [clctn_id] clcn]] + :database con + ) + ) + ) + ) (mapcar #'(lambda (x) (mapcar #'(lambda (q) (deserialize-from-base64-string q :sc sc)) x)) tuples)))

@@ -678,24 +705,11 @@ (if (or (null to-remove) (my-generic-less-than (car tuple) to-remove)) (setf to-remove (car tuple)))) - ;; (nth 0 (sort - ;; (mapcar - ;; #'(lambda (x) - ;; (deserialize-from-base64-string (car x) :sc sc)) - ;; tuples) - ;; #'my-generic-less-than))))) - ;; (format t "to-remove = ~A~%" to-remove) (clsql::delete-records :from [keyvalue] :where [and [= [clctn_id] clcn] [= [key] kbs] [= [value] to-remove]] :database con ) - ;; (format t "After deletion = ~A~%" - ;; (clsql::select [value] - ;; :from [keyvalue] - ;; :where [and [= [clctn_id] clcn] [= [key] kbs]] - ;; :database con - ;; )) ) ) )