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]
(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."))
#:database-list-attributes
#:database-list-sequences
#:database-list-indexes
+ #:database-list-table-indexes
#:database-list-views
#+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))
&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))
(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))
(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)
+
#:list-all-data-sources
#:list-all-database-tables
#:list-all-table-columns
+ #:list-table-indexes
#:loop-over-results
#:prepare-sql
#:rr-sql
(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 ""))
: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)
+
+
#:result-rows-count
#:sql-to-c-type
#:%list-tables
+ #:%table-statistics
#:%list-data-sources
)
(:documentation "This is the low-level interface ODBC."))
&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))
(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))
;;; 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))
(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))
;;; 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))
(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))
(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))))))
"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)
#:database-list-tables
#:database-list-views
#:database-list-indexes
+ #:database-list-table-indexes
#:database-list-sequences
#:database-list-attributes
#:database-attribute-type
#: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
#: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
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
(setq *rt-fddl*
'(
-
+
;; list current tables
(deftest :fddl/table/1
(apply #'values
(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)
(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])
projects / clsql.git / commitdiff