X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fexpressions.lisp;h=e62d593ff7a5166b880978099bf0faabe9afbfff;hp=bfb33c1550768270a87533a60350e66d58fc5d65;hb=fc58e4fb7d908985389c86adf57ddee6c1dde5d2;hpb=65a91423955280d081858aadafab379e23b4304f diff --git a/sql/expressions.lisp b/sql/expressions.lisp index bfb33c1..e62d593 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -67,7 +67,8 @@ (defmethod print-object ((self %sql-expression) stream) (print-unreadable-object (self stream :type t) - (write-string (sql-output self) stream))) + (write-string (sql-output self) stream)) + self) ;; For straight up strings @@ -91,7 +92,8 @@ (defmethod print-object ((ident sql) stream) (format stream "#<~S \"~A\">" (type-of ident) - (sql-output ident nil))) + (sql-output ident nil)) + ident) ;; For SQL Identifiers of generic type @@ -196,14 +198,20 @@ `(make-instance 'sql-ident-table :name ',name :table-alias ',alias))) (defmethod output-sql ((expr sql-ident-table) database) - (with-slots (name alias) - expr - (if (null alias) - (write-string (sql-escape (convert-to-db-default-case (symbol-name name) database)) *sql-stream*) - (progn - (write-string (sql-escape (convert-to-db-default-case (symbol-name name) database)) *sql-stream*) - (write-char #\Space *sql-stream*) - (format *sql-stream* "~s" alias)))) + (with-slots (name alias) expr + (let ((namestr (if (symbolp name) + (symbol-name name) + name))) + (if (null alias) + (write-string + (sql-escape (convert-to-db-default-case namestr database)) + *sql-stream*) + (progn + (write-string + (sql-escape (convert-to-db-default-case namestr database)) + *sql-stream*) + (write-char #\Space *sql-stream*) + (format *sql-stream* "~s" alias))))) t) (defmethod output-sql-hash-key ((expr sql-ident-table) database) @@ -354,7 +362,7 @@ (defmethod collect-table-refs ((sql sql-function-exp)) (let ((tabs nil)) - (dolist (exp (slot-value sql 'components)) + (dolist (exp (slot-value sql 'args)) (let ((refs (collect-table-refs exp))) (if refs (setf tabs (append refs tabs))))) (remove-duplicates tabs @@ -692,7 +700,7 @@ uninclusive, and the args from that keyword to the end." stmt (write-string "DELETE FROM " *sql-stream*) (typecase from - (symbol (write-string (sql-escape from) *sql-stream*)) + ((or symbol string) (write-string (sql-escape from) *sql-stream*)) (t (output-sql from database))) (when where (write-string " WHERE " *sql-stream*) @@ -828,9 +836,8 @@ uninclusive, and the args from that keyword to the end." ;; (defmethod database-output-sql ((str string) database) - (declare (ignore database) - (optimize (speed 3) (safety 1) #+cmu (extensions:inhibit-warnings 3)) - (type (simple-array * (*)) str)) + (declare (optimize (speed 3) (safety 1) + #+cmu (extensions:inhibit-warnings 3))) (let ((len (length str))) (declare (type fixnum len)) (cond ((zerop len) @@ -840,7 +847,8 @@ uninclusive, and the args from that keyword to the end." (concatenate 'string "'" str "'")) (t (let ((buf (make-string (+ (* len 2) 2) :initial-element #\'))) - (do* ((i 0 (incf i)) + (declare (simple-string buf)) + (do* ((i 0 (incf i)) (j 1 (incf j))) ((= i len) (subseq buf 0 (1+ j))) (declare (type fixnum i j)) @@ -901,6 +909,10 @@ uninclusive, and the args from that keyword to the end." (declare (ignore database)) (db-timestring self)) +(defmethod database-output-sql ((self date) database) + (declare (ignore database)) + (db-datestring self)) + (defmethod database-output-sql ((self duration) database) (declare (ignore database)) (format nil "'~a'" (duration-timestring self)))