[elephant-cvs] CVS elephant/src/db-clsql - elephant-cvs@common-lisp.net - mailman3.common-lisp.net

27 Mar 2006

Update of /project/elephant/cvsroot/elephant/src/db-clsql
In directory clnet:/tmp/cvs-serv1800/src/db-clsql
Modified Files:
    sql-controller.lisp 
Log Message:
Subtle bug and performance improvement

--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp	2006/03/01 18:57:34	1.9
+++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp	2006/03/27 20:36:27	1.10
@@ -515,33 +515,46 @@
   (assert (integerp clcn))
   (let* (
     (kbs (serialize-to-base64-string key))
-	;; We want to remove the FIRST value, based on our ordering.
-	;; have little choice but to read everything in and delete based on
-	;; the "value field".
-	(tuples
-	 (clsql::select [value] 
-		 :from [keyvalue]
-		 :where [and [= [clctn_id] clcn] [= [key] kbs]]
-		 :database con
-		 )))
-    (if (< (length tuples) 1)
+	 ;; We want to remove the FIRST value, based on our ordering.
+	 ;; have little choice but to read everything in and delete based on
+	 ;; the "value field".
+	 (tuples
+	  (clsql::select [value] 
+			 :from [keyvalue]
+			 :where [and [= [clctn_id] clcn] [= [key] kbs]]
+			 :database con
+			 ))
+	 (n (length tuples)))
+;;    (format t "num tuples = ~A~%" n)
+    (if (< n 1)
    nil
-	(let ((to-remove
-	       (serialize-to-base64-string 
-		(nth 0 (sort 
-			(mapcar 
-			 #'(lambda (x)
-			     (deserialize-from-base64-string (car x) :sc sc))
-			 tuples)
-			#'my-generic-less-than)))))
+	(let ((to-remove nil))
+	  (dolist (tuple tuples)
+	    (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
-			  )
+				 :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
+;; 				 ))
      )
    )
-    ))
+    )
+  )
(defun sql-remove-key-and-value-from-clcn (clcn key value con)
   (assert (integerp clcn))

    