;;; database. Thus, there's no obstacle to having any number of DB
;;; objects referring to the same database.
-(uffi:def-type pointer-pointer-void '(* :pointer-void))
+(uffi:def-type pointer-pointer-void (* :pointer-void))
(defclass oracle-database (database) ; was struct db
((envhp
;;; NULLS-OK are as in the OERR function.
(defun handle-oci-error (&key database nulls-ok)
- (cond (database
- (with-slots (errhp) database
- (uffi:with-foreign-objects ((errbuf '(:array :unsigned-char
- #.+errbuf-len+))
- (errcode :long))
- ;; ensure errbuf empty string
- (setf (uffi:deref-array errbuf '(:array :unsigned-char) 0)
- (uffi:ensure-char-storable (code-char 0)))
- (setf (uffi:deref-pointer errcode :long) 0)
-
- (uffi:with-cstring (sqlstate nil)
- (oci-error-get (deref-vp errhp) 1
- sqlstate
- errcode
- (uffi:char-array-to-pointer errbuf)
- +errbuf-len+ +oci-htype-error+))
- (let ((subcode (uffi:deref-pointer errcode :long)))
- (unless (and nulls-ok (= subcode +null-value-returned+))
- (error 'sql-database-error
- :database database
- :error-id subcode
- :message (uffi:convert-from-foreign-string errbuf)))))))
- (nulls-ok
- (error 'sql-database-error
- :database database
- :message "can't handle NULLS-OK without ERRHP"))
- (t
- (error 'sql-database-error
- :database database
- :message "OCI Error (and no ERRHP available to find subcode)"))))
+ (cond
+ (database
+ (with-slots (errhp) database
+ (uffi:with-foreign-object (errcode :long)
+ (let ((errbuf (uffi:allocate-foreign-string #.+errbuf-len+)))
+ ;; ensure errbuf empty string
+ (setf (uffi:deref-array errbuf '(:array :unsigned-char) 0)
+ (uffi:ensure-char-storable (code-char 0)))
+ (setf (uffi:deref-pointer errcode :long) 0)
+
+ (uffi:with-cstring (sqlstate nil)
+ (oci-error-get (deref-vp errhp) 1
+ sqlstate
+ errcode
+ (uffi:char-array-to-pointer errbuf)
+ +errbuf-len+ +oci-htype-error+))
+ (let ((subcode (uffi:deref-pointer errcode :long)))
+ (unless (and nulls-ok (= subcode +null-value-returned+))
+ (error 'sql-database-error
+ :database database
+ :error-id subcode
+ :message (uffi:convert-from-foreign-string errbuf))))
+ (uffi:free-foreign-object errbuf)))))
+ (nulls-ok
+ (error 'sql-database-error
+ :database database
+ :message "can't handle NULLS-OK without ERRHP"))
+ (t
+ (error 'sql-database-error
+ :database database
+ :message "OCI Error (and no ERRHP available to find subcode)"))))
;;; Require an OCI success code.
;;;
(defmethod database-list-tables ((database oracle-database) &key owner)
(let ((query
- (if owner
- (format nil
- "select user_tables.table_name from user_tables,all_tables where user_tables.table_name=all_tables.table_name and all_tables.owner='~:@(~A~)'"
- owner)
- "select table_name from user_tables")))
+ (cond ((null owner)
+ "select table_name from user_tables")
+ ((eq owner :all)
+ "select table_name from all_tables")
+ (t
+ (format nil
+ "select user_tables.table_name from user_tables,all_tables where user_tables.table_name=all_tables.table_name and all_tables.owner='~:@(~A~)'"
+ owner)))))
(mapcar #'car (database-query query database nil nil))))
(defmethod database-list-views ((database oracle-database) &key owner)
(let ((query
- (if owner
- (format nil
- "select user_views.view_name from user_views,all_views where user_views.view_name=all_views.view_name and all_views.owner='~:@(~A~)'"
- owner)
- "select view_name from user_views")))
+ (cond ((null owner)
+ "select view_name from user_views")
+ ((eq owner :all)
+ "select view_name from all_views")
+ (t
+ (format nil
+ "select user_views.view_name from user_views,all_views where user_views.view_name=all_views.view_name and all_views.owner='~:@(~A~)'"
+ owner)))))
(mapcar #'car
- (database-query query database nil nil))))
+ (database-query query database nil nil))))
(defmethod database-list-indexes ((database oracle-database)
&key (owner nil))
(let ((query
- (if owner
- (format nil
- "select user_indexes.index_name from user_indexes,all_indexes where user_indexes.index_name=all_indexes.index_name and all_indexes.owner='~:@(~A~)'"
- owner)
- "select index_name from user_indexes")))
+ (cond ((null owner)
+ "select index_name from user_indexes")
+ ((eq owner :all)
+ "select index_name from all_indexes")
+ (t (format nil
+ "select user_indexes.index_name from user_indexes,all_indexes where user_indexes.index_name=all_indexes.index_name and all_indexes.owner='~:@(~A~)'"
+ owner)))))
(mapcar #'car (database-query query database nil nil))))
(defmethod database-list-table-indexes (table (database oracle-database)
&key (owner nil))
(let ((query
- (if owner
- (format nil
- "select user_indexes.index_name from user_indexes,all_indexes where user_indexes.table_name='~A' and user_indexes.index_name=all_indexes.index_name and all_indexes.owner='~:@(~A~)'"
- table owner)
- (format nil "select index_name from user_indexes where table_name='~A'"
- table))))
+ (cond ((null owner)
+ (format nil "select index_name from user_indexes where table_name='~A'"
+ table))
+ ((eq owner :all)
+ (format nil "select index_name from all_indexes where table_name='~A'"
+ table))
+ (t
+ (format nil
+ "select user_indexes.index_name from user_indexes,all_indexes where user_indexes.table_name='~A' and user_indexes.index_name=all_indexes.index_name and all_indexes.owner='~:@(~A~)'"
+ table owner)))))
(mapcar #'car (database-query query database nil nil))))
(defmethod database-list-attributes (table (database oracle-database) &key owner)
(let ((query
- (if owner
- (format nil
- "select user_tab_columns.column_name from user_tab_columns,all_tables where user_tab_columns.table_name='~A' and all_tables.table_name=user_tab_columns.table_name and all_tables.owner='~:@(~A~)'"
- table owner)
- (format nil
- "select column_name from user_tab_columns where table_name='~A'"
- table))))
+ (cond ((null owner)
+ (format nil "select column_name from user_tab_columns where table_name='~A'"
+ table))
+ ((eq owner :all)
+ (format nil "select column_name from all_tab_columns where table_name='~A'"
+ table))
+ (t
+ (format nil
+ "select user_tab_columns.column_name from user_tab_columns,all_tables where user_tab_columns.table_name='~A' and all_tables.table_name=user_tab_columns.table_name and all_tables.owner='~:@(~A~)'"
+ table owner)))))
(mapcar #'car (database-query query database nil nil))))
(defmethod database-attribute-type (attribute (table string)
(database oracle-database)
&key (owner nil))
(let ((query
- (if owner
- (format nil
- "select data_type,data_length,data_scale,nullable from user_tab_columns,all_tables where user_tab_columns.table_name='~A' and column_name='~A' and all_tables.table_name=user_tab_columns.table_name and all_tables.owner='~:@(~A~)'"
- table attribute owner)
- (format nil
- "select data_type,data_length,data_scale,nullable from user_tab_columns where table_name='~A' and column_name='~A'"
- table attribute))))
+ (cond ((null owner)
+ (format nil
+ "select data_type,data_length,data_scale,nullable from user_tab_columns where table_name='~A' and column_name='~A'"
+ table attribute))
+ ((eq owner :all)
+ (format nil
+ "select data_type,data_length,data_scale,nullable from all_tab_columns where table_name='~A' and column_name='~A'"
+ table attribute))
+ (t
+ (format nil
+ "select data_type,data_length,data_scale,nullable from user_tab_columns,all_tables where user_tab_columns.table_name='~A' and column_name='~A' and all_tables.table_name=user_tab_columns.table_name and all_tables.owner='~:@(~A~)'"
+ table attribute owner)))))
(destructuring-bind (type length scale nullable) (car (database-query query database :auto nil))
(values (ensure-keyword type) length scale
(if (char-equal #\Y (schar nullable 0)) 1 0)))))
;; STREAM which has no more data, and QC is not a STREAM, we signal
;; DBI-ERROR instead.
-(uffi:def-type short-array '(:array :short))
-(uffi:def-type int-pointer '(* :int))
-(uffi:def-type double-pointer '(* :double))
+(uffi:def-type short-array (:array :short))
+(uffi:def-type int-pointer (* :int))
+(uffi:def-type double-pointer (* :double))
;;; the result of a database query: a cursor through a table
(defstruct (oracle-result-set (:print-function print-query-cursor)
;; 21 bytes. See pp. 3-10, 3-26, and 6-13 of OCI documentation
;; for more details.
+;; Mac OS X Note: According to table 6-8 in the Oracle 9i OCI
+;; documentation, PRECISION may actually be an sb2 instead of a
+;; single byte if performing an "implicit describe". Using a
+;; signed short instead of an unsigned byte fixes a Mac OS X bug
+;; where PRECISION is always zero. -- JJB 20040713
+
;; When calling OCI C code to handle the conversion, we have
;; only two numeric types available to pass the return value:
;; double-float and signed-long. It would be possible to
;; below, beware!) try setting this value into COLSIZE, calling OCI,
;; then looking at the value in COLSIZE. (setf colsize #x12345678)
;; debugging only
-
+
+;; Mac OS X Note: This workaround fails on a bigendian platform so
+;; I've changed the data type of COLNAME to :unsigned-short as per
+;; the Oracle 9i OCI documentation. -- JJB 20040713
(uffi:def-type byte-pointer (* :byte))
(uffi:def-type ulong-pointer (* :unsigned-long))
(with-slots (errhp) database
(uffi:with-foreign-objects ((dtype-foreign :unsigned-short)
(parmdp :pointer-void)
- (precision :byte)
+ (precision :short)
(scale :byte)
(colname '(* :unsigned-char))
(colnamelen :unsigned-long)
- (colsize :unsigned-long)
+ (colsize :unsigned-short)
(colsizesize :unsigned-long)
(defnp ':pointer-void))
(let ((buffer nil)
+oci-attr-scale+
(deref-vp errhp))
(let ((*scale (uffi:deref-pointer scale :byte))
- (*precision (uffi:deref-pointer precision :byte)))
+ (*precision (uffi:deref-pointer precision :short)))
;;(format t "scale=~d, precision=~d~%" *scale *precision)
(cond
dtype #.SQLT-FLT)))))
;; Default to SQL-STR
(t
- (setf (uffi:deref-pointer colsize :unsigned-long) 0)
+ (setf (uffi:deref-pointer colsize :unsigned-short) 0)
(setf dtype #.SQLT-STR)
(oci-attr-get (deref-vp parmdp)
+oci-dtype-param+
+unsigned-int-null-pointer+
+oci-attr-data-size+
(deref-vp errhp))
- (let ((colsize-including-null (1+ (uffi:deref-pointer colsize :unsigned-long))))
+ (let ((colsize-including-null (1+ (uffi:deref-pointer colsize :unsigned-short))))
(setf buffer (acquire-foreign-resource
:unsigned-char (* +n-buf-rows+ colsize-including-null)))
(setf sizeof colsize-including-null))))
;; handle errors very gracefully (since they're part of the
;; error-handling mechanism themselves) so we just assert they
;; work.
+
(setf (deref-vp envhp) +null-void-pointer+)
+
#-oci7
(oci-env-create envhp +oci-default+ +null-void-pointer+
+null-void-pointer+ +null-void-pointer+
(defmethod database-list-sequences ((database oracle-database) &key owner)
(let ((query
- (if owner
- (format nil
- "select user_sequences.sequence_name from user_sequences,all_sequences where user_sequences.sequence_name=all_sequences.sequence_name and all_sequences.sequence_owner='~:@(~A~)'"
- owner)
- "select sequence_name from user_sequences")))
+ (cond ((null owner)
+ "select sequence_name from user_sequences")
+ ((eq owner :all)
+ "select sequence_name from all_sequences")
+ (t
+ (format nil
+ "select user_sequences.sequence_name from user_sequences,all_sequences where user_sequences.sequence_name=all_sequences.sequence_name and all_sequences.sequence_owner='~:@(~A~)'"
+ owner)))))
(mapcar #'car (database-query query database nil nil))))
(defmethod database-execute-command (sql-expression (database oracle-database))