sql
`(make-instance 'sql-ident-table :name ',name :table-alias ',alias)))
-(defun generate-sql (expr database)
- (let ((*sql-stream* (make-string-output-stream)))
- (output-sql expr database)
- (get-output-stream-string *sql-stream*)))
-
(defmethod output-sql ((expr sql-ident-table) database)
(with-slots (name alias)
expr
:test (lambda (tab1 tab2)
(equal (slot-value tab1 'name)
(slot-value tab2 'name))))))
+(defvar *in-subselect* nil)
(defmethod output-sql ((expr sql-function-exp) database)
(with-slots (name args)
:group-by group-by :having having :order-by order-by
:inner-join inner-join :on on))))))
-(defvar *in-subselect* nil)
-
(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)
(output-sql (apply #'vector selections) database)
(when from
(write-string " FROM " *sql-stream*)
- (typecase from
- (list (output-sql (apply #'vector from) database))
- (string (write-string from *sql-stream*))
- (t (output-sql from database))))
+ (flet ((ident-table-equal (a b)
+ (and (if (and (eql (type-of a) 'sql-ident-table)
+ (eql (type-of b) 'sql-ident-table))
+ (string-equal (slot-value a 'alias)
+ (slot-value b 'alias))
+ t)
+ (string-equal (symbol-name (slot-value a 'name))
+ (symbol-name (slot-value b 'name))))))
+ (typecase from
+ (list (output-sql (apply #'vector
+ (remove-duplicates from
+ :test #'ident-table-equal))
+ database))
+ (string (write-string from *sql-stream*))
+ (t (output-sql from database)))))
(when inner-join
(write-string " INNER JOIN " *sql-stream*)
(output-sql inner-join database))
(cons (symbol-name-default-case "NOT") "NOT")
(cons (symbol-name-default-case "NULL") "NULL")
(cons (symbol-name-default-case "PRIMARY") "PRIMARY")
- (cons (symbol-name-default-case "KEY") "KEY")))
+ (cons (symbol-name-default-case "KEY") "KEY")
+ (cons (symbol-name-default-case "UNSIGNED") "UNSIGNED")
+ (cons (symbol-name-default-case "ZEROFILL") "ZEROFILL")
+ (cons (symbol-name-default-case "AUTO-INCREMENT") "AUTO_INCREMENT")
+ (cons (symbol-name-default-case "UNIQUE") "UNIQUE")))
;;
;; Convert type spec to sql syntax
;;
-(defmethod database-constraint-description (constraint database)
- (declare (ignore database))
- (let ((output (assoc (symbol-name constraint) *constraint-types*
- :test #'equal)))
- (if (null output)
- (error 'sql-user-error
- :message (format nil "unsupported column constraint '~A'"
- constraint))
- (cdr output))))
-
(defmethod database-constraint-statement (constraint-list database)
(declare (ignore database))
(make-constraints-description constraint-list))