X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-oracle%2Foracle-sql.lisp;h=aa7c6d79e0ad70f3b604a57356b47c8144e46839;hp=b18bad77e40fc22f35b9079fe02d8675e3e1de32;hb=6b34e2293a52b03e8611c85e4e53a0ab5c8a3c1a;hpb=0f707b093bdc29389f59db6e50441ac93f47b4b9 diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index b18bad7..aa7c6d7 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -99,7 +99,7 @@ likely that we'll have to worry about the CMUCL limit.")) (date-format :initarg :date-format :reader date-format - :initform "YYYY-MM-DD HH24:MI:SS\"+00\"") + :initform "YYYY-MM-DD HH24:MI:SS\".0\"") (date-format-length :type number :documentation @@ -154,8 +154,8 @@ the length of that format.") (cond (database (with-slots (errhp) database - (uffi:with-foreign-objects ((errcode 'sb4) - (errbuf '(:array :unsigned-char #.+errbuf-len+))) + (let ((errcode (uffi:allocate-foreign-object 'sb4)) + (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))) @@ -169,6 +169,8 @@ the length of that format.") +errbuf-len+ +oci-htype-error+)) (let ((subcode (uffi:deref-pointer errcode 'sb4)) (errstr (uffi:convert-from-foreign-string errbuf))) + (uffi:free-foreign-object errcode) + (uffi:free-foreign-object errbuf) (unless (and nulls-ok (= subcode +null-value-returned+)) (error 'sql-database-error :database database @@ -498,46 +500,47 @@ the length of that format.") (defun sql-stmt-exec (sql-stmt-string db result-types field-names) (with-slots (envhp svchp errhp) db - (let ((stmthp (uffi:allocate-foreign-object :pointer-void)) - select-p) - - (uffi:with-foreign-object (stmttype :unsigned-short) - (unwind-protect - (progn - (oci-handle-alloc (deref-vp envhp) - stmthp - +oci-htype-stmt+ 0 +null-void-pointer-pointer+) - (oci-stmt-prepare (deref-vp stmthp) - (deref-vp errhp) - (uffi:convert-to-cstring sql-stmt-string) - (length sql-stmt-string) - +oci-ntv-syntax+ +oci-default+ :database db) - (oci-attr-get (deref-vp stmthp) - +oci-htype-stmt+ - stmttype - +unsigned-int-null-pointer+ - +oci-attr-stmt-type+ - (deref-vp errhp) - :database db) - - (setq select-p (= (uffi:deref-pointer stmttype :unsigned-short) 1)) - (let ((iters (if select-p 0 1))) - - (oci-stmt-execute (deref-vp svchp) - (deref-vp stmthp) - (deref-vp errhp) - iters 0 +null-void-pointer+ +null-void-pointer+ +oci-default+ - :database db))) - ;; free resources unless a query - (unless select-p - (oci-handle-free (deref-vp stmthp) +oci-htype-stmt+) - (uffi:free-foreign-object stmthp)))) - - (cond - (select-p - (make-query-cursor db stmthp result-types field-names)) - (t - nil))))) + (uffi:with-foreign-strings ((c-stmt-string sql-stmt-string)) + (let ((stmthp (uffi:allocate-foreign-object :pointer-void)) + select-p) + + (uffi:with-foreign-object (stmttype :unsigned-short) + (unwind-protect + (progn + (oci-handle-alloc (deref-vp envhp) + stmthp + +oci-htype-stmt+ 0 +null-void-pointer-pointer+) + (oci-stmt-prepare (deref-vp stmthp) + (deref-vp errhp) + c-stmt-string + (length sql-stmt-string) + +oci-ntv-syntax+ +oci-default+ :database db) + (oci-attr-get (deref-vp stmthp) + +oci-htype-stmt+ + stmttype + +unsigned-int-null-pointer+ + +oci-attr-stmt-type+ + (deref-vp errhp) + :database db) + + (setq select-p (= (uffi:deref-pointer stmttype :unsigned-short) 1)) + (let ((iters (if select-p 0 1))) + + (oci-stmt-execute (deref-vp svchp) + (deref-vp stmthp) + (deref-vp errhp) + iters 0 +null-void-pointer+ +null-void-pointer+ +oci-default+ + :database db))) + ;; free resources unless a query + (unless select-p + (oci-handle-free (deref-vp stmthp) +oci-htype-stmt+) + (uffi:free-foreign-object stmthp)))) + + (cond + (select-p + (make-query-cursor db stmthp result-types field-names)) + (t + nil)))))) ;; Return a QUERY-CURSOR representing the table returned from the OCI @@ -795,6 +798,7 @@ the length of that format.") (oci-env-create envhp +oci-default+ +null-void-pointer+ +null-void-pointer+ +null-void-pointer+ +null-void-pointer+ 0 +null-void-pointer-pointer+) + #+oci7 (progn (oci-initialize +oci-object+ +null-void-pointer+ +null-void-pointer+ @@ -803,27 +807,12 @@ the length of that format.") +oci-htype-env+ 0 +null-void-pointer-pointer+)) ;no testing return (oci-env-init envhp +oci-default+ 0 +null-void-pointer-pointer+)) + (oci-handle-alloc (deref-vp envhp) errhp +oci-htype-error+ 0 +null-void-pointer-pointer+) (oci-handle-alloc (deref-vp envhp) srvhp +oci-htype-server+ 0 +null-void-pointer-pointer+) - #+ignore ;; not used since CLSQL uses the OCILogon function instead - (uffi:with-cstring (dblink nil) - (oci-server-attach (deref-vp srvhp) - (deref-vp errhp) - dblink - 0 +oci-default+)) - - (oci-handle-alloc (deref-vp envhp) svchp - +oci-htype-svcctx+ 0 +null-void-pointer-pointer+) - (oci-attr-set (deref-vp svchp) - +oci-htype-svcctx+ - (deref-vp srvhp) 0 +oci-attr-server+ - (deref-vp errhp)) - ;; oci-handle-alloc((dvoid *)encvhp, (dvoid **)&stmthp, OCI_HTYPE_STMT, 0, 0); - ;;#+nil - (let ((db (make-instance 'oracle-database :name (database-name-from-spec connection-spec database-type) @@ -834,13 +823,16 @@ the length of that format.") :svchp svchp :dsn data-source-name :user user))) - (oci-logon (deref-vp envhp) - (deref-vp errhp) - svchp - (uffi:convert-to-cstring user) (length user) - (uffi:convert-to-cstring password) (length password) - (uffi:convert-to-cstring data-source-name) (length data-source-name) - :database db) + (uffi:with-foreign-strings ((c-user user) + (c-password password) + (c-data-source-name data-source-name)) + (oci-logon (deref-vp envhp) + (deref-vp errhp) + svchp + c-user (length user) + c-password (length password) + c-data-source-name (length data-source-name) + :database db)) ;; :date-format-length (1+ (length date-format))))) (setf (slot-value db 'clsql-sys::state) :open) (database-execute-command