diff options
Diffstat (limited to 'dbutil.scm')
| -rw-r--r-- | dbutil.scm | 26 |
1 files changed, 16 insertions, 10 deletions
@@ -113,11 +113,13 @@ (if (null? *base-table-implementations*) (require 'alist-table)) (cond ((and (not (and mutable? (not certificate))) (loop *base-table-implementations*))) - ((memq 'alist-table *base-table-implementations*) #f) - ((let () - (require 'alist-table) - (loop (list (car *base-table-implementations*))))) - (else #f))) + ((and (not (memq 'alist-table *base-table-implementations*)) + (let () + (require 'alist-table) + (loop (list (car *base-table-implementations*)))))) + (else + (and certificate (file-unlock! filename certificate)) + #f))) (define (mdbm:open-type filename type mutable?) (require type) @@ -126,7 +128,9 @@ (let* ((sys (cadr (assq type *base-table-implementations*))) (open (and sys (sys 'open-database))) (ndb (and open (open filename mutable?)))) - (and ndb (list ndb 1 type certificate)))))) + (cond (ndb (list ndb 1 type certificate)) + (else (and certificate (file-unlock! filename certificate)) + #f)))))) ;;@args filename base-table-type ;;@1 should be a string naming a file; or @code{#f}. @2 must be a @@ -302,14 +306,16 @@ (define certificate #f) (and entry (set! rdb (car entry))) (and (procedure? rdb) - (set! certificate (or (and entry (cadddr entry)) - (and (rdb 'filename) - (file-lock! (rdb 'filename)))))) + (set! certificate (and entry (cadddr entry)))) (cond ((and entry (not (eqv? 1 (cadr entry)))) (set-car! (cdr entry) (+ -1 (cadr entry))) #f) - ((or (not certificate) (not (procedure? rdb))) + ((not (procedure? rdb)) + (slib:warn 'close-database 'not 'procedure? rdb) #f) + ((not certificate) + (and dbs (set! dbs (mdbm:remove-entry dbs entry))) + #t) (else (let* ((filename (rdb 'filename)) (dbclose (rdb 'close-database)) |