Changeset 10382 in project


Ignore:
Timestamp:
04/07/08 23:35:46 (12 years ago)
Author:
Jim Ursetto
Message:

Add busy handler callbacks; ensure finalize! is called on exception.

Location:
release/3/sqlite3/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/3/sqlite3/trunk/doc.scm

    r9304 r10382  
    8585        (procedure "(sqlite3:set-busy-timeout! (db <sqlite3:database>) #!optional ((ms <exact>) 0)) => <void>"
    8686          (p "Installs a busy handler that waits at least the specified amount of milliseconds for locks on the given database. If " (tt "(<= ms 0)") " though, all busy handlers for the database are uninstalled."))
     87        (procedure "(sqlite3:set-busy-handler! (db <sqlite3:database>) (handler <procedure-class>)) => <void>"
     88          (p "Installs the supplied procedure as the library's busy handler, or removes it if " (tt "#f") ".  When the database is busy, SQLite will invoke this handler repeatedly until it returns " (tt "#f") ".  The handler will be called with arguments " (tt "db") " (database) and " (tt "count") " (number of times invoked for the same operation).")
     89          (p "As " (tt "handler") " will be called in a callback context from within the library, safety measures are installed to avoid throwing any exceptions or invoking continuations.  Attempts to do such things will result in " (tt "#f") " return values and warning messages.")
     90          (p "Notably, you may " (b "not") " use this procedure in the presence of multiple threads unless you can ensure no other thread will invoke a C to Scheme callback while this handler is executing.  In other words, callback entrance and exit must occur in order.  Use " (tt "set-safe-busy-handler!") " in this case.")
     91          (pre "Example:
     92(sqlite3:set-busy-handler! db
     93 (lambda (db count)
     94   (cond ((< count 5)
     95          (sleep 1)
     96          #t)
     97         (else #f)))))"))
     98        (procedure "(sqlite3:set-safe-busy-handler! (db <sqlite3:database>) (handler <procedure-class>)) => <void>"
     99          (p "Installs the supplied procedure as the application's busy handler, or removes it if " (tt "#f") ".  When the database returns a busy error code, the egg will invoke this handler repeatedly until it returns " (tt "#f") ".  The handler will be called with arguments " (tt "db") " (database), " (tt "count") " (number of times invoked for the same operation), and " (tt "last") " (the previous value the handler returned for this operation).")
     100          (p "As " (tt "handler") " is not called in a callback context, it is legal to invoke captured continuations, and it is safe in the presence of multiple threads.  In general, this handler should give up at some point to avoid possible deadlock.")
     101          (p "For an example handler, see the code of " (tt "default-safe-busy-handler") "."))
     102        (procedure "(sqlite3:default-safe-busy-handler (ms <exact>)) => <procedure-class>"
     103          (p "Returns a handler suitable for use with " (tt "set-safe-busy-handler!") ".  The behavior is identical to the default SQLite busy handler installed via " (tt "set-busy-timeout!") (& "mdash") "it polls in increasing intervals until the timeout in milliseconds is reached" (& "mdash") "but this version is non-blocking.")
     104          (pre "Example:
     105(define open-db
     106  (let ((handler (sqlite3:default-safe-busy-handler 2000)))
     107    (lambda (db-name)
     108      (let ((db (sqlite3:open db-name)))
     109        (sqlite3:set-safe-busy-handler! db handler)
     110        db))))"))
    87111
    88112        (procedure "(sqlite3:interrupt! (db <sqlite3:database>)) => <void>"
     
    260284
    261285    (history
     286      (version "2.0.8" "Add busy handler callbacks; ensure finalize! is called on exception. [Jim Ursetto]")
    262287      (version "2.0.7" "Restore error reporting. [Jim Ursetto]")
    263288      (version "2.0.6" "Add " (tt "enable-shared-cache!") ", requires 3.3.0 or later. [Jim Ursetto]")
  • release/3/sqlite3/trunk/sqlite3.html

    r9304 r10382  
    281281<dd>
    282282<p>Installs a busy handler that waits at least the specified amount of milliseconds for locks on the given database. If <tt>(&lt;= ms 0)</tt> though, all busy handlers for the database are uninstalled.</p></dd>
     283<dt class="definition"><strong>procedure:</strong> (sqlite3:set-busy-handler! (db &lt;sqlite3:database&gt;) (handler &lt;procedure-class&gt;)) =&gt; &lt;void&gt;</dt>
     284<dd>
     285<p>Installs the supplied procedure as the library's busy handler, or removes it if <tt>#f</tt>.  When the database is busy, SQLite will invoke this handler repeatedly until it returns <tt>#f</tt>.  The handler will be called with arguments <tt>db</tt> (database) and <tt>count</tt> (number of times invoked for the same operation).</p>
     286<p>As <tt>handler</tt> will be called in a callback context from within the library, safety measures are installed to avoid throwing any exceptions or invoking continuations.  Attempts to do such things will result in <tt>#f</tt> return values and warning messages.</p>
     287<p>Notably, you may <b>not</b> use this procedure in the presence of multiple threads unless you can ensure no other thread will invoke a C to Scheme callback while this handler is executing.  In other words, callback entrance and exit must occur in order.  Use <tt>set-safe-busy-handler!</tt> in this case.</p>
     288<pre>Example:
     289(sqlite3:set-busy-handler! db
     290 (lambda (db count)
     291   (cond ((&lt; count 5)
     292          (sleep 1)
     293          #t)
     294         (else #f)))))</pre></dd>
     295<dt class="definition"><strong>procedure:</strong> (sqlite3:set-safe-busy-handler! (db &lt;sqlite3:database&gt;) (handler &lt;procedure-class&gt;)) =&gt; &lt;void&gt;</dt>
     296<dd>
     297<p>Installs the supplied procedure as the application's busy handler, or removes it if <tt>#f</tt>.  When the database returns a busy error code, the egg will invoke this handler repeatedly until it returns <tt>#f</tt>.  The handler will be called with arguments <tt>db</tt> (database), <tt>count</tt> (number of times invoked for the same operation), and <tt>last</tt> (the previous value the handler returned for this operation).</p>
     298<p>As <tt>handler</tt> is not called in a callback context, it is legal to invoke captured continuations, and it is safe in the presence of multiple threads.  In general, this handler should give up at some point to avoid possible deadlock.</p>
     299<p>For an example handler, see the code of <tt>default-safe-busy-handler</tt>.</p></dd>
     300<dt class="definition"><strong>procedure:</strong> (sqlite3:default-safe-busy-handler (ms &lt;exact&gt;)) =&gt; &lt;procedure-class&gt;</dt>
     301<dd>
     302<p>Returns a handler suitable for use with <tt>set-safe-busy-handler!</tt>.  The behavior is identical to the default SQLite busy handler installed via <tt>set-busy-timeout!</tt>&mdash;it polls in increasing intervals until the timeout in milliseconds is reached&mdash;but this version is non-blocking.</p>
     303<pre>Example:
     304(define open-db
     305  (let ((handler (sqlite3:default-safe-busy-handler 2000)))
     306    (lambda (db-name)
     307      (let ((db (sqlite3:open db-name)))
     308        (sqlite3:set-safe-busy-handler! db handler)
     309        db))))</pre></dd>
    283310<dt class="definition"><strong>procedure:</strong> (sqlite3:interrupt! (db &lt;sqlite3:database&gt;)) =&gt; &lt;void&gt;</dt>
    284311<dd>
     
    455482<h3>Version</h3>
    456483<ul>
     484<li>2.0.8 Add busy handler callbacks; ensure finalize! is called on exception. [Jim Ursetto]</li>
    457485<li>2.0.7 Restore error reporting. [Jim Ursetto]</li>
    458486<li>2.0.6 Add <tt>enable-shared-cache!</tt>, requires 3.3.0 or later. [Jim Ursetto]</li>
  • release/3/sqlite3/trunk/sqlite3.scm

    r9958 r10382  
    1919    sqlite3:define-function
    2020    sqlite3:set-busy-timeout!
     21    sqlite3:set-busy-handler!
     22    sqlite3:set-safe-busy-handler!
     23    sqlite3:default-safe-busy-handler
    2124    sqlite3:interrupt!
    2225    sqlite3:auto-committing?
     
    6366    chicken_sqlite3_collation_stub
    6467    chicken_sqlite3_final_stub
    65     chicken_sqlite3_step_stub )
     68    chicken_sqlite3_step_stub
     69    chicken_sqlite3_busy_handler_stub )
    6670  (bound-to-procedure
    6771    ##sys#expand-home-path
     
    135139;;; Classes for databases and statements
    136140
    137 (define-class <sqlite3:database> (<c++-object>) ())
     141(define-class <sqlite3:database> (<c++-object>) (busy-handler))
    138142(define-foreign-type sqlite3:database
    139143  (instance "sqlite3" <sqlite3:database>)
     
    142146      (abort-sqlite3-null-error 'sqlite3:database->c-pointer db))
    143147    db))
     148(define-method (initialize (this <sqlite3:database>) initargs)
     149  (call-next-method)
     150  (initialize-slots this initargs) )
    144151
    145152(define-class <sqlite3:statement> (<c++-object>) (database sql))
     
    553560           => (abort-sqlite3-error 'sqlite3:open #f path) ]
    554561          [else
    555            (make <sqlite3:database> 'this db) ] ) ) )
     562           (make <sqlite3:database> 'this db 'busy-handler #f) ] ) ) )
    556563
    557564;; Set a timeout until a busy error is thrown
     565
     566(define *sqlite3:busy-handlers* (make-hash-table-tree/synch 'sqlite3:busy-handlers))
     567
    558568(define (sqlite3:set-busy-timeout! db #!optional (ms 0))
    559569  (check-sqlite3-type 'sqlite3:set-busy-timeout! db <sqlite3:database>)
    560570  (cond [((foreign-lambda sqlite3:status "sqlite3_busy_timeout" sqlite3:database int) db ms)
    561          => (abort-sqlite3-error 'sqlite3:set-busy-timeout! db db ms) ] ) )
     571         => (abort-sqlite3-error 'sqlite3:set-busy-timeout! db db ms) ]
     572        (else
     573          (call-with/synch *sqlite3:busy-handlers*   ; unregister scheme handler
     574            (lambda (busy)
     575              (hash-table-delete! busy
     576                                  (pointer->address (slot-ref db 'this))))))))
     577
     578(define-record busy-handler proc db)
     579(define-external (chicken_sqlite3_busy_handler_stub (c-pointer data) (int count)) int
     580  (let/cc return
     581    (let ((r #f))
     582      (dynamic-wind
     583          noop
     584          (lambda ()
     585            (handle-exceptions exn (print-error "in busy timeout handler" exn)
     586              (let* ((db-addr (pointer->address data))
     587                     (data (call-with/synch *sqlite3:busy-handlers*
     588                                            (lambda (busy) (hash-table-ref busy db-addr))))
     589                     (handler (busy-handler-proc data))
     590                     (db (busy-handler-db data)))
     591                (set! r (handler db count)))))
     592          (lambda ()
     593            (return (if r 1 0)))))))
     594
     595;; Set SQLite library busy handler callback.  This handler must not yield.
     596;; Callback is called with arguments DB and COUNT.
     597(define (sqlite3:set-busy-handler! db handler)
     598  (check-sqlite3-type 'sqlite3:set-busy-handler! db <sqlite3:database>)
     599  (let ((sqlite3_busy_handler
     600         (foreign-lambda sqlite3:status "sqlite3_busy_handler"
     601                         sqlite3:database c-pointer c-pointer))
     602        (db-ptr (slot-ref db 'this)))
     603    (cond ((not handler)
     604           (cond ((sqlite3_busy_handler db #f #f)
     605                  => (abort-sqlite3-error 'sqlite3:set-busy-handler! db db handler))
     606                 (else (call-with/synch *sqlite3:busy-handlers*
     607                         (lambda (busy)
     608                           (hash-table-delete! busy (pointer->address db-ptr))
     609                           (void))))))
     610          ((sqlite3_busy_handler db #$chicken_sqlite3_busy_handler_stub db-ptr)
     611           => (abort-sqlite3-error 'sqlite3:set-busy-handler! db db handler))
     612          (else
     613           (call-with/synch *sqlite3:busy-handlers*
     614                            (lambda (busy)
     615                              (hash-table-set! busy
     616                                               (pointer->address db-ptr)
     617                                               (make-busy-handler handler db))))))))
     618
     619;; Set application busy handler.  Does not use a callback, so it is safe
     620;; to yield.  Handler is called with DB, COUNT and LAST (the last value
     621;; it returned).  Return true value to continue trying, or #f to stop.
     622(define (sqlite3:set-safe-busy-handler! db handler)
     623  (check-sqlite3-type 'sqlite3:set-safe-busy-handler! db <sqlite3:database>)
     624  (slot-set! db 'busy-handler handler))
     625
     626;; Returns a closure suitable for use with set-safe-busy-handler!.  Identical
     627;; to sqlite's default busy handler (set-busy-timeout!), but does not block.
     628(define (sqlite3:default-safe-busy-handler timeout)
     629  (define (thread-sleep!/ms ms)
     630    (thread-sleep!
     631     (milliseconds->time (+ ms (time->milliseconds (current-time)))))) 
     632  (let* ((delays '#(1 2 5 10 15 20 25 25 25 50 50 100))
     633         (totals '#(0 1 3  8 18 33 53 78 103 128 178 228))
     634         (ndelay (vector-length delays)))
     635    (lambda (db count last)
     636      last   ; ignored
     637      (let* ((delay (vector-ref delays (min count (- ndelay 1))))
     638             (prior (if (< count ndelay)
     639                        (vector-ref totals count)
     640                        (+ (vector-ref totals (- ndelay 1))
     641                           (* delay (- count (- ndelay 1)))))))
     642        (let ((delay (if (> (+ prior delay) timeout)
     643                         (- timeout prior)
     644                         delay)))
     645          (cond ((<= delay 0) #f)
     646                (else
     647                 (thread-sleep!/ms delay)
     648                 #t)))))))
    562649
    563650;; Cancel any running database operation as soon as possible
     
    588675  (cond [(not (slot-ref db 'this))
    589676         (void) ]
    590         [((foreign-lambda sqlite3:status "sqlite3_close" sqlite3:database) db)
     677        [((foreign-safe-lambda sqlite3:status "sqlite3_close" sqlite3:database) db)
    591678         => (abort-sqlite3-error 'sqlite3:finalize! db db) ]
    592679        [else
     
    597684           (call-with/synch *sqlite3:functions*
    598685             (cute hash-table-tree-clear! <> id release-qns)) )
    599            (slot-set! db 'this #f) ] ) )
     686           (slot-set! db 'this #f)
     687           (slot-set! db 'busy-handler #f)] ) )
    600688
    601689;;; Statement interface
     
    605693  (check-sqlite3-type 'sqlite3:prepare db <sqlite3:database>)
    606694  (check-sqlite3-type 'sqlite3:prepare sql <string>)
    607   (let-location ([stmt c-pointer] [tail c-string])
    608     (cond [((foreign-lambda sqlite3:status "sqlite3_prepare"
    609                                             sqlite3:database scheme-pointer int
    610                                             (c-pointer sqlite3:statement)
    611                                             (c-pointer (const c-string)))
    612             db sql (string-length sql) #$stmt #$tail)
    613            => (abort-sqlite3-error 'sqlite3:prepare db db sql) ]
    614           [else
    615            (values
    616             (make <sqlite3:statement> 'this stmt 'database db 'sql sql)
    617             tail) ] ) ) )
     695  (let retry ((retries 0) (last-busy #f))
     696    (let-location ([stmt c-pointer] [tail c-string])
     697      (cond [((foreign-safe-lambda sqlite3:status "sqlite3_prepare"
     698                                   sqlite3:database scheme-pointer int
     699                                   (c-pointer sqlite3:statement)
     700                                   (c-pointer (const c-string)))
     701              db sql (string-length sql) #$stmt #$tail)
     702             => (lambda (err)
     703                  (case err
     704                    ((busy)
     705                     (let ((h (slot-ref db 'busy-handler)))
     706                       (cond ((and h (h db retries last-busy))
     707                              => (lambda (last-busy)
     708                                   (retry (+ retries 1) last-busy)))
     709                             (else
     710                              ((abort-sqlite3-error 'sqlite3:prepare db db sql) err)))))
     711                    (else
     712                     ((abort-sqlite3-error 'sqlite3:prepare db db sql) err))))]
     713            [else
     714             (values
     715              (make <sqlite3:statement> 'this stmt 'database db 'sql sql)
     716              tail) ] ) )) )
    618717
    619718;; Recompile an existing statement and transfer all bindings
     
    649748;; Reset an existing statement to process it again
    650749(define sqlite3_reset
    651   (foreign-lambda sqlite3:status "sqlite3_reset"sqlite3:statement))
     750  (foreign-lambda sqlite3:status "sqlite3_reset" sqlite3:statement))
    652751
    653752(define (sqlite3:reset! stmt)
     
    758857;; Single-step a prepared statement, return #t if data is available,
    759858;; #f otherwise
     859(define sqlite3_step
     860  (foreign-safe-lambda sqlite3:status "sqlite3_step" sqlite3:statement))
    760861(define (sqlite3:step! stmt)
    761862  (check-sqlite3-type 'sqlite3:step! stmt <sqlite3:statement>)
    762   (let retry ()
    763     (let ([s ((foreign-safe-lambda
    764                sqlite3:status "sqlite3_step" sqlite3:statement)
    765               stmt)])
     863  (let retry ((retries 0) (last-busy #f))
     864    (let ([s (sqlite3_step stmt)])
    766865      (case s
    767866        [(row)
     
    774873             [(schema)
    775874              (sqlite3:repair! stmt)
    776               (retry) ]
     875              (retry retries last-busy) ]
    777876             [else
    778877              ((abort-sqlite3-error 'sqlite3:step! (slot-ref stmt 'database) stmt) s) ] ) ) ]
     878        [(busy)
     879         (let* ((db (slot-ref stmt 'database))
     880                (h (slot-ref db 'busy-handler)))
     881           (cond ((and h (h db retries last-busy))
     882                  => (lambda (last-busy)
     883                       (retry (+ retries 1) last-busy)))
     884                 (else
     885                  ((abort-sqlite3-error 'sqlite3:step! db stmt) s))))]
    779886        [else
    780887         ((abort-sqlite3-error 'sqlite3:step! (slot-ref stmt 'database) stmt) s) ] ) ) ) )
     
    825932(define (sqlite3:call-with-temporary-statements proc db . sqls)
    826933  (check-sqlite3-type 'sqlite3:call-with-temporary-statements db <sqlite3:database>)
    827   (let ([stmts #f])
     934  (let ([stmts #f] [e #f])
    828935    (dynamic-wind
    829936        (lambda ()
     
    831938            (set! stmts (map (cute sqlite3:prepare db <>) sqls))))
    832939        (lambda ()
    833           (apply proc stmts))
     940          (handle-exceptions exn (begin
     941                                   (print-error "call-with-temporary-statements" exn)
     942                                   (set! e exn))
     943              (apply proc stmts)))
    834944        (lambda ()
    835945          (when stmts
    836946            (map sqlite3:finalize! stmts)
    837             (set! stmts #f)))) ) )
     947            (set! stmts #f))
     948          (and-let* ((ec e))
     949            (set! e #f)
     950            (signal ec))))))
    838951
    839952;; Step through a statement and ignore possible results
     
    9741087                          type)
    9751088      (make-property-condition 'type))) )
    976   (let ([success? #f])
     1089  (let ([success? #f] [e #f])
    9771090    (dynamic-wind
    9781091        (lambda ()
     
    9801093           (string-append "BEGIN " (symbol->string type) " TRANSACTION;")))
    9811094        (lambda ()
    982           (set! success? (thunk)))
     1095          (handle-exceptions exn (begin
     1096                                   (print-error "with-transaction" exn)
     1097                                   (set! e exn))
     1098            (set! success? (thunk))))
    9831099        (lambda ()
    9841100          (sqlite3:exec db
    985            (if success?
    986                "COMMIT TRANSACTION;"
    987                "ROLLBACK TRANSACTION;")))) ) )
     1101                        (if success?
     1102                            "COMMIT TRANSACTION;"
     1103                            "ROLLBACK TRANSACTION;"))
     1104          (and-let* ((exn e))
     1105            (set! e #f)
     1106            (signal exn))))))
    9881107
    9891108;; Check if the given string is a valid SQL statement
  • release/3/sqlite3/trunk/sqlite3.setup

    r9304 r10382  
    1212  `(,so-file
    1313    "sqlite3.html" "egg.jpg")
    14   '((version "2.0.7")
     14  '((version "2.0.8")
    1515    (documentation "sqlite3.html")))
Note: See TracChangeset for help on using the changeset viewer.