r9421: Docstrings for table.lisp

[clsql.git] / sql / objects.lisp

diff --git a/sql/objects.lisp b/sql/objects.lisp
index 5e36e758bf9ed8b33c93f9280465fa0e0a928d67..e6a9457a9dacf8fa2d00b814b37ba9fed7aedc96 100644 (file)
--- 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))))))