From: Kevin M. Rosenberg Date: Sun, 23 May 2004 10:13:02 +0000 (+0000) Subject: r9449: * db-odbc/odbc-sql.lisp, db-aodbc/aodbc-sql.lisp: Move common code to X-Git-Tag: v3.8.6~398 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=bb2818fb8a6714a55b360dec0bb043c5edccb3f4 r9449: * db-odbc/odbc-sql.lisp, db-aodbc/aodbc-sql.lisp: Move common code to sql/generic-odbc.lisp * db-postgresql/postgresql-sql.lisp, db-postgresql-socket/postgresql-socket-sql.lisp: Move common code to sql/generic-postgresql.lisp --- diff --git a/ChangeLog b/ChangeLog index c3df25c..09f0489 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,10 @@ * sql/*.lisp: Add db-type parameter to generic functions READ-SQL-VALUE, DATABASE-GET-TYPE-SPECIFIER, and OUTPUT-SQL-VALUE-AS-TYPE. Update methods to use these. * sql/generic-postgresql.lisp, sql/generic-odbc.lisp: New files + * db-odbc/odbc-sql.lisp, db-aodbc/aodbc-sql.lisp: Move common code to + sql/generic-odbc.lisp + * db-postgresql/postgresql-sql.lisp, db-postgresql-socket/postgresql-socket-sql.lisp: + Move common code to sql/generic-postgresql.lisp * sql/classes.lisp: honor case of string tables when outputting queries * sql/objects.lisp: Add database type to default database-get-type-specifier method * sql/sql.lisp: Add database type to default database-abort-transaction method diff --git a/db-aodbc/aodbc-sql.lisp b/db-aodbc/aodbc-sql.lisp index 4d83206..a43fb18 100644 --- a/db-aodbc/aodbc-sql.lisp +++ b/db-aodbc/aodbc-sql.lisp @@ -52,6 +52,7 @@ (make-instance 'aodbc-database :name (database-name-from-spec connection-spec :aodbc) :database-type :aodbc + :dbi-package (find-package '#:dbi) :aodbc-conn (dbi:connect :user user :password password @@ -64,89 +65,7 @@ :connection-spec connection-spec :message "Connection failed"))))) -(defmethod database-disconnect ((database aodbc-database)) - #+aodbc-v2 - (dbi:disconnect (database-aodbc-conn database)) - (setf (database-aodbc-conn database) nil) - t) -(defmethod database-query (query-expression (database aodbc-database) result-types field-names) - #+aodbc-v2 - (handler-case - (dbi:sql query-expression :db (database-aodbc-conn database) - :types result-types - :column-names field-names) - (clsql-error (e) - (error e)) - (error () - (error 'sql-database-data-error - :database database - :expression query-expression - :message "Query failed.")))) - -(defmethod database-execute-command (sql-expression - (database aodbc-database)) - #+aodbc-v2 - (handler-case - (dbi:sql sql-expression :db (database-aodbc-conn database)) - (clsql-error (e) - (error e)) - (error () - (error 'sql-database-data-error - :database database - :expression sql-expression - :error "Execute command failed.")))) - -(defstruct aodbc-result-set - (query nil) - (types nil :type cons) - (full-set nil :type boolean)) - -(defmethod database-query-result-set ((query-expression string) - (database aodbc-database) - &key full-set result-types) - #+aodbc-v2 - (handler-case - (multiple-value-bind (query column-names) - (dbi:sql query-expression - :db (database-aodbc-conn database) - :row-count nil - :column-names t - :query t - :types result-types - ) - (values - (make-aodbc-result-set :query query :full-set full-set - :types result-types) - (length column-names) - nil ;; not able to return number of rows with aodbc - )) - (clsql-error (e) - (error e)) - (error () - (error 'sql-database-data-error - :database database - :expression query-expression - :error "Query result set failed.")))) - -(defmethod database-dump-result-set (result-set (database aodbc-database)) - #+aodbc-v2 - (dbi:close-query (aodbc-result-set-query result-set)) - t) - -(defmethod database-store-next-row (result-set - (database aodbc-database) - list) - #+aodbc-v2 - (let ((row (dbi:fetch-row (aodbc-result-set-query result-set) nil 'eof))) - (if (eq row 'eof) - nil - (progn - (loop for elem in row - for rest on list - do - (setf (car rest) elem)) - list)))) ;;; Sequence functions @@ -182,55 +101,6 @@ (warn "database-list-sequences not implemented for AODBC.") nil) -(defmethod database-list-tables ((database aodbc-database) - &key (owner nil)) - (declare (ignore owner)) - #+aodbc-v2 - (multiple-value-bind (rows col-names) - (dbi:list-all-database-tables :db (database-aodbc-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-views ((database aodbc-database) - &key (owner nil)) - (declare (ignore owner)) - #+aodbc-v2 - (multiple-value-bind (rows col-names) - (dbi:list-all-database-tables :db (database-aodbc-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 "VIEW" (nth 3 row))) - collect (nth 2 row)))) - -(defmethod database-list-attributes ((table string) (database aodbc-database) - &key (owner nil)) - (declare (ignore owner)) - #+aodbc-v2 - (multiple-value-bind (rows col-names) - (dbi:list-all-table-columns table :db (database-aodbc-conn database)) - (let ((pos (position "COLUMN_NAME" col-names :test #'string-equal))) - (when pos - (loop for row in rows - collect (nth pos row)))))) - -(defmethod database-attribute-type ((attribute string) (table string) (database aodbc-database) - &key (owner nil)) - (declare (ignore owner)) - #+aodbc-v2 - (multiple-value-bind (rows col-names) - (dbi:list-all-table-columns table :db (database-aodbc-conn database)) - (let ((pos (position "TYPE_NAME" col-names :test #'string-equal))) - (when pos - (loop for row in rows - collect (nth pos row)))))) (defmethod database-list-indexes ((database aodbc-database) &key (owner nil)) diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 94017dc..4706c15 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -44,8 +44,10 @@ as possible second argument) to the desired representation of date/time/timestam (let ((size (gensym))) `(let ((,size (length ,string))) (when (and ,max-length (> ,size ,max-length)) - (error "string \"~a\" of length ~d is longer than max-length: ~d" - ,string ,size ,max-length)) + (error 'clsql:sql-database-data-error + :message + (format nil "string \"~a\" of length ~d is longer than max-length: ~d" + ,string ,size ,max-length))) (with-cast-pointer (char-ptr ,ptr :byte) (dotimes (i ,size) (setf (deref-array char-ptr '(:array :byte) i) @@ -127,7 +129,7 @@ as possible second argument) to the desired representation of date/time/timestam (error 'clsql-sys:sql-database-error :message error-message - :sql-state sql-state))) + :secondary-error-id sql-state))) (#.$SQL_NO_DATA_FOUND (progn ,result-code ,@body)) ;; work-around for Allegro 7.0beta AMD64 which @@ -252,7 +254,7 @@ as possible second argument) to the desired representation of date/time/timestam (SQLAllocStmt hdbc hstmt-ptr) (deref-pointer hstmt-ptr 'sql-handle))))) (if (uffi:null-pointer-p statement-handle) - (error "Received null statement handle.") + (error 'clsql:sql-database-error :message "Received null statement handle.") statement-handle))) (defun %sql-get-info (hdbc info-type) @@ -756,7 +758,8 @@ as possible second argument) to the desired representation of date/time/timestam (prog1 (cond (flatp (when (> column-count 1) - (error "If more than one column is to be fetched, flatp has to be nil.")) + (error 'clsql:sql-database-error + :message "If more than one column is to be fetched, flatp has to be nil.")) (loop until (= (%sql-fetch hstmt) $SQL_NO_DATA_FOUND) collect (read-data (aref data-ptrs 0) @@ -860,7 +863,7 @@ as possible second argument) to the desired representation of date/time/timestam data-ptr str offset data-length))) - (error "wrong type. preliminary.")) + (error 'clsql:sql-database-error :message "wrong type. preliminary.")) while (and (= res $SQL_SUCCESS_WITH_INFO) (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) "01004")) @@ -878,7 +881,7 @@ as possible second argument) to the desired representation of date/time/timestam data-ptr str offset (min out-len (1- +max-precision+)))) - (error "wrong type. preliminary.")) + (error 'clsql:sql-database-error :message "wrong type. preliminary.")) while (and (= res $SQL_SUCCESS_WITH_INFO) #+ingore(eq (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt) diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp index 3a14e72..eee8ad6 100644 --- a/db-odbc/odbc-dbi.lisp +++ b/db-odbc/odbc-dbi.lisp @@ -176,7 +176,7 @@ the query against." )) ((zerop count) (close-query query) (when eof-errorp - (error 'sql-database-data-error + (error 'clsql:sql-database-data-error :message "ODBC: Ran out of data in fetch-row")) eof-value) (t @@ -584,7 +584,9 @@ This makes the functions db-execute-command and db-query thread safe." ;; support SQLDescribeParam. To do: put code in here for drivers that do ;; support it. (unless (string-equal sql "insert" :end1 6) - (error "Only insert expressions are supported in literal ODBC: '~a'." sql)) + (error 'clsql:sql-database-error + (format nil + "Only insert expressions are supported in literal ODBC: '~a'." sql))) (%db-execute query (format nil "select ~{~a~^,~} from ~a where 0 = 1" (or parameter-columns '("*")) parameter-table)) (%initialize-query query nil nil) diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp index 0ed1ebe..862c991 100644 --- a/db-odbc/odbc-sql.lisp +++ b/db-odbc/odbc-sql.lisp @@ -26,8 +26,7 @@ ;; ODBC interface (defclass odbc-database (generic-odbc-database) - ((odbc-conn :accessor database-odbc-conn :initarg :odbc-conn) - (odbc-db-type :accessor database-odbc-db-type))) + ((odbc-db-type :accessor database-odbc-db-type))) (defmethod database-name-from-spec (connection-spec (database-type (eql :odbc))) @@ -40,19 +39,16 @@ (check-connection-spec connection-spec database-type (dsn user password)) (destructuring-bind (dsn user password) connection-spec (handler-case - (let ((db - (make-instance 'odbc-database - :name (database-name-from-spec connection-spec :odbc) - :database-type :odbc - :odbc-conn - (odbc-dbi:connect :user user - :password password - :data-source-name dsn)))) + (let ((db (make-instance 'odbc-database + :name (database-name-from-spec connection-spec :odbc) + :database-type :odbc + :dbi-package (find-package '#:odbc-dbi) + :odbc-conn + (odbc-dbi:connect :user user + :password password + :data-source-name dsn)))) (store-type-of-connected-database db) db) - #+ignore - (sql-condition (e) - (error e)) (error () ;; Init or Connect failed (error 'sql-connection-error :database-type database-type @@ -63,7 +59,7 @@ (database-odbc-db-type database)) (defun store-type-of-connected-database (db) - (let* ((odbc-conn (database-odbc-conn db)) + (let* ((odbc-conn (clsql-sys::odbc-conn db)) (server-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_SERVER_NAME)) (dbms-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_DBMS_NAME)) (type @@ -80,83 +76,8 @@ :oracle)))) (setf (database-odbc-db-type db) type))) -(defmethod database-disconnect ((database odbc-database)) - (odbc-dbi:disconnect (database-odbc-conn database)) - (setf (database-odbc-conn database) nil) - t) - -(defmethod database-query (query-expression (database odbc-database) - result-types field-names) - (handler-case - (odbc-dbi:sql query-expression :db (database-odbc-conn database) - :result-types result-types - :column-names field-names) - #+ignore - (sql-error (e) - (error e)) - (error () - (error 'sql-database-data-error - :database database - :expression query-expression - :message "Query failed")))) - -(defmethod database-execute-command (sql-expression - (database odbc-database)) - (handler-case - (odbc-dbi:sql sql-expression :db (database-odbc-conn database)) - #+ignore - (sql-error (e) - (error e)) - (error () - (error 'sql-database-data-error - :database database - :expression sql-expression - :message "Execute command failed")))) - -(defstruct odbc-result-set - (query nil) - (types nil) - (full-set nil :type boolean)) -(defmethod database-query-result-set ((query-expression string) - (database odbc-database) - &key full-set result-types) - (handler-case - (multiple-value-bind (query column-names) - (odbc-dbi:sql query-expression - :db (database-odbc-conn database) - :row-count nil - :column-names t - :query t - :result-types result-types) - (values - (make-odbc-result-set :query query :full-set full-set - :types result-types) - (length column-names) - nil ;; not able to return number of rows with odbc - )) - (error () - (error 'sql-database-data-error - :database database - :expression query-expression - :message "Query result set failed")))) -(defmethod database-dump-result-set (result-set (database odbc-database)) - (odbc-dbi:close-query (odbc-result-set-query result-set)) - t) - -(defmethod database-store-next-row (result-set - (database odbc-database) - list) - (let ((row (odbc-dbi:fetch-row (odbc-result-set-query result-set) nil 'eof))) - (if (eq row 'eof) - nil - (progn - (loop for elem in row - for rest on list - do - (setf (car rest) elem)) - list)))) ;;; Sequence functions @@ -202,63 +123,6 @@ (database-query "SELECT RELNAME FROM pg_class WHERE RELNAME LIKE '%clsql_seq%'" database nil nil))))) -(defmethod database-list-tables ((database odbc-database) - &key (owner nil)) - (declare (ignore owner)) - (multiple-value-bind (rows col-names) - (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-views ((database odbc-database) - &key (owner nil)) - (declare (ignore owner)) - (multiple-value-bind (rows col-names) - (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 "VIEW" (nth 3 row))) - collect (nth 2 row)))) - -(defmethod database-list-attributes ((table string) (database odbc-database) - &key (owner nil)) - (declare (ignore owner)) - (multiple-value-bind (rows col-names) - (odbc-dbi:list-all-table-columns table :db (database-odbc-conn database)) - (declare (ignore col-names)) - ;; COLUMN_NAME is hard-coded by odbc spec as fourth position - (loop for row in rows - collect (fourth row)))) - -(defmethod database-attribute-type ((attribute string) (table string) (database odbc-database) - &key (owner nil)) - (declare (ignore owner)) - (multiple-value-bind (rows col-names) - (odbc-dbi:list-all-table-columns table :db (database-odbc-conn database)) - (declare (ignore col-names)) - ;; COLUMN_NAME is hard-coded by odbc spec as fourth position - ;; TYPE_NAME is the sixth column - ;; PRECISION/COLUMN_SIZE is the seventh column - ;; SCALE/DECIMAL_DIGITS is the ninth column - ;; NULLABLE is the eleventh column - (loop for row in rows - when (string-equal attribute (fourth row)) - do - (let ((size (seventh row)) - (precision (ninth row)) - (scale (nth 10 row))) - (return (values (ensure-keyword (sixth row)) - (when size (parse-integer size)) - (when precision (parse-integer precision)) - (when scale (parse-integer scale)))))))) (defmethod database-set-sequence-position (sequence-name (position integer) @@ -326,13 +190,10 @@ (defmethod database-list-table-indexes (table (database odbc-database) &key (owner nil)) (declare (ignore owner)) - (odbc-list-table-indexes table database)) - -(defun odbc-list-table-indexes (table database) (multiple-value-bind (rows col-names) (odbc-dbi:list-table-indexes table - :db (database-odbc-conn database)) + :db (clsql-sys::odbc-conn database)) (declare (ignore col-names)) ;; INDEX_NAME is hard-coded in sixth position by ODBC driver ;; FIXME: ??? is hard-coded in the fourth position diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp index f4c1250..ab4d710 100644 --- a/db-postgresql-socket/postgresql-socket-sql.lisp +++ b/db-postgresql-socket/postgresql-socket-sql.lisp @@ -357,7 +357,7 @@ doesn't depend on UFFI." (defmethod db-type-default-case ((db-type (eql :postgresql-socket))) :lower) -(defmethod db-underlying-type ((database postgresql-socket-database)) +(defmethod database-underlying-type ((database postgresql-socket-database)) :postgresql) (when (clsql-sys:database-type-library-loaded :postgresql-socket) diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp index bcfda5e..d93b153 100644 --- a/db-postgresql/postgresql-sql.lisp +++ b/db-postgresql/postgresql-sql.lisp @@ -443,11 +443,5 @@ ;;; Database capabilities -(defmethod db-type-has-fancy-math? ((db-type (eql :postgresql))) - t) - -(defmethod db-type-default-case ((db-type (eql :postgresql))) - :lower) - (when (clsql-sys:database-type-library-loaded :postgresql) (clsql-sys:initialize-database-type :database-type :postgresql)) diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index be35f5b..b2d4e3e 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -1,7 +1,7 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ====================================================================== ;;;; File: test-fdml.lisp -;;;; Author: Marcus Pearce +;;;; Author: Marcus Pearce , Kevin Rosenberg ;;;; Created: 30/03/2004 ;;;; Updated: $Id$ ;;;;