X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fexpressions.lisp;h=983d4a526bb5667e1eb6fa17f2c6090c15f93823;hb=f5b49cfe271f8c467f74002eaf27e1d93409cdc5;hp=bee6faffafa22dfc543255d3892890a2ce4736cd;hpb=d86f73be9a261b9c071ab905aeff5d1ee30a3f31;p=clsql.git diff --git a/sql/expressions.lisp b/sql/expressions.lisp index bee6faf..983d4a5 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) @@ -128,10 +140,8 @@ "Top-level call for generating SQL strings. Returns an SQL string appropriate for DATABASE which corresponds to the supplied lisp expression SQL-EXPR." - (progv '(*sql-stream*) - `(,(make-string-output-stream)) - (output-sql sql-expr database) - (get-output-stream-string *sql-stream*))) + (with-output-to-string (*sql-stream*) + (output-sql sql-expr database))) (defmethod output-sql (expr database) (write-string (database-output-sql expr database) *sql-stream*) @@ -139,11 +149,9 @@ (defvar *output-hash* - #+sbcl - (make-hash-table :test #'equal :synchronized T :weakness :key-and-value) - #-sbcl - (make-hash-table :test #'equal ) - "For caching generated SQL strings.") + (make-weak-hash-table :test #'equal) + "For caching generated SQL strings, set to NIL to disable." + ) (defmethod output-sql :around ((sql t) database) (if (null *output-hash*) @@ -675,6 +683,20 @@ uninclusive, and the args from that keyword to the end." :group-by group-by :having having :order-by order-by :inner-join inner-join :on on)))))) +(defun output-sql-where-clause (where database) + "ensure that we do not output a \"where\" sql keyword when we will + not output a clause. Also sets *in-subselect* to use SQL + parentheticals as needed." + (when where + (let ((where-out (string-trim + '(#\newline #\space #\tab #\return) + (with-output-to-string (*sql-stream*) + (let ((*in-subselect* t)) + (output-sql where database)))))) + (when (> (length where-out) 0) + (write-string " WHERE " *sql-stream*) + (write-string where-out *sql-stream*))))) + (defmethod output-sql ((query sql-query) database) (with-slots (distinct selections from where group-by having order-by limit offset inner-join on all set-operation) @@ -714,15 +736,7 @@ uninclusive, and the args from that keyword to the end." (when on (write-string " ON " *sql-stream*) (output-sql on database)) - (when where - (let ((where-out (string-trim - '(#\newline #\space #\tab #\return) - (with-output-to-string (*sql-stream*) - (let ((*in-subselect* t)) - (output-sql where database)))))) - (when (> (length where-out) 0) - (write-string " WHERE " *sql-stream*) - (write-string where-out *sql-stream*)))) + (output-sql-where-clause where database) (when group-by (write-string " GROUP BY " *sql-stream*) (if (listp group-by) @@ -809,7 +823,8 @@ uninclusive, and the args from that keyword to the end." (output-sql attributes database)) (when values (write-string " VALUES " *sql-stream*) - (output-sql values database)) + (let ((clsql-sys::*in-subselect* t)) + (output-sql values database))) (when query (write-char #\Space *sql-stream*) (output-sql query database))) @@ -834,9 +849,7 @@ uninclusive, and the args from that keyword to the end." (typecase from ((or symbol string) (write-string (sql-escape from) *sql-stream*)) (t (output-sql from database))) - (when where - (write-string " WHERE " *sql-stream*) - (output-sql where database))) + (output-sql-where-clause where database)) t) ;; UPDATE @@ -868,10 +881,9 @@ uninclusive, and the args from that keyword to the end." (write-string "UPDATE " *sql-stream*) (output-sql table database) (write-string " SET " *sql-stream*) - (output-sql (apply #'vector (update-assignments)) database) - (when where - (write-string " WHERE " *sql-stream*) - (output-sql where database)))) + (let ((clsql-sys::*in-subselect* t)) + (output-sql (apply #'vector (update-assignments)) database)) + (output-sql-where-clause where database))) t) ;; CREATE TABLE @@ -939,7 +951,7 @@ uninclusive, and the args from that keyword to the end." (when (and (eq :mysql (database-underlying-type database)) transactions (db-type-transaction-capable? :mysql database)) - (write-string " Type=InnoDB" *sql-stream*)))) + (write-string " ENGINE=innodb" *sql-stream*)))) t) @@ -1116,7 +1128,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 +1151,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))