X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fexpressions.lisp;h=16bf687567ebc75e7dec65ed895ed5de92fda40b;hp=cb8046fb09b6fb9e38bfbac3a14d8f38a8c4bf13;hb=4332610851d855ebc858f231f06cff81c675e5f2;hpb=7df5c123266275ba2666cc2637d9a30d4b65d6df

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index cb8046f..16bf687 100644
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -68,6 +68,14 @@
                             #\^ #\& #\* #\| #\( #\) #\- #\+ #\< #\>
                             #\{ #\}))))
 
+(defun special-cased-symbol-p (sym)
+  "Should the symbols case be preserved, or should we convert to default casing"
+  (let ((name (symbol-name sym)))
+    (case (readtable-case *readtable*)
+      (:upcase (not (string= (string-upcase name) name)))
+      (:downcase (not (string= (string-downcase name) name)))
+      (t t))))
+
 (defun %make-database-identifier (inp &optional database)
   "We want to quote an identifier if it came to us as a string or if it has special characters
    in it."
@@ -88,8 +96,12 @@
       (symbol
        (let ((s (sql-escape inp)))
          (if (and (not (eql '* inp)) (special-char-p s))
-             (%escape-identifier (convert-to-db-default-case s database) inp)
-             (make-instance '%database-identifier :escaped s :unescaped inp)))))))
+             (%escape-identifier
+              (if (special-cased-symbol-p inp)
+                  s
+                  (convert-to-db-default-case s database)) inp)
+             (make-instance '%database-identifier :escaped s :unescaped inp))
+         )))))
 
 (defun combine-database-identifiers (ids &optional (database clsql-sys:*default-database*)
                                      &aux res all-sym? pkg)
@@ -237,6 +249,10 @@
   (declare (ignore sql))
   nil)
 
+(defmethod collect-table-refs ((sql list))
+  (loop for i in sql
+        appending (listify (collect-table-refs i))))
+
 (defmethod collect-table-refs ((sql sql-ident-attribute))
   (let ((qual (slot-value sql 'qualifier)))
     (when qual
@@ -274,6 +290,9 @@
     sql
     `(make-instance 'sql-ident-table :name ',name :table-alias ',alias)))
 
+(defmethod collect-table-refs ((sql sql-ident-table))
+  (list sql))
+
 (defmethod output-sql ((expr sql-ident-table) database)
   (with-slots (name alias) expr
     (flet ((p (s) ;; the etypecase is in sql-escape too
@@ -1092,17 +1111,20 @@ uninclusive, and the args from that keyword to the end."
    ))
 
 (defmethod database-constraint-statement (constraint-list database)
-  (declare (ignore database))
-  (make-constraints-description constraint-list))
+  (make-constraints-description constraint-list database))
+
+(defmethod database-translate-constraint (constraint database)
+  (assoc (symbol-name constraint)
+	 *constraint-types*
+	 :test #'equal))
 
-(defun make-constraints-description (constraint-list)
+(defun make-constraints-description (constraint-list database)
   (if constraint-list
       (let ((string ""))
         (do ((constraint constraint-list (cdr constraint)))
             ((null constraint) string)
-          (let ((output (assoc (symbol-name (car constraint))
-                               *constraint-types*
-                               :test #'equal)))
+          (let ((output (database-translate-constraint (car constraint)
+						       database)))
             (if (null output)
                 (error 'sql-user-error
                        :message (format nil "unsupported column constraint '~A'"
@@ -1116,7 +1138,7 @@ uninclusive, and the args from that keyword to the end."
 
 (defmethod database-identifier ( name  &optional database find-class-p
                                  &aux cls)
-  "A function that takes whatever you give it, recurively coerces it,
+  "A function that takes whatever you give it, recursively coerces it,
    and returns a database-identifier.
 
    (escaped-database-identifiers *any-reasonable-object*) should be called to
@@ -1139,6 +1161,7 @@ uninclusive, and the args from that keyword to the end."
             a new db-id with that string as escaped"
            (let ((s (sql-output id database)))
              (make-instance '%database-identifier :escaped s :unescaped s))))
+    (setf name (dequote name))
     (etypecase name
       (null nil)
       (string (%make-database-identifier name database))
@@ -1169,3 +1192,51 @@ uninclusive, and the args from that keyword to the end."
       (%sql-expression (flatten-id name))
       )))
 
+(defun %clsql-subclauses (clauses)
+  "a helper for dealing with lists of sql clauses"
+  (loop for c in clauses
+        when c
+        collect (typecase c
+                  (string (clsql-sys:sql-expression :string c))
+                  (T c))))
+
+(defun clsql-ands (clauses)
+  "Correctly creates a sql 'and' expression for the clauses
+    ignores any nil clauses
+    returns a single child expression if there is only one
+    returns an 'and' expression if there are many
+    returns nil if there are no children"
+  (let ((ex (%clsql-subclauses clauses)))
+    (when ex
+      (case (length ex)
+        (1 (first ex))
+        (t (apply #'clsql-sys:sql-and ex))))))
+
+(defun clsql-and (&rest clauses)
+  "Correctly creates a sql 'and' expression for the clauses
+    ignores any nil clauses
+    returns a single child expression if there is only one
+    returns an 'and' expression if there are many
+    returns nil if there are no children"
+  (clsql-ands clauses))
+
+(defun clsql-ors (clauses)
+  "Correctly creates a sql 'or' expression for the clauses
+    ignores any nil clauses
+    returns a single child expression if there is only one
+    returns an 'or' expression if there are many
+    returns nil if there are no children"
+  (let ((ex (%clsql-subclauses clauses)))
+    (when ex
+      (case (length ex)
+        (1 (first ex))
+        (t (apply #'clsql-sys:sql-or ex))))))
+
+(defun clsql-or (&rest clauses)
+  "Correctly creates a sql 'or' expression for the clauses
+    ignores any nil clauses
+    returns a single child expression if there is only one
+    returns an 'or' expression if there are many
+    returns nil if there are no children"
+  (clsql-ors clauses))
+