X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fobjects.lisp;h=af5aaea1c476cbd5f1b8690e5f8b110a8d1b88ef;hb=142e85f6cb0b1305d1f200b27b6ebec8ac7d511a;hp=07652f21c7f77d7712b35ddde07da23a5c945997;hpb=12ad0234eb45fd831c5c905b8428868731ba3c54;p=clsql.git diff --git a/sql/objects.lisp b/sql/objects.lisp index 07652f2..af5aaea 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -1021,16 +1021,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))) @@ -1136,10 +1127,30 @@ ENABLE-SQL-READER-SYNTAX." (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 @@ -1194,6 +1205,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))))))