X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-odbc%2Fodbc-api.lisp;h=eb68f205b42c32ce248b6f1a217c389a992f75ad;hp=66c9936b041193327782a1bc31f0f9ffcb8700e0;hb=d9f41af62750c622945bb17b622a39689ee5b840;hpb=6684280691d01cc6d761f24288f9ea80d77bca29 diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 66c9936..eb68f20 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -6,7 +6,7 @@ ;;;; Purpose: Low-level ODBC API using UFFI ;;;; Authors: Kevin M. Rosenberg and Paul Meurer ;;;; -;;;; $Id: odbc-package.lisp 7061 2003-09-07 06:34:45Z kevin $ +;;;; $Id$ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2004 by Kevin M. Rosenberg ;;;; and Copyright (C) Paul Meurer 1999 - 2001. All rights reserved. @@ -27,8 +27,8 @@ May be locally bound to something else if a certain type is necessary.") (defvar *time-conversion-function* (lambda (universal-time &optional fraction) (declare (ignore fraction)) - (clsql-base:format-time - nil (clsql-base:utime->time universal-time) + (clsql-sys:format-time + nil (clsql-sys:utime->time universal-time) :format :iso) #+ignore universal-time) @@ -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) @@ -113,21 +115,21 @@ as possible second argument) to the desired representation of date/time/timestam (progn ,result-code ,@body)) (#.$SQL_INVALID_HANDLE (error - 'clsql-base:clsql-odbc-error - :odbc-message "Invalid handle")) + 'clsql-sys:sql-database-error + :message "ODBC: Invalid handle")) (#.$SQL_STILL_EXECUTING (error - 'clsql-base:clsql-odbc-error - :odbc-message "Still executing")) + 'clsql-sys:sql-temporary-error + :message "ODBC: Still executing")) (#.$SQL_ERROR (multiple-value-bind (error-message sql-state) (handle-error (or ,henv +null-handle-ptr+) (or ,hdbc +null-handle-ptr+) (or ,hstmt +null-handle-ptr+)) (error - 'clsql-base:clsql-odbc-error - :odbc-message error-message - :sql-state sql-state))) + 'clsql-sys:sql-database-error + :message error-message + :secondary-error-id sql-state))) (#.$SQL_NO_DATA_FOUND (progn ,result-code ,@body)) ;; work-around for Allegro 7.0beta AMD64 which @@ -138,9 +140,9 @@ as possible second argument) to the desired representation of date/time/timestam (or ,hdbc +null-handle-ptr+) (or ,hstmt +null-handle-ptr+)) (error - 'clsql-base:clsql-odbc-error - :odbc-message error-message - :sql-state sql-state)) + 'clsql-sys:sql-database-error + :message error-message + :secondary-error-id sql-state)) #+ignore (progn ,result-code ,@body)))))) @@ -149,9 +151,9 @@ as possible second argument) to the desired representation of date/time/timestam (with-foreign-object (phenv 'sql-handle) (with-error-handling () - (SQLAllocEnv phenv) + (SQLAllocHandle $SQL_HANDLE_ENV +null-handle-ptr+ phenv) (deref-pointer phenv 'sql-handle))))) - (%set-attr-odbc-version henv $SQL_OV_ODBC2) + (%set-attr-odbc-version henv $SQL_OV_ODBC3) henv)) @@ -162,9 +164,10 @@ as possible second argument) to the desired representation of date/time/timestam (defun %new-db-connection-handle (henv) (with-foreign-object (phdbc 'sql-handle) + (setf (deref-pointer phdbc sql-handle) +null-handle-ptr+) (with-error-handling (:henv henv) - (SQLAllocConnect henv phdbc) + (SQLAllocHandle $SQL_HANDLE_DBC henv phdbc) (deref-pointer phdbc 'sql-handle)))) (defun %free-statement (hstmt option) @@ -246,13 +249,13 @@ as possible second argument) to the desired representation of date/time/timestam (defun %new-statement-handle (hdbc) (let ((statement-handle - (with-foreign-object (hstmt-ptr 'sql-handle) + (with-foreign-object (phstmt 'sql-handle) (with-error-handling (:hdbc hdbc) - (SQLAllocStmt hdbc hstmt-ptr) - (deref-pointer hstmt-ptr 'sql-handle))))) + (SQLAllocHandle $SQL_HANDLE_STMT hdbc phstmt) + (deref-pointer phstmt '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) @@ -566,17 +569,20 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_DATE $SQL_C_DATE) (#.$SQL_TIME $SQL_C_TIME) (#.$SQL_TIMESTAMP $SQL_C_TIMESTAMP) + (#.$SQL_TYPE_DATE $SQL_C_TYPE_DATE) + (#.$SQL_TYPE_TIME $SQL_C_TYPE_TIME) + (#.$SQL_TYPE_TIMESTAMP $SQL_C_TYPE_TIMESTAMP) ((#.$SQL_BINARY #.$SQL_VARBINARY #.$SQL_LONGVARBINARY) $SQL_C_BINARY) (#.$SQL_TINYINT $SQL_C_STINYINT) (#.$SQL_BIT $SQL_C_BIT))) -(def-type byte-pointer-type '(* :byte)) -(def-type short-pointer-type '(* :short)) -(def-type int-pointer-type '(* :int)) -(def-type long-pointer-type '(* #.$ODBC-LONG-TYPE)) -(def-type float-pointer-type '(* :float)) -(def-type double-pointer-type '(* :double)) -(def-type string-pointer-type '(* :unsigned-char)) +(def-type byte-pointer-type (* :byte)) +(def-type short-pointer-type (* :short)) +(def-type int-pointer-type (* :int)) +(def-type long-pointer-type (* #.$ODBC-LONG-TYPE)) +(def-type float-pointer-type (* :float)) +(def-type double-pointer-type (* :double)) +(def-type string-pointer-type (* :unsigned-char)) (defun get-cast-byte (ptr) (locally (declare (type byte-pointer-type ptr)) @@ -642,18 +648,17 @@ as possible second argument) to the desired representation of date/time/timestam (#.$SQL_INTEGER (get-cast-int data-ptr)) (#.$SQL_BIGINT (read-from-string (get-cast-foreign-string data-ptr))) - (#.$SQL_TINYINT (get-cast-byte data-ptr)) (#.$SQL_DECIMAL (let ((*read-base* 10)) (read-from-string (get-cast-foreign-string data-ptr)))) (t (case c-type - (#.$SQL_C_DATE + ((#.$SQL_C_DATE #.$SQL_C_TYPE_DATE) (funcall *time-conversion-function* (date-to-universal-time data-ptr))) - (#.$SQL_C_TIME + ((#.$SQL_C_TIME #.$SQL_C_TYPE_TIME) (multiple-value-bind (universal-time frac) (time-to-universal-time data-ptr) (funcall *time-conversion-function* universal-time frac))) - (#.$SQL_C_TIMESTAMP + ((#.$SQL_C_TIMESTAMP #.$SQL_C_TYPE_TIMESTAMP) (multiple-value-bind (universal-time frac) (timestamp-to-universal-time data-ptr) (funcall *time-conversion-function* universal-time frac))) (#.$SQL_INTEGER @@ -703,9 +708,9 @@ as possible second argument) to the desired representation of date/time/timestam (data-ptr (case c-type ;; add more? (#.$SQL_C_SLONG (uffi:allocate-foreign-object #.$ODBC-LONG-TYPE)) - (#.$SQL_C_DATE (allocate-foreign-object 'sql-c-date)) - (#.$SQL_C_TIME (allocate-foreign-object 'sql-c-time)) - (#.$SQL_C_TIMESTAMP (allocate-foreign-object 'sql-c-timestamp)) + ((#.$SQL_C_DATE #.$SQL_C_TYPE_DATE) (allocate-foreign-object 'sql-c-date)) + ((#.$SQL_C_TIME #.$SQL_C_TYPE_TIME) (allocate-foreign-object 'sql-c-time)) + ((#.$SQL_C_TIMESTAMP #.$SQL_C_TYPE_TIMESTAMP) (allocate-foreign-object 'sql-c-timestamp)) (#.$SQL_C_FLOAT (uffi:allocate-foreign-object :float)) (#.$SQL_C_DOUBLE (uffi:allocate-foreign-object :double)) (#.$SQL_C_BIT (uffi:allocate-foreign-object :byte)) @@ -756,7 +761,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 +866,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 +884,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) @@ -893,9 +899,9 @@ as possible second argument) to the desired representation of date/time/timestam (read-from-string str)) str)))))) -(def-type c-timestamp-ptr-type '(* (:struct sql-c-timestamp))) -(def-type c-time-ptr-type '(* (:struct sql-c-time))) -(def-type c-date-ptr-type '(* (:struct sql-c-date))) +(def-type c-timestamp-ptr-type (* (:struct sql-c-timestamp))) +(def-type c-time-ptr-type (* (:struct sql-c-time))) +(def-type c-date-ptr-type (* (:struct sql-c-date))) (defun timestamp-to-universal-time (ptr) (declare (type c-timestamp-ptr-type ptr))