?? oracle.lisp
字號(hào):
) ; Do a real fetch from Oracle (t (let ((fetch_status (oracle_fetch_row (curconn)))) (cond ((not (lisp-truth fetch_status)) (error (oracle_last_error (curconn)))) ((= fetch_status 2) ; Newly arrived at EOF - do nothing ) (t ; Good fetch - get and convert row data (setf result (oracle_row_values (curconn))) (check-success) ; Convert NULL values to NIL (map-into result #'from-sqlval result) ; Convert number and string types to Lisp based on Oracle type (let ((colinfo (oracle_column_info (curconn)))) (check-success) (map-into result #'convert-type result colinfo) result)))))) ; Set the flag that fetch was called at least once. ; This is to avoid further fetch calls to underlying Oracle library ; when we are already at EOF. (setf (db-fetch-called *oracle-connection*) t) (row-to-result result result-type)));----------------------------------------------; FETCH-ALL(defun fetch-all (&optional max-rows (result-type 'ARRAY) (item-type 'ARRAY))"(ORACLE:FETCH-ALL(&optional max-rows (result-type 'ARRAY) (item-type 'ARRAY))Fetch all rows from a query and return result as a sequence ofsequences. Arguments (all optional) are: max-rows Maximum number of rows to fetch result-type Sequence type of row set 'ARRAY (default) or 'LIST item-type Sequence type of columns per row,'ARRAY (default) or 'LIST" (check-connection "fetch all rows of data") (do ((result (make-array 100 :element-type item-type :fill-pointer 0 :adjustable t)) (count 0 (1+ count)) (row (oracle:fetch) (oracle:fetch))) ((or (null row) (when max-rows (>= count max-rows))) (coerce result result-type)) (vector-push-extend (coerce row item-type) result)));----------------------------------------------; PEEK(defun peek (&optional (result-type 'ARRAY))"(ORACLE:PEEK (&optional (result-type 'ARRAY)))Peek at next row of data (without fetching it). Same as fetch, exceptdoes not advance the database cursor to the next row. Returns NIL ifat EOF. If data is available, returns row data as FETCH (see FETCHfor data format and conversions done).Arguments: none" (check-connection "peek at next row of data") (cond ((not (db-fetch-called *oracle-connection*)) (setf (db-pending-row *oracle-connection*) (fetch))) ((and (not (db-pending-row *oracle-connection*)) (not (eof))) (setf (db-pending-row *oracle-connection*) (fetch)))) (row-to-result (db-pending-row *oracle-connection*) result-type));----------------------------------------------; COLUMNS - Return column info for most recent SELECT(defun columns ()"(ORACLE:COLUMNS)Returns an array of column information structures, one for eachresult column in the most recent SELECT statement. Each structure hasslots: NAME = Oracle colume name, or the expression selected. If the query used a column alias, \"SELECT <expr> AS <name>\" this alias will be returned. TYPE = Oracle data type (VARCHAR, NUMBER, DATE, ...) SIZE = Oracle data length (useful mostly for character types) SCALE = For numeric types, number of digits to right of decimal PRECISION = For numeric types, total number of significant digits NULL_OK = T if NULLs allowed, NIL if nulls are not allowed.Arguments: none" (check-connection "get column information") (let ((cached-info (db-colinfo *oracle-connection*))) (if cached-info cached-info (let ((result (oracle_column_info (curconn)))) (check-success) ; Convert C truth to Lisp for export (map-into result #'(lambda (col) (setf (sqlcol-null_ok col) (lisp-truth (sqlcol-null_ok col))) col) result) (setf (db-colinfo *oracle-connection*) result) result))));----------------------------------------------; EOF(defun eof ()"(ORACLE:EOF)Returns EOF status. A SELECT query is consdiered at EOF if the nextFETCH will return no data. Must be connected to a database, and havean active SELECT statement.Arguments: none" (check-connection "determine if at fetch EOF") (cond ((not (db-fetch-called *oracle-connection*)) (null (peek))) ((db-pending-row *oracle-connection*) nil) (t (let ((oracle-eof (lisp-truth (oracle_eof (curconn))))) (check-success) (when (not oracle-eof) (setf (db-pending-row *oracle-connection*) (fetch))) (null (db-pending-row *oracle-connection*))))));----------------------------------------------; INSERT-ROW(defun insert-row (table vals)"(ORACLE:INSERT-ROW table values)Inserts a row into table. First argument is a table name, secondargument is a map of column names to values, either a hash table or alist of (name, value) pairs. Columns missing from the map will begiven the default Oracle value, or NULL.Returns: the number of rows inserted (i.e., 1)." (when (null vals) (error "NULL name -> value map given")) (setf vals (check-pairs vals)) (when (= 0 (hash-table-count vals)) (error "Empty column map given")) ; Build the INSERT statement (let ((sql (cat "INSERT INTO " table " (" (comma-list-of-keys vals) ") VALUES (" (comma-list-of-keys vals t) ")"))) (run-sql sql vals)));----------------------------------------------; UPDATE-ROW(defun update-row (table condition vals &optional params)"(ORACLE:UPDATE-ROW table condition values &optional params)Updates rows in a table. First argument is the table. Secondargument is a condition expression for a WHERE clause (without the\"WHERE\") which determines which rows are updated. Third argument isa map of columns to be updated to their new values. The map may begiven as a hash or list of (name, value) pairs. Last optionalargument is used to specify bind parameters that may occur in thecondition expression; this is most commonly done when the condition isa match on a primary key, e.g.: \"pk_column = :pk_val\".Returns: the number of rows updated." (when (null vals) (error "NULL name -> value map given")) (setf vals (check-pairs vals)) (when (= 0 (hash-table-count vals)) (error "Empty column map given")) ; Build the UPDATE statement (let ((sql (cat "UPDATE " table " SET ")) (plural nil)) (loop for hkey being each hash-key of vals do (if plural (setf sql (cat sql ", ")) (setf plural t)) (setf sql (cat sql hkey " = :" hkey))) (setf sql (cat sql " WHERE " condition)) ; Note we need to convert params to hash to combine it (run-sql sql (hash-combine (check-pairs params) vals))));----------------------------------------------; ROW-COUNT(defun row-count ()"(ORACLE:ROW-COUNT)For SELECT statements, returns the number of rows fetched (NOT peeked)so far. For other statements (INSERT/UPDATE/DELETE), returns thenumber of rows inserted/updated/deleted. Must be connected to adatabase and have an active SQL statement.Arguments: none" (check-connection "get number of rows fetched or modified") (let ((rowcount (oracle_rows_affected (curconn)))) (check-success) ; Maybe adjust downward to account for lookahead row (if (db-pending-row *oracle-connection*) (- rowcount 1) rowcount)));----------------------------------------------; AUTO-COMMIT(defun auto-commit (enable)"(ORACLE:AUTO-COMMIT)Enables or disables auto-commit. When auto-commit is enabled,modifications to the database are committed (made permanent) aftereach call to RUN-SQL. With auto-commit disabled, it is the callersresponsibility to explictly commit (or abort) changes by callingCOMMIT (or ROLLBACK), or to ensure transactional integrity by usingthe WITH-TRANSACTION macro. This function returns the previous statusof auto-commit. This function may not be called inside theWITH-TRANSACTION macro.Arguments: (Boolean) Whether to enable auto-commit." (when *oracle-in-transaction* (error "Setting of AUTO-COMMIT not allowed inside WITH-TRANSACTION")) (auto-commit-nocheck enable)); Private version that does not check if in transaction(defun auto-commit-nocheck (enable) (check-connection "enable/disable auto-commit") (let ((old-value (lisp-truth (oracle_set_auto_commit (curconn) (c-truth enable))))) (check-success) old-value));----------------------------------------------; WITH-TRANSACTION(defmacro with-transaction (&body body)"(ORACLE:WITH-TRANSACTION (&body body))Executes Lisp code atomically as a transaction, ensuring that eitherall the database operations complete successfully, or none of them do.If there are any pending un-committed changes when this macro iscalled, they are ROLLED BACK so that the database is affected only bythe updates inside the macro body. Nesting of the macro is notallowed and will produce an error. There is no effect on the statusof auto-commit; it resumes its previous state when the macro exits.The value returned by the macro is that of the last form in the macrobody." (let ((prev-auto-commit (gensym)) (commit-ok (gensym)) (result (gensym))) `(progn ; Check nesting (when *oracle-in-transaction* (error "Nesting of WITH-TRANSACTION is not allowed.")) (let ((,prev-auto-commit t) (,commit-ok nil)) (unwind-protect (progn ; Mark us as inside the macro (setf *oracle-in-transaction* t) ; Turn off auto-commit and save for later restore (setf ,prev-auto-commit (auto-commit-nocheck nil)) ; Roll back any pending operation so that the database sees ; only the effects of what's inside this macro (if (not ,prev-auto-commit) (rollback-nocheck)) (setf ,result (progn ,@body)) (commit-nocheck) (setf ,commit-ok t) ,result) ; Cleanup (progn (when (not ,commit-ok) (rollback-nocheck)) ; Only roll back if need to (auto-commit-nocheck ,prev-auto-commit) (setf *oracle-in-transaction* nil)))))));----------------------------------------------; COMMIT(defun commit ()"(ORACLE:COMMIT)Commits (makes permanent) any pending changes to the database. Theauto-commit feature must be OFF to use this function, nor can it becalled inside the WITH-TRANSACTION macro. Always returns NIL.Argument: none" (when *oracle-in-transaction* (error "COMMIT not allowed inside WITH-TRANSACTION")) (commit-nocheck))(defun commit-nocheck () (check-connection "commit transaction") (oracle_commit (curconn)) (check-success) nil);----------------------------------------------; ROLLBACK(defun rollback ()"(ORACLE:ROLLBACK)Rolls back (abandons) any pending changes to the database. Theauto-commit feature must be OFF to use this function, nor can it becalled insde the WITH-TRANSACTION macro. Always returns NIL.Argument: none" (when *oracle-in-transaction* (error "ROLLBACK not allowed inside WITH-TRANSACTION")) (rollback-nocheck))(defun rollback-nocheck () (check-connection "rollback transaction") (oracle_rollback (curconn)) (check-success) nil); =-=-=-=-=-=-=- INTERNAL FUNCTIONS BELOW =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-; Helper functions for DO-ROWS(defun do-rows-var (v) (if (atom v) v (car v)))(defun do-rows-col (v) (if (atom v) v (cadr v)))(defun do-rows-index-of (v) (let ((i (position (to-string (do-rows-col v)) (map 'array #'(lambda (x) (to-string (sqlcol-name x))) (columns)) :test #'equal))) (when (null i) (error (cat "DO-ROWS: Column '" (do-rows-col v) "' does not occur in query. Allowed columns are:~%" (column-names)))) i)); COLUMN-NAMES; Get list of column names, one per line.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -