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 ;;