`(make-instance 'sql-ident :name ',name)))
(defmethod output-sql ((expr sql-ident) database)
+
(with-slots (name) expr
(write-string
(etypecase name
: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 (sql-escape qualifier))))
- (typecase name
- (string (format nil "~s" (sql-escape name)))
- (t (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)
;; should do arity checking of subexpressions
(defmethod output-sql ((expr sql-relational-exp) database)
+ (with-slots (operator sub-expressions)
+ 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)
+ ()
+ (:documentation "An SQL relational expression."))
+
+(defmethod output-sql ((expr sql-array-exp) database)
(with-slots (operator sub-expressions)
expr
(let ((subs (if (consp (car sub-expressions))
(car sub-expressions)
sub-expressions)))
(write-char #\( *sql-stream*)
+ (output-sql operator database)
+ (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 #\, *sql-stream*)
(write-char #\Space *sql-stream*))
+ (write-char #\] *sql-stream*)
(write-char #\) *sql-stream*)))
t)
(write-string "SELECT " *sql-stream*)
(when all
(write-string "ALL " *sql-stream*))
+ (when (and limit (eq :odbc (database-type database)))
+ (write-string " TOP " *sql-stream*)
+ (output-sql limit database))
(when (and distinct (not all))
(write-string "DISTINCT " *sql-stream*)
(unless (eql t distinct)
(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)
(when (cdr order)
(write-char #\, *sql-stream*))))
(output-sql order-by database)))
- (when limit
+ (when (and limit (not (eq :odbc (database-type database))))
(write-string " LIMIT " *sql-stream*)
(output-sql limit database))
(when offset