X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fclasses.lisp;h=62033591985db4e4ab3e64a4b100e81c89e7fc4b;hp=e7bc74e2934fd311b7808f083571ad21db8cb077;hb=155c60b5195d618ef93541699694d57a21be3246;hpb=71ac7a8d3e5bea99472b07fa2a089c7173abb1f7

diff --git a/sql/classes.lisp b/sql/classes.lisp
index e7bc74e..6203359 100644
--- a/sql/classes.lisp
+++ b/sql/classes.lisp
@@ -13,7 +13,7 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
-(in-package #:clsql)
+(in-package #:clsql-sys)
 
 (defvar +empty-string+ "''")
 
@@ -160,7 +160,10 @@
 		(convert-to-db-default-case (symbol-name type) database)))
       (format *sql-stream* "~@[~A.~]~A"
 	      (when qualifier
-		(convert-to-db-default-case (sql-escape qualifier) database))
+                (typecase qualifier 
+                  (string (format nil "~s" qualifier))
+                  (t (convert-to-db-default-case (sql-escape qualifier) 
+                                                 database))))
 	      (sql-escape (convert-to-db-default-case name database))))
     t))
 
@@ -436,6 +439,9 @@
     (let ((subs (if (consp (car sub-expressions))
                     (car sub-expressions)
                     sub-expressions)))
+      (when (= (length subs) 1)
+        (output-sql operator database)
+        (write-char #\Space *sql-stream*))
       (do ((sub subs (cdr sub)))
           ((null (cdr sub)) (output-sql (car sub) database))
         (output-sql (car sub) database)
@@ -481,9 +487,6 @@
    (order-by
     :initarg :order-by
     :initform nil)
-   (order-by-descending
-    :initarg :order-by-descending
-    :initform nil)
    (inner-join
     :initarg :inner-join
     :initform nil)
@@ -514,8 +517,9 @@
 
 (defvar *select-arguments*
   '(:all :database :distinct :flatp :from :group-by :having :order-by
-    :order-by-descending :set-operation :where :offset :limit
-    :inner-join :on))
+    :set-operation :where :offset :limit :inner-join :on
+    ;; below keywords are not a SQL argument, but these keywords may terminate select
+    :caching :refresh))
 
 (defun query-arg-p (sym)
   (member sym *select-arguments*))
@@ -544,7 +548,7 @@ uninclusive, and the args from that keyword to the end."
 			   :flatp flatp :refresh refresh
 			   :exp arglist))
 	  (destructuring-bind (&key all flatp set-operation distinct from where
-				    group-by having order-by order-by-descending
+				    group-by having order-by 
 				    offset limit inner-join on &allow-other-keys)
 	      arglist
 	    (if (null selections)
@@ -556,19 +560,20 @@ uninclusive, and the args from that keyword to the end."
 			   :distinct distinct :from from :where where
 			   :limit limit :offset offset
 			   :group-by group-by :having having :order-by order-by
-			   :order-by-descending order-by-descending
 			   :inner-join inner-join :on on))))))
 
 (defvar *in-subselect* nil)
 
 (defmethod output-sql ((query sql-query) database)
   (with-slots (distinct selections from where group-by having order-by
-                        order-by-descending limit offset inner-join on)
+                        limit offset inner-join on all set-operation) 
       query
     (when *in-subselect*
       (write-string "(" *sql-stream*))
     (write-string "SELECT " *sql-stream*)
-    (when distinct
+    (when all 
+      (write-string "ALL " *sql-stream*))
+    (when (and distinct (not all))
       (write-string "DISTINCT " *sql-stream*)
       (unless (eql t distinct)
         (write-string "ON " *sql-stream*)
@@ -577,9 +582,12 @@ uninclusive, and the args from that keyword to the end."
     (output-sql (apply #'vector selections) database)
     (when from
       (write-string " FROM " *sql-stream*)
-      (if (listp from)
-	  (output-sql (apply #'vector from) database)
-	(output-sql from database)))
+      (typecase from 
+        (list (output-sql (apply #'vector from) database))
+        (string (write-string 
+                 (sql-escape 
+                  (convert-to-db-default-case from database)) *sql-stream*))
+        (t (output-sql from database))))
     (when inner-join
       (write-string " INNER JOIN " *sql-stream*)
       (output-sql inner-join database))
@@ -601,20 +609,16 @@ uninclusive, and the args from that keyword to the end."
       (if (listp order-by)
           (do ((order order-by (cdr order)))
               ((null order))
-            (output-sql (car order) database)
-            (when (cdr order)
-              (write-char #\, *sql-stream*)))
+            (let ((item (car order)))
+              (typecase item 
+                (cons 
+                 (output-sql (car item) database)
+                 (format *sql-stream* " ~A" (cadr item)))
+                (t 
+                 (output-sql item database)))
+              (when (cdr order)
+                (write-char #\, *sql-stream*))))
           (output-sql order-by database)))
-    (when order-by-descending
-      (write-string " ORDER BY " *sql-stream*)
-      (if (listp order-by-descending)
-          (do ((order order-by-descending (cdr order)))
-              ((null order))
-            (output-sql (car order) database)
-            (when (cdr order)
-              (write-char #\, *sql-stream*)))
-          (output-sql order-by-descending database))
-      (write-string " DESC " *sql-stream*))
     (when limit
       (write-string " LIMIT " *sql-stream*)
       (output-sql limit database))
@@ -622,10 +626,14 @@ uninclusive, and the args from that keyword to the end."
       (write-string " OFFSET " *sql-stream*)
       (output-sql offset database))
     (when *in-subselect*
-      (write-string ")" *sql-stream*)))
+      (write-string ")" *sql-stream*))
+    (when set-operation 
+      (write-char #\Space *sql-stream*)
+      (output-sql set-operation database)))
   t)
 
 (defmethod output-sql ((query sql-object-query) database)
+  (declare (ignore database))
   (with-slots (objects)
       query
     (when objects