X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fclasses.lisp;h=4c11dbea69b0a235882046e0776c5b50157761f9;hb=5990bfce392a05c10237d4f97b008c4f828028e5;hp=c6cf764ab9debdfea53a8c2494aa77883702f92d;hpb=cff8a2497b3f111a43d819476b55bfad2b447532;p=clsql.git diff --git a/sql/classes.lisp b/sql/classes.lisp index c6cf764..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))) @@ -433,22 +443,30 @@ uninclusive, and the args from that keyword to the end." select-args))) (defun 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)))) + (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