X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fclasses.lisp;h=4c11dbea69b0a235882046e0776c5b50157761f9;hb=5990bfce392a05c10237d4f97b008c4f828028e5;hp=c2cd651317291031fb6b82fcc59646db951bc6d0;hpb=967266c94b00f91e5967b8330fe2b9134b0c0447;p=clsql.git diff --git a/sql/classes.lisp b/sql/classes.lisp index c2cd651..4c11dbe 100644 --- a/sql/classes.lisp +++ b/sql/classes.lisp @@ -13,7 +13,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-sys) +(in-package #:clsql) (defvar +empty-string+ "''") @@ -147,11 +147,21 @@ (with-slots (qualifier name type params) expr (if (and (not qualifier) (not type)) - (write-string (sql-escape (convert-to-db-default-case (symbol-name name) database)) *sql-stream*) + (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~]" - (if qualifier (sql-escape qualifier) qualifier) + (when qualifier + (convert-to-db-default-case (sql-escape qualifier) database)) (sql-escape (convert-to-db-default-case name database)) - type)) + (when type + (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) @@ -170,7 +180,7 @@ (declare (ignore environment)) (with-slots (alias name) sql - `(make-instance 'sql-ident-table :name name :alias ',alias))) + `(make-instance 'sql-ident-table :name ',name :table-alias ',alias))) (defun generate-sql (expr database) (let ((*sql-stream* (make-string-output-stream))) @@ -432,23 +442,31 @@ uninclusive, and the args from that keyword to the end." (subseq select-args first-key-arg)) select-args))) -(defmethod make-query (&rest args) - (multiple-value-bind (selections arglist) - (query-get-selections args) - (destructuring-bind (&key all flatp set-operation distinct from where - group-by having order-by order-by-descending - offset limit &allow-other-keys) - arglist - (if (null selections) - (error "No target columns supplied to select statement.")) - (if (null from) - (error "No source tables supplied to select statement.")) - (make-instance 'sql-query :selections selections - :all all :flatp flatp :set-operation set-operation - :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)))) +(defun make-query (&rest args) + (flet ((select-objects (target-args) + (and target-args + (every #'(lambda (arg) + (and (symbolp arg) + (find-class arg nil))) + target-args)))) + (multiple-value-bind (selections arglist) + (query-get-selections args) + (if (select-objects selections) + (apply #'select args) + (destructuring-bind (&key all flatp set-operation distinct from where + group-by having order-by order-by-descending + offset limit &allow-other-keys) + arglist + (if (null selections) + (error "No target columns supplied to select statement.")) + (if (null from) + (error "No source tables supplied to select statement.")) + (make-instance 'sql-query :selections selections + :all all :flatp flatp :set-operation set-operation + :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)))))) (defvar *in-subselect* nil) @@ -690,8 +708,9 @@ uninclusive, and the args from that keyword to the end." ;; Column constraint types ;; (defparameter *constraint-types* - '(("NOT-NULL" . "NOT NULL") - ("PRIMARY-KEY" . "PRIMARY KEY"))) + (list + (cons (symbol-name-default-case "NOT-NULL") "NOT NULL") + (cons (symbol-name-default-case "PRIMARY-KEY") "PRIMARY KEY"))) ;; ;; Convert type spec to sql syntax