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

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 90b2620..cb8046f 100644
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -128,31 +128,34 @@
   "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*)
   (values))
 
-(defvar *output-hash* (make-hash-table :test #'equal)
-  "For caching generated SQL strings.")
+
+(defvar *output-hash*
+      (make-weak-hash-table :test #'equal)
+  "For caching generated SQL strings, set to NIL to disable."
+  )
 
 (defmethod output-sql :around ((sql t) database)
-  (let* ((hash-key (output-sql-hash-key sql database))
-         (hash-value (when hash-key (gethash hash-key *output-hash*))))
-    (cond ((and hash-key hash-value)
-           (write-string hash-value *sql-stream*))
-          (hash-key
-           (let ((*sql-stream* (make-string-output-stream)))
-             (call-next-method)
-             (setf hash-value (get-output-stream-string *sql-stream*))
-             (setf (gethash hash-key *output-hash*) hash-value))
-           (write-string hash-value *sql-stream*))
-          (t
-           (call-next-method)))))
+  (if (null *output-hash*)
+      (call-next-method)
+      (let* ((hash-key (output-sql-hash-key sql database))
+             (hash-value (when hash-key (gethash hash-key *output-hash*))))
+        (cond ((and hash-key hash-value)
+               (write-string hash-value *sql-stream*))
+              (hash-key
+               (let ((*sql-stream* (make-string-output-stream)))
+                 (call-next-method)
+                 (setf hash-value (get-output-stream-string *sql-stream*))
+                 (setf (gethash hash-key *output-hash*) hash-value))
+               (write-string hash-value *sql-stream*))
+              (t
+               (call-next-method))))))
 
 (defmethod output-sql-hash-key (expr database)
   (declare (ignore expr database))
@@ -254,7 +257,9 @@
   (with-slots (qualifier name type)
       expr
     (list (and database (database-underlying-type database))
-          'sql-ident-attribute qualifier name type)))
+          'sql-ident-attribute
+          (unescaped-database-identifier qualifier)
+          (unescaped-database-identifier name) type)))
 
 ;; For SQL Identifiers for tables
 
@@ -297,7 +302,9 @@
   (with-slots (name alias)
       expr
     (list (and database (database-underlying-type database))
-          'sql-ident-table name alias)))
+          'sql-ident-table
+          (unescaped-database-identifier name)
+          (unescaped-database-identifier alias))))
 
 (defclass sql-relational-exp (%sql-expression)
   ((operator
@@ -326,6 +333,12 @@
 ;; Write SQL for relational operators (like 'AND' and 'OR').
 ;; should do arity checking of subexpressions
 
+(defun %write-operator (operator database)
+  (typecase operator
+    (string (write-string operator *sql-stream*))
+    (symbol (write-string (symbol-name operator) *sql-stream*))
+    (T (output-sql operator database))))
+
 (defmethod output-sql ((expr sql-relational-exp) database)
   (with-slots (operator sub-expressions) expr
      ;; we do this as two runs so as not to emit confusing superflous parentheses
@@ -350,7 +363,9 @@
 	      (loop for str-sub in (rest str-subs)
 		    do
 		 (write-char #\Space *sql-stream*)
-		 (output-sql operator database)
+                 ;; do this so that symbols can be output as database identifiers
+                 ;; rather than allowing symbols to inject sql
+		 (%write-operator operator database)
 		 (write-char #\Space *sql-stream*)
 		 (write-string str-sub *sql-stream*))
 	      (write-char #\) *sql-stream*))
@@ -391,7 +406,7 @@
         ((null (cdr sub)) (output-sql (car sub) database))
       (output-sql (car sub) database)
       (write-char #\Space *sql-stream*)
-      (output-sql operator database)
+      (%write-operator operator database)
       (write-char #\Space *sql-stream*)))
   t)
 
@@ -424,7 +439,14 @@
     (if modifier
         (progn
           (write-char #\( *sql-stream*)
-          (output-sql modifier database)
+          (cond
+            ((sql-operator modifier)
+             (%write-operator modifier database))
+            ((or (stringp modifier) (symbolp modifier))
+             (write-string
+              (escaped-database-identifier modifier)
+              *sql-stream*))
+            (t (output-sql modifier database)))
           (write-char #\Space *sql-stream*)
           (output-sql components database)
           (write-char #\) *sql-stream*))
@@ -464,7 +486,10 @@
 (defmethod output-sql ((expr sql-function-exp) database)
   (with-slots (name args)
     expr
-    (output-sql name database)
+    (typecase name
+      ((or string symbol)
+       (write-string (escaped-database-identifier name) *sql-stream*))
+      (t (output-sql name database)))
     (let ((*in-subselect* nil)) ;; aboid double parens
       (when args (output-sql args database))))
   t)
@@ -494,7 +519,7 @@
       expr
     (%write-operator modifier database)
     (write-string " " *sql-stream*)
-    (output-sql (car components) database)
+    (%write-operator (car components) database)
     (when components
       (mapc #'(lambda (comp)
                 (write-string ", " *sql-stream*)
@@ -525,13 +550,13 @@
                     (car sub-expressions)
                     sub-expressions)))
       (when (= (length subs) 1)
-        (output-sql operator database)
+        (%write-operator 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)
         (write-char #\Space *sql-stream*)
-        (output-sql operator database)
+        (%write-operator operator database)
         (write-char #\Space *sql-stream*))))
   t)
 
@@ -646,6 +671,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)
@@ -685,15 +724,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)
@@ -780,7 +811,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)))
@@ -805,9 +837,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
@@ -839,10 +869,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
@@ -910,7 +939,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)
 
 
@@ -976,9 +1005,9 @@ uninclusive, and the args from that keyword to the end."
   (defmethod database-output-sql ((sym symbol) database)
   (if (null sym)
       +null-string+
-    (if (equal (symbol-package sym) keyword-package)
-        (concatenate 'string "'" (string sym) "'")
-      (symbol-name sym)))))
+      (if (equal (symbol-package sym) keyword-package)
+          (database-output-sql (symbol-name sym) database)
+          (escaped-database-identifier sym)))))
 
 (defmethod database-output-sql ((tee (eql t)) database)
   (if database