:type ',type)))
(defmethod output-sql ((expr sql-ident-attribute) database)
- (with-slots (qualifier name type) expr
- (if (and (not qualifier) (not type))
- (etypecase name
- (string
- (write-string name *sql-stream*))
- (symbol
- (write-string
- (sql-escape (symbol-name name)) *sql-stream*)))
-
- ;;; KMR: The TYPE field is used by CommonSQL for type conversion -- it
- ;;; should not be output in SQL statements
- #+ignore
- (format *sql-stream* "~@[~A.~]~A~@[ ~A~]"
- (when qualifier
- (sql-escape qualifier))
- (sql-escape name)
- (when type
- (symbol-name type)))
- (format *sql-stream* "~@[~A.~]~A"
- (when qualifier
- (typecase qualifier
- (string (format nil "~s" qualifier))
- (t (format nil "~s" (sql-escape qualifier)))))
- (typecase name
- (string (format nil "~s" (sql-escape name)))
- (t (format nil "~s" (sql-escape name))))))
- t))
+;;; KMR: The TYPE field is used by CommonSQL for type conversion -- it
+;;; should not be output in SQL statements
+ (let ((*print-pretty* nil))
+ (labels ((quoted-string-p (inp)
+ (and (char-equal #\" (elt inp 0))
+ (char-equal #\" (elt inp (1- (length inp))))))
+ (safety-first (inp)
+ "do our best not to output sql that we can guarantee is invalid.
+ if the ident has a space or quote in it, instead output a quoted
+ identifier containing those chars"
+ (when (and (not (quoted-string-p inp))
+ (find-if
+ (lambda (x) (member x '(#\space #\' #\")
+ :test #'char-equal)) inp))
+ (setf inp (format nil "~s" (substitute "\\\"" "\"" inp :test #'string-equal))))
+ inp))
+ (with-slots (qualifier name type) expr
+ (format *sql-stream* "~@[~a.~]~a"
+ (typecase qualifier
+ (null nil) ; nil is a symbol
+ (string (format nil "~s" qualifier))
+ (symbol (safety-first (sql-escape qualifier))))
+ (typecase name ;; could never get this to be nil without getting another error first
+ (string (format nil "~s" name))
+ (symbol (safety-first (sql-escape name)))))
+ t))))
(defmethod output-sql-hash-key ((expr sql-ident-attribute) database)
(with-slots (qualifier name type)
(defmethod output-sql ((expr sql-relational-exp) database)
(with-slots (operator sub-expressions)
- expr
- (let ((subs (if (consp (car sub-expressions))
- (car sub-expressions)
- sub-expressions)))
- (write-char #\( *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-char #\Space *sql-stream*))
- (write-char #\) *sql-stream*)))
+ expr
+ (when sub-expressions
+ (let ((subs (if (consp (car sub-expressions))
+ (car sub-expressions)
+ sub-expressions)))
+ (write-char #\( *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-char #\Space *sql-stream*))
+ (write-char #\) *sql-stream*))))
t)
(defclass sql-array-exp (sql-relational-exp)
(write-string " ON " *sql-stream*)
(output-sql on database))
(when where
- (write-string " WHERE " *sql-stream*)
- (let ((*in-subselect* t))
- (output-sql where database)))
+ (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*))))
(when group-by
(write-string " GROUP BY " *sql-stream*)
(if (listp group-by)