+14 Sep 2007 Kevin Rosenberg <kevin@rosenberg.net>
+ * Version 4.0.0: Major version increase to warn of potential
+ backwards incompatibility.
+ * NEWS: Document potentional backward incompatible changes
+ * db-mysql/mysql-sql.lisp: Changes session SQL mode to ANSI immediately
+ after connecting. This may break compatibility with some applications
+ who are using non-ANSI features with MySQL. This change is required to
+ properly support view-classes using a string as their :base-table
+ attribute. This allows users to specify the case of table names.
+ This is feature is even more essential for MySQL itself since MySQL
+ uses case-sensitive table names. Use connection-based database-create
+ and database-destroy rather than trying to invoke command-line mysql
+ utility. Remove automatic upcasing of strings from list-indices.
+ * db-postgresql/postgresql-sql.lisp: Use connection-based
+ database-create and database-destroy rather than trying to invoke
+ command-line utilities.
+ * db-postgresql-socket/postgresql-socket-sql.lisp: Use
+ database-execute-command rather than execute-command for
+ database-{create,destroy}. Connect to postgres database
+ rather than template1 for those database creation/deletion.
+ * sql/metaclasses.lisp: Store the string value of :base-table if a
+ string is provided. Perform sql-escape at time of view-table name
+ creation.
+ * tests/test-init.lisp: Use "ej_join" as a string, rather than a
+ symbol, since "ej_join" is specified as :base-table. Clear the
+ expression output-cache in case the code for generating sql output
+ has changed.
+ * test/test-oodml.lisp: whitespace fix
+ * sql/ooddl.lisp: Use quoted string for primary key constraint if
+ table name is specified as a string.
+ * sql/oodml.lisp: Don't convert a string view-table name to database's
+ default case.
+ * sql/expressions.lisp: Properly handle table and attribute identifiers
+ when they are a string. Do not change case of symbols to match database
+ default case.
+ * sql/operations.lisp: Change multiword symbols to upper case.
+ * sql/fddl.lisp: Quote base-table if a string to preserve case
+ for drop-table and create-table.
+ * tests/test-syntax.lisp: Add tests of low-level string attribute
+ identifiers.
+
20 Jul 2007 Kevin Rosenberg <kevin@rosenberg.net>
* Version 3.8.6
* db-oracle/oracle-loader.lisp: Rework use of ORACLE_HOME directory
* sql/pool.lisp: Remove incorrect keyword
* sql/database.lisp: Rework WITH-DATABASE to not make the database the
default database (reported by Saurabh Nanda and Chaitanya Gupta)
- * doc/ref-connect.lisp: Update the documentation to WITH-DATABASE to emphasis
- that make-default has a default value of nil.
- * sql/transaction.lisp: Adjust commit/rollback messages for Microsoft SQL Server.
- (patch from Nathan Bird)
- * sql/metaclasses.lisp: Use finalize-inheritance hack on SBCL because of trouble with
- def-view-class compilations (patch from Nathan Bird)
+ * doc/ref-connect.lisp: Update the documentation to WITH-DATABASE to
+ emphasis that make-default has a default value of nil.
+ * sql/transaction.lisp: Adjust commit/rollback messages for Microsoft
+ SQL Server. (patch from Nathan Bird)
+ * sql/metaclasses.lisp: Use finalize-inheritance hack on SBCL because
+ of trouble with def-view-class compilations (patch from Nathan Bird)
15 Jul 2007 Kevin Rosenberg <kevin@rosenberg.net>
* Version 3.8.5
+Sep 14 2006
+-----------
+Version 4.0.0 release with incompatible backward change:
+ - using ANSI mode for MySQL backend
+ - reducing case changes in SQL output for symbols which will have an effect
+ for users of mlisp (Allegro "Modern" Lisp) .
+ - Add support for generating quoted strings in SQL output when
+specifying table names as strings rather than symbols. This may have
+an effect on applications that use strings as table names and use
+inconsistent case in the table names. Previously, those varying case
+strings would be mapped to a canonical case unquoted SQL output. But
+to accomodate users which need to specify case in table names, this
+mapping has been removed.
+See ChangeLog entry for details.
+
Dec 30 2006
-----------
Version 3.8.0 released with incompatible backward change. See
:connection-spec connection-spec
:error-id (mysql-errno mysql-ptr)
:message (mysql-error-string mysql-ptr)))
- (make-instance 'mysql-database
- :name (database-name-from-spec connection-spec
- database-type)
- :database-type :mysql
- :connection-spec connection-spec
- :server-info (uffi:convert-from-cstring
- (mysql:mysql-get-server-info mysql-ptr))
- :mysql-ptr mysql-ptr))
+ (let ((db
+ (make-instance 'mysql-database
+ :name (database-name-from-spec connection-spec
+ database-type)
+ :database-type :mysql
+ :connection-spec connection-spec
+ :server-info (uffi:convert-from-cstring
+ (mysql:mysql-get-server-info mysql-ptr))
+ :mysql-ptr mysql-ptr))
+ (cmd "SET SESSION sql_mode='ANSI'"))
+ (if (zerop (mysql-real-query mysql-ptr cmd (expression-length cmd)))
+ db
+ (progn
+ (warn "Error setting ANSI mode for MySQL.")
+ db))))
(when error-occurred (mysql-close mysql-ptr)))))))))
(declare (ignore owner))
(do ((results nil)
(rows (database-query
- (format nil "SHOW INDEX FROM ~A" (string-upcase table))
+ (format nil "SHOW INDEX FROM ~A" table)
database nil nil)
(cdr rows)))
((null rows) (nreverse results))
database :auto nil))))
(defmethod database-create (connection-spec (type (eql :mysql)))
- (destructuring-bind (host name user password &optional port) connection-spec
- (multiple-value-bind (output status)
- (clsql-sys:command-output "mysqladmin create -u~A -p~A -h~A~@[ -P~A~] ~A"
- user password
- (if host host "localhost")
- port name
- name)
- (if (or (not (eql 0 status))
- (and (search "failed" output) (search "error" output)))
- (error 'sql-database-error
- :message
- (format nil "mysql database creation failed with connection-spec ~A."
- connection-spec))
- t))))
+ (destructuring-bind (host name user password) connection-spec
+ (let ((database (database-connect (list host "" user password)
+ type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
+ (unwind-protect
+ (database-execute-command (format nil "create database ~A" name) database)
+ (database-disconnect database)))))
(defmethod database-destroy (connection-spec (type (eql :mysql)))
- (destructuring-bind (host name user password &optional port) connection-spec
- (multiple-value-bind (output status)
- (clsql-sys:command-output "mysqladmin drop -f -u~A -p~A -h~A~@[ -P~A~] ~A"
- user password
- (if host host "localhost")
- port name)
- (if (or (not (eql 0 status))
- (and (search "failed" output) (search "error" output)))
- (error 'sql-database-error
- :message
- (format nil "mysql database deletion failed with connection-spec ~A."
- connection-spec))
- t))))
+ (destructuring-bind (host name user password) connection-spec
+ (let ((database (database-connect (list host "" user password)
+ type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
+ (unwind-protect
+ (database-execute-command (format nil "drop database ~A" name) database)
+ (database-disconnect database)))))
(defmethod database-probe (connection-spec (type (eql :mysql)))
(when (find (second connection-spec) (database-list connection-spec type)
;;;;
;;;; $Id$
;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
+;;;; This file, part of CLSQL, is Copyright (c) 2002-2007 by Kevin M. Rosenberg
;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
(wait-for-query-results (database-connection database)))))))
(defmethod database-create (connection-spec (type (eql :postgresql-socket)))
- (destructuring-bind (host name user password) connection-spec
- (let ((database (database-connect (list host "template1" user password)
+ (destructuring-bind (host name user password &optional port options tty) connection-spec
+ (let ((database (database-connect (list host "postgres" user password)
type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
(unwind-protect
- (execute-command (format nil "create database ~A" name))
+ (database-execute-command (format nil "create database ~A" name) database)
(database-disconnect database)))))
(defmethod database-destroy (connection-spec (type (eql :postgresql-socket)))
- (destructuring-bind (host name user password) connection-spec
- (let ((database (database-connect (list host "template1" user password)
+ (destructuring-bind (host name user password &optional port optional tty) connection-spec
+ (let ((database (database-connect (list host "postgres" user password)
type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
(unwind-protect
- (execute-command (format nil "drop database ~A" name))
+ (database-execute-command (format nil "drop database ~A" name) database)
(database-disconnect database)))))
(defmethod database-create (connection-spec (type (eql :postgresql)))
(destructuring-bind (host name user password) connection-spec
- (declare (ignore user password))
- (multiple-value-bind (output status)
- (clsql-sys:command-output "createdb -h~A ~A"
- (if host host "localhost")
- name)
- (if (or (not (zerop status))
- (search "database creation failed: ERROR:" output))
- (error 'sql-database-error
- :message
- (format nil "createdb failed for postgresql backend with connection spec ~A."
- connection-spec))
- t))))
+ (let ((database (database-connect (list host "postgres" user password)
+ type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
+ (unwind-protect
+ (database-execute-command (format nil "create database ~A" name) database)
+ (database-disconnect database)))))
(defmethod database-destroy (connection-spec (type (eql :postgresql)))
(destructuring-bind (host name user password) connection-spec
- (declare (ignore user password))
- (multiple-value-bind (output status)
- (clsql-sys:command-output "dropdb -h~A ~A"
- (if host host "localhost")
- name)
- (if (or (not (zerop status))
- (search "database removal failed: ERROR:" output))
- (error 'sql-database-error
- :message
- (format nil "dropdb failed for postgresql backend with connection spec ~A."
- connection-spec))
- t))))
+ (let ((database (database-connect (list host "postgres" user password)
+ type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
+ (unwind-protect
+ (database-execute-command (format nil "drop database ~A" name) database)
+ (database-disconnect database)))))
(defmethod database-probe (connection-spec (type (eql :postgresql)))
+cl-sql (4.0.0-1) unstable; urgency=low
+
+ * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Fri, 14 Sep 2007 11:55:03 -0600
+
cl-sql (3.8.6.1-4) unstable; urgency=low
* make package binNMU safe (closes:435968)
(defmethod output-sql ((expr sql-ident) database)
(with-slots (name) expr
(write-string
- (convert-to-db-default-case
- (etypecase name
- (string name)
- (symbol (symbol-name name)))
- database)
+ (etypecase name
+ (string name)
+ (symbol (symbol-name name) database))
*sql-stream*))
t)
(defmethod collect-table-refs ((sql sql-ident-attribute))
(let ((qual (slot-value sql 'qualifier)))
- (if (and qual (symbolp (slot-value sql 'qualifier)))
- (list (make-instance 'sql-ident-table :name
- (slot-value sql 'qualifier))))))
+ (when qual
+ (list (make-instance 'sql-ident-table :name qual)))))
(defmethod make-load-form ((sql sql-ident-attribute) &optional environment)
(declare (ignore environment))
(with-slots (qualifier name type) expr
(if (and (not qualifier) (not type))
(etypecase name
- ;; Honor care of name
(string
(write-string name *sql-stream*))
(symbol
- (write-string (sql-escape (convert-to-db-default-case
- (symbol-name name) database)) *sql-stream*)))
+ (write-string
+ (sql-escape (symbol-name name)) *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))
- (sql-escape (convert-to-db-default-case name database))
+ (sql-escape qualifier))
+ (sql-escape name)
(when type
- (convert-to-db-default-case (symbol-name type) database)))
+ (symbol-name type)))
(format *sql-stream* "~@[~A.~]~A"
(when qualifier
(typecase qualifier
(string (format nil "~s" qualifier))
- (t (convert-to-db-default-case (sql-escape qualifier)
- database))))
- (sql-escape (convert-to-db-default-case name database))))
+ (t (sql-escape qualifier))))
+ (typecase name
+ (string (format nil "~s" (sql-escape name)))
+ (t (sql-escape name)))))
t))
(defmethod output-sql-hash-key ((expr sql-ident-attribute) database)
(defmethod output-sql ((expr sql-ident-table) database)
(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)))))
+ (etypecase name
+ (string
+ (format *sql-stream* "~s" (sql-escape name)))
+ (symbol
+ (write-string (sql-escape name) *sql-stream*)))
+ (when alias
+ (format *sql-stream* " ~s" alias)))
t)
(defmethod output-sql-hash-key ((expr sql-ident-table) database)
(remove-duplicates from
:test #'ident-table-equal))
database))
- (string (write-string from *sql-stream*))
+ (string (format *sql-stream* "~s" (sql-escape from)))
(t (let ((*in-subselect* t))
(output-sql from database))))))
(when inner-join
(write-string "INSERT INTO " *sql-stream*)
(output-sql
(typecase into
- (string (sql-expression :attribute into))
+ (string (sql-expression :table into))
(t into))
database)
(when attributes
(with-slots (name columns modifiers transactions)
stmt
(write-string "CREATE TABLE " *sql-stream*)
- (output-sql name database)
+ (etypecase name
+ (string (format *sql-stream* "~s" (sql-escape name)))
+ (symbol (write-string (sql-escape name) *sql-stream*))
+ (sql-ident (output-sql name database)))
(write-string " (" *sql-stream*)
(do ((column columns (cdr column)))
((null (cdr column))
(defmethod database-output-sql ((sym symbol) database)
(if (null sym)
+null-string+
- (convert-to-db-default-case
- (if (equal (symbol-package sym) keyword-package)
- (concatenate 'string "'" (string sym) "'")
- (symbol-name sym))
- database))))
+ (if (equal (symbol-package sym) keyword-package)
+ (concatenate 'string "'" (string sym) "'")
+ (symbol-name sym)))))
(defmethod database-output-sql ((tee (eql t)) database)
(if database
(defun database-identifier (name database)
(sql-escape (etypecase name
;; honor case of strings
- (string name
- #+nil (convert-to-db-default-case name database))
+ (string name)
(sql-ident (sql-output name database))
(symbol (sql-output name database)))))
constraint expression or a list of such strings. With MySQL
databases, if TRANSACTIONS is t an InnoDB table is created which
supports transactions."
- (let* ((table-name (etypecase name
- (symbol (sql-expression :attribute name))
- (string (sql-expression :attribute name))
- (sql-ident name)))
- (stmt (make-instance 'sql-create-table
- :name table-name
- :columns description
- :modifiers constraints
- :transactions transactions)))
- (execute-command stmt :database database)))
+ (execute-command
+ (make-instance 'sql-create-table
+ :name name
+ :columns description
+ :modifiers constraints
+ :transactions transactions)
+ :database database))
(defun drop-table (name &key (if-does-not-exist :error)
(database *default-database*)
(:error
t))
- ;; Fixme: move to clsql-oracle
- (let ((expr (concatenate 'string "DROP TABLE " table-name)))
+ (let ((expr (etypecase name
+ ;; keep quotes for strings for mixed-case names
+ (string (format nil "DROP TABLE ~S" table-name))
+ ((or symbol sql-ident)
+ (concatenate 'string "DROP TABLE " table-name)))))
+ ;; Fixme: move to clsql-oracle
(when (and (find-package 'clsql-oracle)
(eq :oracle (database-type database))
(eql 10 (slot-value database
(let ((insert (make-instance 'sql-insert :into into)))
(with-slots (attributes values query)
insert
+
(cond ((and vals (not attrs) (not query) (not av-pairs))
(setf values vals))
((and vals attrs (not subquery) (not av-pairs))
(defun table-name-from-arg (arg)
(cond ((symbolp arg)
- arg)
+ (intern (sql-escape arg)))
((typep arg 'sql-ident)
- (slot-value arg 'name))
+ (if (symbolp (slot-value arg 'name))
+ (intern (sql-escape (slot-value arg 'name)))
+ (sql-escape (slot-value arg 'name))))
((stringp arg)
- (intern arg))))
+ (sql-escape arg))))
(defun column-name-from-arg (arg)
(cond ((symbolp arg)
(remove-keyword-arg all-keys :direct-superclasses)))
(call-next-method))
(setf (view-table class)
- (table-name-from-arg (sql-escape (or (and base-table
- (if (listp base-table)
- (car base-table)
- base-table))
- (class-name class)))))
+ (table-name-from-arg (or (and base-table
+ (if (listp base-table)
+ (car base-table)
+ base-table))
+ (class-name class))))
(register-metaclass class (nth (1+ (position :direct-slots all-keys))
all-keys))))
t)
(defmethod database-pkey-constraint ((class standard-db-class) database)
- (let ((keylist (mapcar #'view-class-slot-column (keyslots-for-class class))))
+ (let ((keylist (mapcar #'view-class-slot-column (keyslots-for-class class)))
+ (table (view-table class)))
(when keylist
- (convert-to-db-default-case
- (format nil "CONSTRAINT ~APK PRIMARY KEY~A"
- (sql-output (view-table class) database)
- (sql-output keylist database))
- database))))
+ (etypecase table
+ (string
+ (format nil "CONSTRAINT \"~APK\" PRIMARY KEY~A" table
+ (sql-output keylist database)))
+ ((or symbol sql-ident)
+ (format nil "CONSTRAINT ~APK PRIMARY KEY~A" table
+ (sql-output keylist database)))))))
(defmethod database-generate-column-definition (class slotdef database)
(declare (ignore database class))
(listify order-by)))
(join-where nil))
-
;;(format t "sclasses: ~W~%ijc: ~W~%tables: ~W~%" sclasses immediate-join-classes tables)
(dolist (ob order-by-slots)
;; one selected table. This is required so FIND-ALL won't duplicate
;; the field
(when (and order-by (= 1 (length target-args)))
- (let ((table-name (view-table (find-class (car target-args))))
+ (let ((table-name (view-table (find-class (car target-args))))
(order-by-list (copy-seq (listify order-by))))
(loop for i from 0 below (length order-by-list)
(defsql sql-group-by (:symbol "group-by") (&rest rest)
(make-instance 'sql-query-modifier-exp
- :modifier '|group by| :components rest))
+ :modifier '|GROUP BY| :components rest))
(defsql sql-order-by (:symbol "order-by") (&rest rest)
(make-instance 'sql-query-modifier-exp
- :modifier '|order by| :components rest))
+ :modifier '|ORDER BY| :components rest))
(defsql sql-having (:symbol "having") (&rest rest)
(make-instance 'sql-query-modifier-exp
(prog1
(progn
(clsql:create-table "MyMixedCase" '(([a] integer)))
- (clsql:execute-command "insert into MyMixedCase values (5)")
+ (clsql:execute-command "insert into \"MyMixedCase\" values (5)")
(clsql:insert-records :into "MyMixedCase" :values '(6))
(clsql:select [a] :from "MyMixedCase" :order-by '((a :asc))))
(clsql:drop-table "MyMixedCase"))
(defun run-tests (&key (report-stream *standard-output*) (sexp-report-stream nil))
+ ;; clear SQL-OUTPUT cache
+ (setq clsql-sys::*output-hash* (make-hash-table :test #'equal))
(let ((specs (read-specs))
(*report-stream* report-stream)
(*sexp-report-stream* sexp-report-stream)
(deftest :oodml/uoj/1
(progn
- (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by [ea_join aaddressid]
+ (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
:flatp t))
(dea-list-copy (copy-seq dea-list))
(initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
#.(clsql:locally-enable-sql-reader-syntax)
+
(setq *rt-syntax*
'(
(deftest :syntax/ident/5
(clsql:sql [foo "bar"])
- "FOO \"bar\"")
+ "FOO \"bar\"")
(deftest :syntax/ident/6
(clsql:sql ["foo" bar])
"\"foo\".BAR")
+(deftest :syntax/attribute/1
+ (clsql:sql (clsql:sql-expression :table 'foo :attribute 'bar))
+ "FOO.BAR")
+
+(deftest :syntax/attribute/2
+ (clsql:sql (clsql:sql-expression :table 'foo :attribute "bar"))
+ "FOO.\"bar\"")
+
+(deftest :syntax/attribute/3
+ (clsql:sql (clsql:sql-expression :table "foo" :attribute 'bar))
+ "\"foo\".BAR")
+
+(deftest :syntax/attribute/4
+ (clsql:sql (clsql:sql-expression :table "foo" :attribute "bar"))
+ "\"foo\".\"bar\"")
+
(deftest :syntax/subquery/1
(clsql:sql [any '(3 4)])
(deftest :syntax/group-by/2
(clsql:sql
(clsql-sys::make-query [foo] [bar] [count [foo]]
- :from [table]
- :group-by '([foo] [bar])
- :order-by '([foo] [bar])))
+ :from [table]
+ :group-by '([foo] [bar])
+ :order-by '([foo] [bar])))
"SELECT FOO,BAR,COUNT(FOO) FROM TABLE GROUP BY FOO,BAR ORDER BY FOO,BAR")
"SELECT COUNT(*) FROM EMP")
-(deftest :syntax/expression1
+(deftest :syntax/expression/1
(clsql:sql
(clsql:sql-operation
'select
projects / clsql.git / commitdiff