Changeset unicode,3 for unicode/src/odbc/parameter.lisp
- Timestamp:
- 12/07/2007 02:13:22 PM (19 years ago)
- revision id:
- svn-v3-trunk1:1c22b0a8-4d0b-0410-a296-af6a2e6f35e3:plain-odbc%2Ftrunk:8
- File:
-
- 1 edited
-
unicode/src/odbc/parameter.lisp (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
unicode/src/odbc/parameter.lisp
r1 r3 55 55 56 56 (defun bind-parameter (hstmt pos param) 57 (setf (slot-value param 'ind-ptr) 58 (cffi:foreign-alloc :long))59 (%sql-bind-parameter 57 (setf (slot-value param 'ind-ptr) 58 (cffi:foreign-alloc 'sql-len)) 59 (%sql-bind-parameter 60 60 hstmt 61 61 pos … … 110 110 (cond 111 111 ((null value) 112 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 113 $SQL_NULL_DATA) 114 (put-string (slot-value param 'value-ptr) "")) 115 (t 116 (cffi:lisp-string-to-foreign value (slot-value param 'value-ptr) (1+ (length value))) 117 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 118 (length value))))) 112 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 113 $SQL_NULL_DATA) 114 (put-string (slot-value param 'value-ptr) "")) 115 (t 116 (cffi:lisp-string-to-foreign value 117 (slot-value param 'value-ptr) 118 (1+ (length value))) 119 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 120 (length value))))) 119 121 120 122 (defmethod get-parameter-value ((param string-parameter)) 121 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))123 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len))) 122 124 (if (= len $SQL_NULL_DATA) 123 nil124 (progn125 (get-string (slot-value param 'value-ptr) len)))))125 nil 126 (progn 127 (get-string (slot-value param 'value-ptr) len))))) 126 128 127 129 ;;------------------------ … … 132 134 133 135 (defmethod initialize-parameter ((param unicode-string-parameter) args) 134 (let ((length-of-buffer (* 2 (or (car args) *default-string-parameter-size*)))) 136 (let ((length-of-buffer 137 (* 2 (or (car args) *default-string-parameter-size*)))) 135 138 (with-slots (value-type parameter-type buffer-length 136 139 column-size value-ptr … … 145 148 (cond 146 149 ((null value) 147 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)148 149 150 151 (t 152 153 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)154 (* 2 (lengthvalue))))))150 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 151 $SQL_NULL_DATA) 152 ;; not necessary 153 (%put-unicode-string (slot-value param 'value-ptr) "")) 154 (t 155 (%put-unicode-string (slot-value param 'value-ptr) value) 156 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 157 (* 2 (length value)))))) 155 158 156 159 (defmethod get-parameter-value ((param unicode-string-parameter)) 157 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))160 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len))) 158 161 (if (= len $SQL_NULL_DATA) 159 nil160 (progn161 (%get-unicode-string (slot-value param 'value-ptr) len)))))162 nil 163 (progn 164 (%get-unicode-string (slot-value param 'value-ptr) len))))) 162 165 163 166 ;;---------------------- … … 174 177 (setf value-type $SQL_C_LONG) 175 178 (setf parameter-type $SQL_INTEGER) 176 (setf buffer-length 4)177 (setf value-ptr (cffi:foreign-alloc :long))))179 (setf buffer-length (cffi:foreign-type-size 'sql-integer)) 180 (setf value-ptr (cffi:foreign-alloc 'sql-integer)))) 178 181 179 182 (defmethod set-parameter-value ((param integer-parameter) value) 180 (cond 183 (cond 181 184 ((null value) 182 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)183 184 (t (setf (cffi:mem-ref (slot-value param 'value-ptr) :long)185 186 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 0))))185 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 186 $SQL_NULL_DATA)) 187 (t (setf (cffi:mem-ref (slot-value param 'value-ptr) 'sql-integer) 188 value) 189 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 0)))) 187 190 188 191 (defmethod get-parameter-value ((param integer-parameter)) 189 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))192 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len))) 190 193 (if (= len $SQL_NULL_DATA) 191 nil192 (progn193 (cffi:mem-ref (slot-value param 'value-ptr) :long)))))194 nil 195 (progn 196 (cffi:mem-ref (slot-value param 'value-ptr) 'sql-integer))))) 194 197 195 198 … … 203 206 (defmethod initialize-parameter ((param double-parameter) args) 204 207 (assert (not args)) 205 206 207 208 209 (setf buffer-length 8)210 (setf value-ptr (cffi:foreign-alloc :double))))208 (with-slots (value-type parameter-type buffer-length value-ptr 209 ind-ptr) param 210 (setf value-type $SQL_C_DOUBLE) 211 (setf parameter-type $SQL_DOUBLE) 212 (setf buffer-length (cffi:foreign-type-size :double)) 213 (setf value-ptr (cffi:foreign-alloc :double)))) 211 214 212 215 (defmethod set-parameter-value ((param double-parameter) value) 213 (cond 214 ((null value) 215 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 216 $SQL_NULL_DATA)) 217 (t 218 (setf (cffi:mem-ref (slot-value param 'value-ptr) :double) 219 (coerce value 'double-float)) 220 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 8)))) 216 (cond 217 ((null value) 218 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 219 $SQL_NULL_DATA)) 220 (t 221 (setf (cffi:mem-ref (slot-value param 'value-ptr) :double) 222 (coerce value 'double-float)) 223 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 224 (cffi:foreign-type-size :double))))) 221 225 222 226 (defmethod get-parameter-value ((param double-parameter)) 223 (if (= (cffi:mem-ref (slot-value param 'ind-ptr) :long) $SQL_NULL_DATA)227 (if (= (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) $SQL_NULL_DATA) 224 228 nil 225 229 (cffi:mem-ref (slot-value param 'value-ptr) :double))) … … 242 246 (setf value-ptr (cffi:foreign-alloc :uchar :count 24)))) 243 247 244 245 248 (defmethod set-parameter-value ((param date-parameter) value) 246 249 (if (null value) 247 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)250 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 248 251 $SQL_NULL_DATA) 249 (progn250 ;; fixme warum 1?251 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 1)252 (multiple-value-bind (sec min hour day month year)253 (decode-universal-time254 (funcall *date-datatype-to-universal-time* value))255 (%put-sql-c-timestamp (slot-value param 'value-ptr) year month day hour min sec 0)))))252 (progn 253 ;; fixme warum 1? 254 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 1) 255 (multiple-value-bind (sec min hour day month year) 256 (decode-universal-time 257 (funcall *date-datatype-to-universal-time* value)) 258 (%put-sql-c-timestamp (slot-value param 'value-ptr) year month day hour min sec 0))))) 256 259 257 260 (defmethod get-parameter-value ((param date-parameter)) 258 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))259 (if (= len $SQL_NULL_DATA) 260 nil261 (funcall *universal-time-to-date-dataype*262 (timestamp-to-universal-time (slot-value param 'value-ptr))))))261 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len))) 262 (if (= len $SQL_NULL_DATA) 263 nil 264 (funcall *universal-time-to-date-dataype* 265 (timestamp-to-universal-time (slot-value param 'value-ptr)))))) 263 266 264 267 … … 280 283 281 284 (defmethod set-parameter-value ((param binary-parameter) value) 282 (if (null value) 283 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 284 $SQL_NULL_DATA) 285 (if (< (slot-value param 'buffer-length) (length value)) 286 (progn 287 (error "buffer is to small") 288 ; we could increase the buffer size with another bind parameter 289 ; or set data_at_execution =1 290 ) 291 (progn 292 ;(break) 293 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 294 (length value)) 295 (put-byte-vector (slot-value param 'value-ptr) value))))) 285 (if (null value) 286 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 287 $SQL_NULL_DATA) 288 (if (< (slot-value param 'buffer-length) (length value)) 289 (progn 290 (error "buffer is to small") 291 ;; we could increase the buffer size with another bind 292 ;; parameter or set data_at_execution =1 293 ) 294 (progn 295 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 296 (length value)) 297 (put-byte-vector (slot-value param 'value-ptr) value))))) 296 298 297 299 298 300 (defmethod get-parameter-value ((param binary-parameter)) 299 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long)))301 (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len))) 300 302 (if (= len $SQL_NULL_DATA) 301 nil302 (get-byte-vector (slot-value param 'value-ptr) len))))303 nil 304 (get-byte-vector (slot-value param 'value-ptr) len)))) 303 305 304 306 … … 323 325 ;; the value-ptr will be needed to find the parameter, 324 326 ;; we store the position there 325 (setf buffer-length 4)326 (setf value-ptr (cffi:foreign-alloc :long))))327 (setf buffer-length (cffi:foreign-type-size 'sql-pointer)) 328 (setf value-ptr (cffi:foreign-alloc 'sql-pointer)))) 327 329 328 330 (defmethod set-parameter-value ((param clob-parameter) value) 329 331 (if (null value) 330 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)332 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 331 333 $SQL_NULL_DATA) 332 (progn333 (setf (slot-value param 'temp-val) value)334 (setf (cffi:mem-ref (slot-value param 'value-ptr) :long)335 336 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)334 (progn 335 (setf (slot-value param 'temp-val) value) 336 (setf (cffi:mem-ref (slot-value param 'value-ptr) :long) 337 (slot-value param 'position)) 338 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 337 339 (%sql-len-data-at-exec (length value)))))) 338 340 … … 373 375 ;; the value-ptr will be needed to find the parameter, 374 376 ;; we store the position there 375 (setf buffer-length 4)376 (setf value-ptr (cffi:foreign-alloc :long))))377 (setf buffer-length (cffi:foreign-type-size 'sql-pointer)) 378 (setf value-ptr (cffi:foreign-alloc 'sql-pointer)))) 377 379 378 380 (defmethod set-parameter-value ((param uclob-parameter) value) 379 381 (if (null value) 380 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)382 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 381 383 $SQL_NULL_DATA) 382 384 (progn 383 385 (setf (slot-value param 'temp-val) value) 384 (setf (cffi:mem-ref (slot-value param 'value-ptr) :long)386 (setf (cffi:mem-ref (slot-value param 'value-ptr) ':long) 385 387 (slot-value param 'position)) 386 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)388 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 387 389 (%sql-len-data-at-exec (* 2 (length value))))))) 388 390 … … 422 424 ;; the value-ptr will be needed to find the parameter, 423 425 ;; we store the position there 424 (setf buffer-length 4) 425 (setf value-ptr (cffi:foreign-alloc :long)))) 426 (setf buffer-length (cffi:foreign-type-size 'sql-pointer)) 427 (setf value-ptr (cffi:foreign-alloc 'sql-pointer))) 428 ) 426 429 427 430 (defmethod set-parameter-value ((param blob-parameter) value) 428 431 (if (null value) 429 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long)432 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 430 433 $SQL_NULL_DATA) 431 434 (progn 432 435 (setf (slot-value param 'temp-val) value) 433 (setf (cffi:mem-ref (slot-value param 'value-ptr) :long)436 (setf (cffi:mem-ref (slot-value param 'value-ptr) ':long) 434 437 (slot-value param 'position)) 435 (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 436 (%sql-len-data-at-exec (length value)))))) 438 (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 439 (%sql-len-data-at-exec (length value))) 440 ))) 437 441 438 442 (defmethod send-parameter-data ((param blob-parameter) hstmt) … … 440 444 (len (length temp-val)) 441 445 (buffer (cffi:foreign-alloc :uchar 442 446 :count (if (zerop len) 1 len)))) 443 447 (put-byte-vector buffer 444 448 temp-val)
Note: See TracChangeset
for help on using the changeset viewer.
