+(defun sql (expr &key db result-types row-count (column-names t) query
+ hstmt width)
+ (declare (ignore hstmt))
+ (cond
+ (query
+ (let ((q (db-open-query db expr :result-types result-types :width width)))
+ (if column-names
+ (values q (column-names q))
+ q)))
+ (t
+ (multiple-value-bind (data col-names)
+ (db-query db expr :result-types result-types :width width)
+ (cond
+ (row-count
+ (if (consp data) (length data) data))
+ (column-names
+ (values data col-names))
+ (t
+ data))))))
+
+(defun fetch-row (query &optional (eof-errorp t) eof-value)
+ (multiple-value-bind (row query count) (db-fetch-query-results query 1)
+ (cond
+ ((zerop count)
+ (close-query query)
+ (when eof-errorp
+ (error 'clsql:sql-database-data-error
+ :message "ODBC: Ran out of data in fetch-row"))
+ eof-value)
+ (t
+ (car row)))))
+
+
+(defun close-query (query)
+ (db-close-query query))
+
+(defun list-all-database-tables (&key db 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))))
+ (%list-tables hstmt)
+ (%initialize-query query nil nil)
+ (values
+ (db-fetch-query-results query)
+ (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 nil nil table nil)) ;; use nil rather than "" for unspecified values
+
+(defun list-all-data-sources ()
+ (let ((db (make-instance 'odbc-db)))
+ (unless (henv db) ;; has class allocation!
+ (setf (henv db) (%new-environment-handle)))
+ (%list-data-sources (henv db))))