[elephant-cvs] CVS elephant/src/db-clsql

[rread]

Update of /project/elephant/cvsroot/elephant/src/db-clsql
In directory common-lisp:/tmp/cvs-serv13327/src/db-clsql

Modified Files:
	sql-collections.lisp sql-controller.lisp 
Log Message:
New Configuration mechanism.  Minor test changes.  At least to SQL-side fixes.


--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp	2006/02/19 20:06:03	1.3
+++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp	2006/02/22 20:18:51	1.4
@@ -98,6 +98,19 @@
      (string< (format nil "~A" a) (format nil "~A" b)))
     ))
 
+(defun my-generic-at-most (a b)
+  (cond
+    ((and (typep a 'persistent) (typep b 'persistent))
+     (<= (oid a) (oid b))
+     )
+    ((and (numberp a ) (numberp b))
+     (<= a b))
+    ((and (stringp a) (stringp b))
+     (string<= a b))
+    (t
+     (string<= (format nil "~A" a) (format nil "~A" b)))
+    ))
+
 (defmethod cursor-un-init ((cursor sql-cursor) &key (returnpk nil))
   (setf (cursor-initialized-p cursor) nil)
   (if returnpk
@@ -352,17 +365,17 @@
   (let ((idx (position key (:sql-crsr-ks cursor))))
     (if idx
 	(progn
-	(setf (:sql-crsr-ck cursor) idx)
-	(setf (:dp-nmbr cursor) 0)
-	(cursor-current-x cursor :returnpk t))
+	  (setf (:sql-crsr-ck cursor) idx)
+	  (setf (:dp-nmbr cursor) 0)
+	  (cursor-current-x cursor :returnpk t))
 	(cursor-un-init cursor)
-    )))
+	)))
 
 (defun array-index-if (p a)
   (do ((i 0 (1+ i)))
       ((or (not (array-in-bounds-p a i))
 	(funcall p (aref a i)))
-       (if (funcall p (aref a i))
+       (if (and (array-in-bounds-p a i) (funcall p (aref a i)))
 	   i
 	   -1)))
 )
@@ -371,7 +384,7 @@
   (declare (optimize (speed 3)))
   (unless (cursor-initialized-p cursor)
     (cursor-init cursor))
-  (let ((idx (array-index-if #'(lambda (x) (my-generic-less-than key x)) (:sql-crsr-ks cursor))))
+  (let ((idx (array-index-if #'(lambda (x) (my-generic-at-most key x)) (:sql-crsr-ks cursor))))
     (if (<= 0 idx)
 	(progn
 	  (setf (:sql-crsr-ck cursor) idx)
@@ -535,12 +548,16 @@
 )
 
 (defmethod cursor-next-dup-x ((cursor sql-secondary-cursor) &key (returnpk nil))
-  (declare (optimize (speed 3)))
+;;  (declare (optimize (speed 3)))
   (when (cursor-initialized-p cursor)
     (let* ((cur-pk (aref (:sql-crsr-ks cursor)
 			 (:sql-crsr-ck cursor)))
-	   (nxt-pk (aref (:sql-crsr-ks cursor)
-			 (+ 1 (:sql-crsr-ck cursor))))
+	   (nint (+ 1 (:sql-crsr-ck cursor)))
+	   (nxt-pk (if (array-in-bounds-p (:sql-crsr-ks cursor) nint) 
+		       (aref (:sql-crsr-ks cursor)
+			     nint)
+		       -1
+		       ))
 	   )
       (if (equal cur-pk nxt-pk)
 	  (progn
@@ -559,8 +576,12 @@
   (if (cursor-initialized-p cursor)
       (let ((n
 	     (do ((i (:sql-crsr-ck cursor) (1+ i)))
-		 ((not (equal (aref (:sql-crsr-ks cursor) i)
-			      (aref (:sql-crsr-ks cursor) (+ 1 i)))) (+ 1 i)))))
+		 ((or 
+		    (not (array-in-bounds-p (:sql-crsr-ks cursor) (+ i 1)))
+		    (not 
+		     (equal (aref (:sql-crsr-ks cursor) i)
+			    (aref (:sql-crsr-ks cursor) (+ 1 i)))))
+		    (+ 1 i)))))
 	(setf (:sql-crsr-ck cursor) n)
 	(setf (:dp-nmbr cursor) 0)
 	(has-key-value-scnd cursor :returnpk returnpk))
--- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp	2006/02/20 21:21:41	1.6
+++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp	2006/02/22 20:18:51	1.7
@@ -24,24 +24,6 @@
 
 (in-package "ELEPHANT-CLSQL")
 
-;; ISE NOTE: Putting this here results in users having to
-;; modify source code to run which is inadvisable.  My strategy
-;; is to asdf resolve references to local libraries and require
-;; that the user properly install clsql for their chosen SQL 
-;; backend.  If you really want to allow local configuration
-;; for SQL then stick it into ele-sql.asd just as we did for
-;; BDB in ele-bdb.asd.  This note and code should get removed
-;; in 0.6.1 if we have a reasonable strategy
-;;
-;;; other clsql packages would have to be added for 
-;;; non-postgresql databases, see the CL-SQL documentation
-;; (eval-when (:compile-toplevel :load-toplevel)
-;;   ;; NOTE: Integrate into load process
-;;   ;; Probably must be customized ... see documentation on installin postgres.
-;;   (defvar *clsql-foreign-lib-path* "/usr/lib")
-;;   (clsql:push-library-path *clsql-foreign-lib-path*)
-;;   (clsql:push-library-path *elephant-lib-path*))
-
 ;;
 ;; The main SQL Controller Class
 ;;