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

diff --git a/sql/objects.lisp b/sql/objects.lisp
index 869e643..5e36e75 100644
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -317,10 +317,10 @@ superclass of the newly-defined View Class."
          (basetype (if (listp slot-type) (car slot-type) slot-type)))
     (when (and slot-type val)
       (unless (typep val basetype)
-        (error 'clsql-type-error
-               :slotname (slot-definition-name slotdef)
-               :typespec slot-type
-               :value val)))))
+        (error 'sql-user-error
+	       :message
+	       (format nil "Invalid value ~A in slot ~A, not of type ~A."
+		       val (slot-definition-name slotdef) slot-type))))))
 
 ;;
 ;; Called by find-all
@@ -423,7 +423,7 @@ superclass of the newly-defined View Class."
 	(let ((qualifier (key-qualifier-for-instance instance :database vd)))
 	  (delete-records :from vt :where qualifier :database vd)
 	  (setf (slot-value instance 'view-database) nil))
-	(error 'clsql-no-database-error :database nil))))
+	(signal-no-database-error vd))))
 
 (defmethod update-instance-from-records ((instance standard-db-object)
                                          &key (database *default-database*))
@@ -852,6 +852,7 @@ superclass of the newly-defined View Class."
 					       :operator 'in
 					       :sub-expressions (list (sql-expression :attribute foreign-key)
 								      keys))
+				      :result-types :auto
 				      :flatp t)))
 	      (dolist (object objects)
 		(when (or force-p (not (slot-boundp object slotdef-name)))
@@ -968,8 +969,8 @@ superclass of the newly-defined View Class."
 (defun find-all (view-classes 
 		 &rest args
 		 &key all set-operation distinct from where group-by having 
-		      order-by order-by-descending offset limit refresh
-		      flatp result-types inner-join on 
+		      order-by offset limit refresh flatp result-types 
+                      inner-join on 
 		      (database *default-database*)
 		      instances)
   "Called by SELECT to generate object query results when the
@@ -1013,19 +1014,25 @@ superclass of the newly-defined View Class."
 									     jcs))
 								 immediate-join-classes)
 							 sel-tables)
-						 :test #'tables-equal))))
-      (dolist (ob (listify order-by))
+						 :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)))
 	  (setq fullsels 
-		  (append fullsels (mapcar #'(lambda (att) (cons nil att))
-					   (listify ob))))))
-      (dolist (ob (listify order-by-descending))
-	(when (and ob (not (member ob (mapcar #'cdr fullsels)
-				   :test #'ref-equal)))
-	  (setq fullsels 
-		(append fullsels (mapcar #'(lambda (att) (cons nil att))
-					 (listify ob))))))
+	    (append fullsels (mapcar #'(lambda (att) (cons nil att))
+				     order-by-slots)))))
       (dolist (ob (listify distinct))
 	(when (and (typep ob 'sql-ident) 
 		   (not (member ob (mapcar #'cdr fullsels) 
@@ -1120,24 +1127,28 @@ ENABLE-SQL-READER-SYNTAX."
 	(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*)))
 	     (remf qualifier-args :caching)
 	     (remf qualifier-args :refresh)
+	     (remf qualifier-args :result-types)
 	     (cond
 	       ((null caching)
-		(apply #'find-all target-args qualifier-args))
+		(apply #'find-all target-args
+		       (append qualifier-args (list :result-types result-types))))
 	       (t
 		(let ((cached (records-cache-results target-args qualifier-args database)))
 		  (cond
 		    ((and cached (not refresh))
 		     cached)
 		    ((and cached refresh)
-		     (let ((results (apply #'find-all (append (list target-args) qualifier-args `(:instances ,cached)))))
+		     (let ((results (apply #'find-all (append (list target-args) qualifier-args `(:instances ,cached :result-types :auto)))))
 		       (setf (records-cache-results target-args qualifier-args database) results)
 		       results))
 		    (t
-		     (let ((results (apply #'find-all target-args qualifier-args)))
+		     (let ((results (apply #'find-all target-args (append qualifier-args
+									  '(:result-types :auto)))))
 		       (setf (records-cache-results target-args qualifier-args database) results)
 		       results))))))))
 	  (t