suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

db: report SQL stmt in errors when available

Browse Source
This commit is contained in:
Ryan Culpepper 2014-10-31 12:01:48 -04:00
parent b2434ab5b9
commit 2d38b089cd
2 changed files with 34 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
racket/collects/db/private/sqlite3/connection.rkt
View File

@ -87,7 +87,7 @@
(and (null? info) (sqlite3_total_changes db))] (and (null? info) (sqlite3_total_changes db))]
[result [result
(or cursor? (or cursor?
(step* fsym db stmt #f +inf.0))]) (step* fsym db stmt #f +inf.0 pst))])
(unless (eq? (get-tx-status) 'invalid) (unless (eq? (get-tx-status) 'invalid)
(set-tx-status! fsym (read-tx-status))) (set-tx-status! fsym (read-tx-status)))
(unless cursor? (unless cursor?
@ -119,7 +119,7 @@
(cond [(unbox end-box) #f] (cond [(unbox end-box) #f]
[else [else
(let ([stmt (send pst get-handle)]) (let ([stmt (send pst get-handle)])
(begin0 (step* fsym (get-db fsym) stmt end-box fetch-size) (begin0 (step* fsym (get-db fsym) stmt end-box fetch-size pst)
(when (unbox end-box) (when (unbox end-box)
(send pst after-exec #f))))]))))) (send pst after-exec #f))))])))))
@ -150,7 +150,7 @@
[else [else
(error/internal* fsym "bad parameter value" '("value" value) param)]))) (error/internal* fsym "bad parameter value" '("value" value) param)])))
(define/private (step* fsym db stmt end-box fetch-limit) (define/private (step* fsym db stmt end-box fetch-limit pst)
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
(lambda (e) (lambda (e)
(void (sqlite3_reset stmt)) (void (sqlite3_reset stmt))
@ -159,7 +159,7 @@
(let loop ([fetch-limit fetch-limit]) (let loop ([fetch-limit fetch-limit])
(if (zero? fetch-limit) (if (zero? fetch-limit)
null null
(let ([c (step fsym db stmt)]) (let ([c (step fsym db stmt pst)])
(cond [c (cond [c
(cons c (loop (sub1 fetch-limit)))] (cons c (loop (sub1 fetch-limit)))]
[else [else
@ -168,8 +168,8 @@
(when end-box (set-box! end-box #t)) (when end-box (set-box! end-box #t))
null])))))) null]))))))
(define/private (step fsym db stmt) (define/private (step fsym db stmt pst)
(let ([s (HANDLE fsym (sqlite3_step stmt))]) (let ([s (HANDLE fsym (sqlite3_step stmt) pst)])
(cond [(= s SQLITE_DONE) #f] (cond [(= s SQLITE_DONE) #f]
[(= s SQLITE_ROW) [(= s SQLITE_ROW)
(let* ([column-count (sqlite3_column_count stmt)] (let* ([column-count (sqlite3_column_count stmt)]
@ -340,10 +340,14 @@
;; ---- ;; ----
(define-syntax-rule (HANDLE who expr) (define-syntax HANDLE
(handle* who (lambda () expr) 0)) (syntax-rules ()
[(HANDLE who expr)
(HANDLE who expr #f)]
[(HANDLE who expr pst)
(handle* who (lambda () expr) 0 pst)]))
(define/private (handle* who thunk iteration) (define/private (handle* who thunk iteration pst)
(call-with-values thunk (call-with-values thunk
(lambda (full-s . rest) (lambda (full-s . rest)
(define s (simplify-status full-s)) (define s (simplify-status full-s))
@ -356,17 +360,17 @@
who who
(if (= s SQLITE_BUSY) "SQLITE_BUSY" s) (if (= s SQLITE_BUSY) "SQLITE_BUSY" s)
iteration)) iteration))
(apply values (handle-status who full-s) rest)])))) (apply values (handle-status who full-s pst) rest)]))))
;; Some errors can cause whole transaction to rollback; ;; Some errors can cause whole transaction to rollback;
;; (see http://www.sqlite.org/lang_transaction.html) ;; (see http://www.sqlite.org/lang_transaction.html)
;; So when those errors occur, compare current tx-status w/ saved. ;; So when those errors occur, compare current tx-status w/ saved.
;; Can't figure out how to test... ;; Can't figure out how to test...
(define/private (handle-status who full-s) (define/private (handle-status who full-s pst)
(when (memv (simplify-status full-s) maybe-rollback-status-list) (when (memv (simplify-status full-s) maybe-rollback-status-list)
(when (and saved-tx-status -db (not (read-tx-status))) ;; was in trans, now not (when (and saved-tx-status -db (not (read-tx-status))) ;; was in trans, now not
(set-tx-status! who 'invalid))) (set-tx-status! who 'invalid)))
(handle-status* who full-s -db db-spec)) (handle-status* who full-s -db db-spec pst))
;; ---- ;; ----
@ -385,10 +389,11 @@
;; handle-status* : symbol integer [...] -> integer ;; handle-status* : symbol integer [...] -> integer
;; Returns the status code if no error occurred, otherwise ;; Returns the status code if no error occurred, otherwise
;; raises an exception with an appropriate message. ;; raises an exception with an appropriate message.
(define (handle-status* who full-s db [db-spec #f]) (define (handle-status* who full-s db db-spec pst)
(define s (simplify-status full-s)) (define s (simplify-status full-s))
(define db-file (and db-spec (car db-spec))) (define db-file (and db-spec (car db-spec)))
(define db-mode (and db-spec (cadr db-spec))) (define db-mode (and db-spec (cadr db-spec)))
(define sql (and pst (send pst get-stmt)))
(cond [(or (= s SQLITE_OK) (cond [(or (= s SQLITE_OK)
(= s SQLITE_ROW) (= s SQLITE_ROW)
(= s SQLITE_DONE)) (= s SQLITE_DONE))
@ -404,21 +409,27 @@
(sqlite3_errmsg db)] (sqlite3_errmsg db)]
[else (caddr info)])]) [else (caddr info)])])
(define extra (define extra
(cond [(memv s include-db-file-status-list) (string-append
(string-append ;; query, if available
(format "\n database: ~e" (or db-file 'unknown)) (cond [sql (format "\n SQL: ~e" sql)]
(format "\n mode: ~e" (or db-mode 'unknown)) [else ""])
(if (path-string? db-file) ;; db file and mode, if relevant and available
(format "\n file permissions: ~s" (cond [(memv s include-db-file-status-list)
(file-or-directory-permissions db-file)) (string-append
""))] (format "\n database: ~e" (or db-file 'unknown))
[else ""])) (format "\n mode: ~e" (or db-mode 'unknown))
(if (path-string? db-file)
(format "\n file permissions: ~s"
(file-or-directory-permissions db-file))
""))]
[else ""])))
(raise (make-exn:fail:sql (format "~a: ~a~a" who message extra) (raise (make-exn:fail:sql (format "~a: ~a~a" who message extra)
(current-continuation-marks) (current-continuation-marks)
sym sym
`((code . ,sym) `((code . ,sym)
(message . ,message) (message . ,message)
(errcode . ,s) (errcode . ,s)
(sql . ,sql)
(db-file . ,db-file) (db-file . ,db-file)
(db-mode . ,db-mode)))))])) (db-mode . ,db-mode)))))]))

2
racket/collects/db/private/sqlite3/main.rkt
View File

@ -35,7 +35,7 @@
((read/write) SQLITE_OPEN_READWRITE) ((read/write) SQLITE_OPEN_READWRITE)
((create) ((create)
(+ SQLITE_OPEN_READWRITE SQLITE_OPEN_CREATE))))]) (+ SQLITE_OPEN_READWRITE SQLITE_OPEN_CREATE))))])
(handle-status* 'sqlite3-connect open-status db (list path mode)) (handle-status* 'sqlite3-connect open-status db (list path mode) #f)
(let ([c (let ([c
(new connection% (new connection%
(db db) (db db)