X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fobjects.lisp;h=e6a9457a9dacf8fa2d00b814b37ba9fed7aedc96;hb=b2ff4969e20cce173d403de7542d5bf0e46938d7;hp=5e36e758bf9ed8b33c93f9280465fa0e0a928d67;hpb=3a3ccc7a171dc4c6c10bc7e3fea8461fca6dc51b;p=clsql.git

diff --git a/sql/objects.lisp b/sql/objects.lisp
index 5e36e75..e6a9457 100644
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -690,7 +690,11 @@ superclass of the newly-defined View Class."
 (defmethod read-sql-value (val (type (eql 'float)) database)
   (declare (ignore database))
   ;; writing 1.0 writes 1, so we we *really* want a float, must do (float ...)
-  (float (read-from-string val))) 
+  (etypecase val
+    (string
+     (float (read-from-string val)))
+    (float
+     val)))
 
 (defmethod read-sql-value (val (type (eql 'boolean)) database)
   (case (database-underlying-type database)
@@ -804,6 +808,13 @@ superclass of the newly-defined View Class."
 		     :from (sql-expression :table jc-view-table)
 		     :where jq)))))))
 
+
+;;; Remote Joins
+
+(defvar *default-update-objects-max-len* nil
+  "The default maximum number of objects supplying data for a
+  query when updating remote joins.")
+
 (defun update-object-joins (objects &key (slots t) (force-p t)
 			    class-name (max-len *default-update-objects-max-len*))
   "Updates the remote join slots, that is those slots defined without
@@ -1017,16 +1028,7 @@ superclass of the newly-defined View Class."
 						 :test #'tables-equal)))
 	   (order-by-slots (mapcar #'(lambda (ob) (if (atom ob) ob (car ob)))
 				   (listify order-by))))
-				    
 				 
-      (when (and order-by-slots (= 1 (length tables)))
-	;; Add explicity table name if not specified and only one selected table
-	(let ((table-name (sql-output (car tables) database)))
-	  (loop for i from 0 below (length order-by-slots)
-	      do (when (typep (nth i order-by-slots) 'sql-ident-attribute)
-		   (unless (slot-value (nth i order-by-slots) 'qualifier)
-		     (setf (slot-value (nth i order-by-slots) 'qualifier) table-name)))))) 
-	
       (dolist (ob order-by-slots)
 	(when (and ob (not (member ob (mapcar #'cdr fullsels)
 				   :test #'ref-equal)))
@@ -1124,15 +1126,38 @@ ENABLE-SQL-READER-SYNTAX."
                        target-args))))
     (multiple-value-bind (target-args qualifier-args)
         (query-get-selections select-all-args)
+      (unless (or *default-database* (getf qualifier-args :database))
+	(signal-no-database-error nil))
+   
 	(cond
 	  ((select-objects target-args)
 	   (let ((caching (getf qualifier-args :caching t))
 		 (result-types (getf qualifier-args :result-types :auto))
 		 (refresh (getf qualifier-args :refresh nil))
-		 (database (or (getf qualifier-args :database) *default-database*)))
+		 (database (or (getf qualifier-args :database) *default-database*))
+		 (order-by (getf qualifier-args :order-by)))
 	     (remf qualifier-args :caching)
 	     (remf qualifier-args :refresh)
 	     (remf qualifier-args :result-types)
+	     
+	     
+	     ;; Add explicity table name to order-by if not specified and only
+	     ;; one selected table. This is required so FIND-ALL won't duplicate
+	     ;; the field
+	     (when (and order-by (= 1 (length target-args)))
+	       (let ((table-name  (view-table (find-class (car target-args))))
+		     (order-by-list (copy-seq (listify order-by))))
+		 
+		 (loop for i from 0 below (length order-by-list)
+		     do (etypecase (nth i order-by-list)
+			  (sql-ident-attribute
+			   (unless (slot-value (nth i order-by-list) 'qualifier)
+			     (setf (slot-value (nth i order-by-list) 'qualifier) table-name)))
+			  (cons
+			   (unless (slot-value (car (nth i order-by-list)) 'qualifier)
+			     (setf (slot-value (car (nth i order-by-list)) 'qualifier) table-name)))))
+		 (setf (getf qualifier-args :order-by) order-by-list)))
+	
 	     (cond
 	       ((null caching)
 		(apply #'find-all target-args
@@ -1187,6 +1212,7 @@ ENABLE-SQL-READER-SYNTAX."
 	    (when value
 	      (push (list arg
 			  (typecase value
+			    (cons (cons (sql (car value)) (cdr value)))
 			    (%sql-expression (sql value))
 			    (t value)))
 		    results))))))