[elephant-cvs] CVS elephant/src/db-clsql
rread
rread at common-lisp.net
Fri Jan 26 14:41:09 UTC 2007
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]
More information about the Elephant-cvs
mailing list