[elephant-cvs] CVS elephant/src/db-clsql
rread
rread at common-lisp.net
Thu Feb 8 22:33:35 UTC 2007
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
- ;; ))
)
)
)
More information about the Elephant-cvs
mailing list