X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fclasses.lisp;h=f33a236769d83df592eedf0835d338858bd8d96a;hp=b7cd0c6b95f16157ecfba0748f1d973c372edab8;hb=8a8ee2d7d791b7a3efaed06420802a925d16fca3;hpb=1751e5245c270bd1ee854a98dfe6caa665abe34e diff --git a/sql/classes.lisp b/sql/classes.lisp index b7cd0c6..f33a236 100644 --- a/sql/classes.lisp +++ b/sql/classes.lisp @@ -149,12 +149,19 @@ (if (and (not qualifier) (not type)) (write-string (sql-escape (convert-to-db-default-case (symbol-name name) database)) *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 - (convert-to-db-default-case (sql-escape qualifier) database)) + (convert-to-db-default-case (sql-escape qualifier) database)) (sql-escape (convert-to-db-default-case name database)) (when type - (convert-to-db-default-case (symbol-name type) database)))) + (convert-to-db-default-case (symbol-name type) database))) + (format *sql-stream* "~@[~A.~]~A" + (when qualifier + (convert-to-db-default-case (sql-escape qualifier) database)) + (sql-escape (convert-to-db-default-case name database)))) t)) (defmethod output-sql-hash-key ((expr sql-ident-attribute) database) @@ -371,6 +378,72 @@ (when args (output-sql args database))) t) + +(defclass sql-between-exp (sql-function-exp) + () + (:documentation "An SQL between expression.")) + +(defmethod output-sql ((expr sql-between-exp) database) + (with-slots (name args) + expr + (output-sql (first args) database) + (write-string " BETWEEN " *sql-stream*) + (output-sql (second args) database) + (write-string " AND " *sql-stream*) + (output-sql (third args) database)) + t) + +(defclass sql-query-modifier-exp (%sql-expression) + ((modifier :initarg :modifier :initform nil) + (components :initarg :components :initform nil)) + (:documentation "An SQL query modifier expression.")) + +(defmethod output-sql ((expr sql-query-modifier-exp) database) + (with-slots (modifier components) + expr + (output-sql modifier database) + (write-string " " *sql-stream*) + (output-sql (car components) database) + (when components + (mapc #'(lambda (comp) + (write-string ", " *sql-stream*) + (output-sql comp database)) + (cdr components)))) + t) + +(defclass sql-set-exp (%sql-expression) + ((operator + :initarg :operator + :initform nil) + (sub-expressions + :initarg :sub-expressions + :initform nil)) + (:documentation "An SQL set expression.")) + +(defmethod collect-table-refs ((sql sql-set-exp)) + (let ((tabs nil)) + (dolist (exp (slot-value sql 'sub-expressions)) + (let ((refs (collect-table-refs exp))) + (if refs (setf tabs (append refs tabs))))) + (remove-duplicates tabs + :test (lambda (tab1 tab2) + (equal (slot-value tab1 'name) + (slot-value tab2 'name)))))) + +(defmethod output-sql ((expr sql-set-exp) database) + (with-slots (operator sub-expressions) + expr + (let ((subs (if (consp (car sub-expressions)) + (car sub-expressions) + sub-expressions))) + (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*)))) + t) + (defclass sql-query (%sql-expression) ((selections :initarg :selections @@ -410,9 +483,29 @@ :initform nil) (order-by-descending :initarg :order-by-descending + :initform nil) + (inner-join + :initarg :inner-join + :initform nil) + (on + :initarg :on :initform nil)) (:documentation "An SQL SELECT query.")) +(defclass sql-object-query (%sql-expression) + ((objects + :initarg :objects + :initform nil) + (flatp + :initarg :flatp + :initform nil) + (exp + :initarg :exp + :initform nil) + (refresh + :initarg :refresh + :initform nil))) + (defmethod collect-table-refs ((sql sql-query)) (remove-duplicates (collect-table-refs (slot-value sql 'where)) :test (lambda (tab1 tab2) @@ -421,7 +514,10 @@ (defvar *select-arguments* '(:all :database :distinct :flatp :from :group-by :having :order-by - :order-by-descending :set-operation :where :offset :limit)) + :order-by-descending :set-operation :where :offset :limit + :inner-join :on + ;; below keywords are not a SQL argument, but these keywords may terminate select + :caching :refresh)) (defun query-arg-p (sym) (member sym *select-arguments*)) @@ -445,10 +541,13 @@ uninclusive, and the args from that keyword to the end." (multiple-value-bind (selections arglist) (query-get-selections args) (if (select-objects selections) - (apply #'select args) + (destructuring-bind (&key flatp refresh &allow-other-keys) arglist + (make-instance 'sql-object-query :objects selections + :flatp flatp :refresh refresh + :exp arglist)) (destructuring-bind (&key all flatp set-operation distinct from where group-by having order-by order-by-descending - offset limit &allow-other-keys) + offset limit inner-join on &allow-other-keys) arglist (if (null selections) (error "No target columns supplied to select statement.")) @@ -459,13 +558,14 @@ uninclusive, and the args from that keyword to the end." :distinct distinct :from from :where where :limit limit :offset offset :group-by group-by :having having :order-by order-by - :order-by-descending order-by-descending)))))) + :order-by-descending order-by-descending + :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 - order-by-descending limit offset) + order-by-descending limit offset inner-join on) query (when *in-subselect* (write-string "(" *sql-stream*)) @@ -477,10 +577,17 @@ uninclusive, and the args from that keyword to the end." (output-sql distinct database) (write-char #\Space *sql-stream*))) (output-sql (apply #'vector selections) database) - (write-string " FROM " *sql-stream*) - (if (listp from) - (output-sql (apply #'vector from) database) - (output-sql from database)) + (when from + (write-string " FROM " *sql-stream*) + (if (listp from) + (output-sql (apply #'vector from) database) + (output-sql from database))) + (when inner-join + (write-string " INNER JOIN " *sql-stream*) + (output-sql inner-join database)) + (when on + (write-string " ON " *sql-stream*) + (output-sql on database)) (when where (write-string " WHERE " *sql-stream*) (let ((*in-subselect* t)) @@ -520,6 +627,13 @@ uninclusive, and the args from that keyword to the end." (write-string ")" *sql-stream*))) t) +(defmethod output-sql ((query sql-object-query) database) + (with-slots (objects) + query + (when objects + (format *sql-stream* "(~{~A~^ ~})" objects)))) + + ;; INSERT (defclass sql-insert (%sql-expression) @@ -633,6 +747,7 @@ uninclusive, and the args from that keyword to the end." ;; Here's a real warhorse of a function! +(declaim (inline listify)) (defun listify (x) (if (atom x) (list x)