X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-oracle%2Foracle-sql.lisp;h=03480682f823b91a691533ba217c9239eca6fb5c;hp=0250a34357bbf3c017d624198e29e0c1343ff6f9;hb=f97c6c182c9746cd6adbdacf8cdfebbaadef3c37;hpb=8d66a64a8453c9a9b26b2959d9238b5edec03564 diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index 0250a34..0348068 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -126,36 +126,37 @@ the length of that format.") ;;; 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. ;;; @@ -234,68 +235,88 @@ the length of that format.") (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))))) @@ -508,6 +529,12 @@ the length of that format.") ;; 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 @@ -554,7 +581,10 @@ the length of that format.") ;; 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)) @@ -567,11 +597,11 @@ the length of that format.") (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) @@ -614,7 +644,7 @@ the length of that format.") +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 @@ -629,7 +659,7 @@ the length of that format.") 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+ @@ -637,7 +667,7 @@ the length of that format.") +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)))) @@ -719,7 +749,9 @@ the length of that format.") ;; 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+ @@ -878,11 +910,14 @@ the length of that format.") (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))