From db9892632e6eb7869aea7a94c16b523a82de1501 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 20 Apr 2004 20:35:38 +0000 Subject: [PATCH] r9113: intial changes for list-table-indexes --- ChangeLog | 10 +++- base/db-interface.lisp | 3 + base/package.lisp | 1 + db-aodbc/aodbc-sql.lisp | 12 ++-- db-mysql/mysql-sql.lisp | 20 +++++-- db-odbc/odbc-api.lisp | 14 +++++ db-odbc/odbc-constants.lisp | 7 ++- db-odbc/odbc-dbi.lisp | 15 +++++ db-odbc/odbc-ff-interface.lisp | 13 +++++ db-odbc/odbc-package.lisp | 1 + db-odbc/odbc-sql.lisp | 30 ++++++++-- .../postgresql-socket-sql.lisp | 56 +++++++++++++----- db-postgresql/postgresql-sql.lisp | 58 ++++++++++++++----- db-sqlite/sqlite-sql.lisp | 11 ++++ sql/package.lisp | 3 + sql/table.lisp | 9 +++ tests/test-fddl.lisp | 38 ++++++++---- 17 files changed, 242 insertions(+), 59 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5d0c375..f3816fe 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,13 @@ 20 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) - * Version 2.8.3: Fix regression test + * Version 2.9.0: New API function: LIST-TABLE-INDEXES, + supported by all database backends (except AODBC since + AODBC doesn't support index querying) + * db-obdc/odbc-sql.lisp: Support DATABASE-LIST-INDEXES + * db-odbc/odbc-api.lisp: Add %TABLE-STATISTICS function + to support index queries + * db-aodbc/aodbc-sql.lisp: Filter driver manager + "information_schema" tables from LIST-TABLES + * tests/test-basic.lisp: Remove table after testing 19 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.8.2: Build changes for FreeBSD [Slawek Zak] diff --git a/base/db-interface.lisp b/base/db-interface.lisp index 7c75dd0..d257a5f 100644 --- a/base/db-interface.lisp +++ b/base/db-interface.lisp @@ -186,6 +186,9 @@ the given lisp type and parameters.")) (defgeneric database-list-indexes (database &key owner) (:documentation "List all indexes in the DATABASE.")) +(defgeneric database-list-table-indexes (table database &key owner) + (:documentation "List all indexes for a table in the DATABASE.")) + (defgeneric database-list-attributes (table database &key owner) (:documentation "List all attributes in TABLE.")) diff --git a/base/package.lisp b/base/package.lisp index 03d1544..daea90f 100644 --- a/base/package.lisp +++ b/base/package.lisp @@ -58,6 +58,7 @@ #:database-list-attributes #:database-list-sequences #:database-list-indexes + #:database-list-table-indexes #:database-list-views diff --git a/db-aodbc/aodbc-sql.lisp b/db-aodbc/aodbc-sql.lisp index 0981591..bbe655e 100644 --- a/db-aodbc/aodbc-sql.lisp +++ b/db-aodbc/aodbc-sql.lisp @@ -194,11 +194,13 @@ #+aodbc-v2 (multiple-value-bind (rows col-names) (dbi:list-all-database-tables :db (database-aodbc-conn database)) - (let ((pos (position "TABLE_NAME" col-names :test #'string-equal))) - (when pos - (loop for row in rows - collect (nth pos row)))))) - + (declare (ignore col-names)) + ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager + ;; TABLE_NAME in third column, TABLE_TYPE in fourth column + (loop for row in rows + when (and (not (string-equal "information_schema" (nth 1 row))) + (string-equal "TABLE" (nth 3 row))) + collect (nth 2 row)))) (defmethod database-list-attributes ((table string) (database aodbc-database) &key (owner nil)) diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index ea66f3d..c047b97 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -274,10 +274,22 @@ &key (owner nil)) (let ((result '())) (dolist (table (database-list-tables database :owner owner) result) - (mapc #'(lambda (index) (push (nth 2 index) result)) - (database-query - (format nil "SHOW INDEX FROM ~A" (string-upcase table)) - database nil))))) + (setq result + (append (database-list-table-indexes table database :owner owner) + result))))) + +(defmethod database-list-table-indexes (table (database mysql-database) + &key (owner nil)) + (declare (ignore owner)) + (do ((results nil) + (rows (database-query + (format nil "SHOW INDEX FROM ~A" (string-upcase table)) + database nil) + (cdr rows))) + ((null rows) (nreverse results)) + (let ((col (nth 2 (car rows)))) + (unless (find col results :test #'string-equal) + (push col results))))) (defmethod database-list-attributes ((table string) (database mysql-database) &key (owner nil)) diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 0f27b57..5ff3d09 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -940,6 +940,20 @@ as possible second argument) to the desired representation of date/time/timestam (with-error-handling (:hstmt hstmt) (SQLTables hstmt +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0))) +(defun %table-statistics (table hstmt &key unique (ensure t)) + (with-cstrings ((table-cs table)) + (with-error-handling (:hstmt hstmt) + (print hstmt) + (print table-cs) + (print (uffi:convert-from-cstring table-cs)) + (SQLStatistics + hstmt + +null-ptr+ 0 + +null-ptr+ 0 + table-cs (length table) ;;$SQL_NTS + (if unique $SQL_INDEX_UNIQUE $SQL_INDEX_ALL) + (if ensure $SQL_ENSURE $SQL_QUICK))))) + (defun %list-data-sources (henv) (let ((dsn (allocate-foreign-string (1+ $SQL_MAX_DSN_LENGTH))) (desc (allocate-foreign-string 256)) diff --git a/db-odbc/odbc-constants.lisp b/db-odbc/odbc-constants.lisp index 2f52d9d..cddb4be 100644 --- a/db-odbc/odbc-constants.lisp +++ b/db-odbc/odbc-constants.lisp @@ -944,9 +944,14 @@ (defconstant $SQL_FETCH_RELATIVE 6) (defconstant $SQL_FETCH_BOOKMARK 8) -;;; ODBC v3 constants +;;; ODBC v3 constants, added by KMR (defconstant $SQL_ATTR_ODBC_VERSION 200) (defconstant $SQL_OV_ODBC2 2) (defconstant $SQL_OV_ODBC3 3) +(defconstant $SQL_INDEX_UNIQUE 0) +(defconstant $SQL_INDEX_ALL 1) +(defconstant $SQL_QUICK 0) +(defconstant $SQL_ENSURE 1) + diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp index ff96c21..f9e8493 100644 --- a/db-odbc/odbc-dbi.lisp +++ b/db-odbc/odbc-dbi.lisp @@ -33,6 +33,7 @@ #:list-all-data-sources #:list-all-database-tables #:list-all-table-columns + #:list-table-indexes #:loop-over-results #:prepare-sql #:rr-sql @@ -180,6 +181,20 @@ the query against." )) (coerce (column-names query) 'list)))) (db-close-query query)))) +(defun list-table-indexes (table &key db unique hstmt) + (declare (ignore hstmt)) + (let ((query (get-free-query db))) + (unwind-protect + (progn + (with-slots (hstmt) query + (unless hstmt (setf hstmt (%new-statement-handle (hdbc db)))) + (%table-statistics table hstmt :unique unique) + (%initialize-query query nil nil) + (values + (db-fetch-query-results query) + (coerce (column-names query) 'list)))) + (db-close-query query)))) + (defun list-all-table-columns (table &key db hstmt) (declare (ignore hstmt)) (db-describe-columns db "" "" table "")) diff --git a/db-odbc/odbc-ff-interface.lisp b/db-odbc/odbc-ff-interface.lisp index fa46667..4f80888 100644 --- a/db-odbc/odbc-ff-interface.lisp +++ b/db-odbc/odbc-ff-interface.lisp @@ -369,3 +369,16 @@ :returning :short) +(def-function "SQLStatistics" + ((hstmt :pointer-void) + (catalog-name :pointer-void) + (catalog-name-length :short) + (schema-name :pointer-void) + (schema-name-length :short) + (table-name :cstring) + (table-name-length :short) + (unique :short) + (reserved :short)) + :returning :short) + + diff --git a/db-odbc/odbc-package.lisp b/db-odbc/odbc-package.lisp index 3c22c8b..c34147b 100644 --- a/db-odbc/odbc-package.lisp +++ b/db-odbc/odbc-package.lisp @@ -63,6 +63,7 @@ #:result-rows-count #:sql-to-c-type #:%list-tables + #:%table-statistics #:%list-data-sources ) (:documentation "This is the low-level interface ODBC.")) diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp index 3bc5368..2fad848 100644 --- a/db-odbc/odbc-sql.lisp +++ b/db-odbc/odbc-sql.lisp @@ -198,11 +198,14 @@ &key (owner nil)) (declare (ignore owner)) (multiple-value-bind (rows col-names) - (odbc-dbi:list-all-database-tables :db (database-odbc-conn database)) - (let ((pos (position "TABLE_NAME" col-names :test #'string-equal))) - (when pos - (loop for row in rows - collect (nth pos row)))))) + (odbc-dbi:list-all-database-tables :db (database-odbc-conn database)) + (declare (ignore col-names)) + ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager + ;; TABLE_NAME in third column, TABLE_TYPE in fourth column + (loop for row in rows + when (and (not (string-equal "information_schema" (nth 1 row))) + (string-equal "TABLE" (nth 3 row))) + collect (nth 2 row)))) (defmethod database-list-attributes ((table string) (database odbc-database) &key (owner nil)) @@ -279,6 +282,21 @@ (declare (ignore connection-spec)) (odbc-dbi:list-all-data-sources)) -#+ignore +(defmethod database-list-indexes ((database odbc-database) + &key (owner nil)) + (let ((result '())) + (dolist (table (database-list-tables database :owner owner) result) + (append (database-list-table-indexes table database :owner owner) + result)))) + +(defmethod database-list-table-indexes (table (database odbc-database) + &key (owner nil)) + (multiple-value-bind (rows col-names) + (odbc-dbi:list-table-indexes table :db (database-odbc-conn database)) + (declare (ignore col-names)) + ;; INDEX_NAME is hard-coded in sixth position by ODBC driver + (loop for row in rows collect (nth 5 row)))) + +#+ignore (when (clsql-base-sys:database-type-library-loaded :odbc) (clsql-base-sys:initialize-database-type :database-type :odbc)) diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp index 50c6899..6307f05 100644 --- a/db-postgresql-socket/postgresql-socket-sql.lisp +++ b/db-postgresql-socket/postgresql-socket-sql.lisp @@ -314,22 +314,27 @@ doesn't depend on UFFI." ;;; Object listing +(defun owner-clause (owner) + (cond + ((stringp owner) + (format + nil + " AND (relowner=(SELECT usesysid FROM pg_user WHERE (usename='~A')))" + owner)) + ((null owner) + (format nil " AND (NOT (relowner=1))")) + (t ""))) + (defmethod database-list-objects-of-type ((database postgresql-socket-database) type owner) - (let ((owner-clause - (cond ((stringp owner) - (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE (usename='~A')))" owner)) - ((null owner) - (format nil " AND (NOT (relowner=1))")) - (t "")))) - (mapcar #'car - (database-query - (format nil - "SELECT relname FROM pg_class WHERE (relkind = '~A')~A" - type - owner-clause) - database nil)))) - + (mapcar #'car + (database-query + (format nil + "SELECT relname FROM pg_class WHERE (relkind = '~A')~A" + type + (owner-clause owner)) + database nil))) + (defmethod database-list-tables ((database postgresql-socket-database) &key (owner nil)) (database-list-objects-of-type database "r" owner)) @@ -341,7 +346,28 @@ doesn't depend on UFFI." (defmethod database-list-indexes ((database postgresql-socket-database) &key (owner nil)) (database-list-objects-of-type database "i" owner)) - + +(defmethod database-list-table-indexes (table + (database postgresql-socket-database) + &key (owner nil)) + (let ((indexrelids + (database-query + (format + nil + "select indexrelid from pg_index where indrelid=(select relfilenode from pg_class where relname='~A'~A)" + (string-downcase table) + (owner-clause owner)) + database :auto)) + (result nil)) + (dolist (indexrelid indexrelids (nreverse result)) + (push + (caar (database-query + (format nil "select relname from pg_class where relfilenode='~A'" + (car indexrelid)) + database + nil)) + result)))) + (defmethod database-list-attributes ((table string) (database postgresql-socket-database) &key (owner nil)) diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp index b4eaa82..3d1eca3 100644 --- a/db-postgresql/postgresql-sql.lisp +++ b/db-postgresql/postgresql-sql.lisp @@ -366,22 +366,27 @@ ;;; Object listing +(defun owner-clause (owner) + (cond + ((stringp owner) + (format + nil + " AND (relowner=(SELECT usesysid FROM pg_user WHERE (usename='~A')))" + owner)) + ((null owner) + (format nil " AND (NOT (relowner=1))")) + (t ""))) + (defmethod database-list-objects-of-type ((database postgresql-database) type owner) - (let ((owner-clause - (cond ((stringp owner) - (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE (usename='~A')))" owner)) - ((null owner) - (format nil " AND (NOT (relowner=1))")) - (t "")))) - (mapcar #'car - (database-query - (format nil - "SELECT relname FROM pg_class WHERE (relkind = '~A')~A" - type - owner-clause) - database nil)))) - + (mapcar #'car + (database-query + (format nil + "SELECT relname FROM pg_class WHERE (relkind = '~A')~A" + type + (owner-clause owner)) + database nil))) + (defmethod database-list-tables ((database postgresql-database) &key (owner nil)) (database-list-objects-of-type database "r" owner)) @@ -393,7 +398,28 @@ (defmethod database-list-indexes ((database postgresql-database) &key (owner nil)) (database-list-objects-of-type database "i" owner)) - + + +(defmethod database-list-table-indexes (table (database postgresql-database) + &key (owner nil)) + (let ((indexrelids + (database-query + (format + nil + "select indexrelid from pg_index where indrelid=(select relfilenode from pg_class where relname='~A'~A)" + (string-downcase table) + (owner-clause owner)) + database :auto)) + (result nil)) + (dolist (indexrelid indexrelids (nreverse result)) + (push + (caar (database-query + (format nil "select relname from pg_class where relfilenode='~A'" + (car indexrelid)) + database + nil)) + result)))) + (defmethod database-list-attributes ((table string) (database postgresql-database) &key (owner nil)) @@ -530,7 +556,7 @@ (progn (setf (slot-value database 'clsql-base-sys::state) :open) (mapcar #'car (database-query "select datname from pg_database" - database :auto))) + database nil))) (progn (database-disconnect database) (setf (slot-value database 'clsql-base-sys::state) :closed)))))) diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index 1ea5599..5a902c9 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -207,6 +207,17 @@ "SELECT name FROM sqlite_master WHERE type='index' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' ORDER BY name" database nil))) +(defmethod database-list-table-indexes (table (database sqlite-database) + &key (owner nil)) + (declare (ignore owner)) + (mapcar #'car + (database-query + (format + nil + "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='~A' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' AND tbl_name='~A' ORDER BY name" + table table) + database nil))) + (declaim (inline sqlite-table-info)) (defun sqlite-table-info (table database) (database-query (format nil "PRAGMA table_info('~A')" table) diff --git a/sql/package.lisp b/sql/package.lisp index 63847d3..302bc42 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -149,6 +149,7 @@ #:database-list-tables #:database-list-views #:database-list-indexes + #:database-list-table-indexes #:database-list-sequences #:database-list-attributes #:database-attribute-type @@ -253,6 +254,7 @@ #:database-list-views #:database-view-exists-p #:database-list-indexes + #:database-list-table-indexes #:database-index-exists-p #:database-list-sequences #:database-sequence-exists-p @@ -333,6 +335,7 @@ #:list-views ; table xx #:view-exists-p ; table xx #:list-indexes ; table xx + #:list-table-indexes ; table xx #:index-exists-p ; table xx #:create-sequence ; table xx #:drop-sequence ; table xx diff --git a/sql/table.lisp b/sql/table.lisp index 4fb9168..52b5c1a 100644 --- a/sql/table.lisp +++ b/sql/table.lisp @@ -185,6 +185,15 @@ specification of a table to drop the index from." OWNER is a string, this denotes a username and only indexs owned by OWNER are considered. Index names are returned as a list of strings." (database-list-indexes database :owner owner)) + +(defun list-table-indexes (table &key (owner nil) + (database *default-database*)) + "List all indexes in DATABASE for a TABLE, which defaults to +*default-database*. If OWNER is :all , all indexs are considered. If +OWNER is a string, this denotes a username and only indexs owned by +OWNER are considered. Index names are returned as a list of strings." + (database-list-table-indexes (database-identifier table) + database :owner owner)) (defun index-exists-p (name &key (owner nil) (database *default-database*)) "Test for existence of an index called NAME in DATABASE which diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp index bafa1c5..e231592 100644 --- a/tests/test-fddl.lisp +++ b/tests/test-fddl.lisp @@ -21,7 +21,7 @@ (setq *rt-fddl* '( - + ;; list current tables (deftest :fddl/table/1 (apply #'values @@ -157,12 +157,8 @@ (values (clsql:index-exists-p [bar] :owner *test-database-user*) (progn - (case *test-database-type* - (:mysql - (clsql:drop-index [bar] :on [employee] - :if-does-not-exist :ignore)) - (t - (clsql:drop-index [bar]:if-does-not-exist :ignore))) + (clsql:drop-index [bar] :on [employee] + :if-does-not-exist :ignore) (clsql:index-exists-p [bar] :owner *test-database-user*)))) t nil) @@ -173,13 +169,33 @@ (dolist (name names) (clsql:create-index name :on [employee] :attributes '([emplid])) (push (clsql:index-exists-p name :owner *test-database-user*) result) - (case *test-database-type* - (:mysql - (clsql:drop-index name :on [employee] :if-does-not-exist :ignore)) - (t (clsql:drop-index name :if-does-not-exist :ignore)))) + (clsql:drop-index name :on [employee] :if-does-not-exist :ignore)) (apply #'values result)) t t t) +;; test list-table-indexes +(deftest :fddl/index/3 + (progn + (clsql:create-index [bar] :on [employee] :attributes + '([last-name]) :unique nil) + (clsql:create-index [foo] :on [employee] :attributes + '([first-name]) :unique nil) + (values + + (sort + (mapcar + #'string-downcase + (clsql:list-table-indexes [employee] :owner *test-database-user*)) + #'string-lessp) + (sort (clsql:list-table-indexes [company] :owner *test-database-user*) + #'string-lessp) + (progn + (clsql:drop-index [bar] :on [employee]) + (clsql:drop-index [foo] :on [employee]) + t))) + + ("bar" "foo") nil t) + ;; create an sequence, test for existence, drop it and test again (deftest :fddl/sequence/1 (progn (clsql:create-sequence [foo]) -- 2.34.1