Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Initial binding of cursor operations |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
85c0637f632414077def5435101f191c |
| User & Date: | murphy 2018-08-20 16:35:43 |
Context
|
2018-08-20
| ||
| 18:09 | Set current-database-environment to #f when it is closed check-in: 9f4cd15298 user: murphy tags: trunk | |
| 16:35 | Initial binding of cursor operations check-in: 85c0637f63 user: murphy tags: trunk | |
| 13:53 | Database environment copy check-in: bf6e2af64e user: murphy tags: trunk | |
Changes
Changes to lmdb.scm.
1 2 3 4 5 6 7 8 9 ... 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 ... 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 ... 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 ... 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 ... 451 452 453 454 455 456 457 458 459 460 |
(module lmdb * #; (database-environment? current-database-environment open-database-environment close-database-environment copy-database-environment with-transaction database? open-database close-database drop-database ................................................................................ [#:no-sync "MDB_NOSYNC"] [#:map-async "MDB_MAPASYNC"] [#:no-lock "MDB_NOLOCK"] [#:no-read-ahead "MDB_NORDAHEAD"]) (define-values (no-tls no-subdirectory) (values (foreign-value "MDB_NOTLS" unsigned-int) (foreign-value "MDB_NOSUBDIR" unsigned-int))) (define (open-database-environment path . args) (let-keys+flags open-database-environment args ([#:mode mode #o666] [#:max-databases maxdbs #f] [#:max-readers maxreaders #f] [#:max-size mapsize #f]) ................................................................................ [#:reverse-duplicate "MDB_REVERSEDUP"] [#:create "MDB_CREATE"]) (define (open-database . args) (let-keys+flags open-database args ([0 name #f]) ([database-flags flags]) (let-location ([dbi database]) (check-error 'open-database ((foreign-lambda int "mdb_dbi_open" nonnull-transaction c-string unsigned-int (nonnull-c-pointer database)) (current-transaction) name flags (location dbi))) ................................................................................ [#:no-overwrite "MDB_NOOVERWRITE"] [#:append "MDB_APPEND"] [#:append/duplicate "MDB_APPENDDUP"]) (define-values (database-ref database-set!) (letrec ([database-ref (lambda (dbi key #!optional [default (cut check-error 'database-ref not-found)]) (let-location ([vlen size_t] [vptr c-pointer]) (let ([status ((foreign-lambda* int ([nonnull-transaction txn] [database dbi] [size_t klen] [scheme-pointer kptr] [(c-pointer size_t) vlen] [(c-pointer c-pointer) vptr]) "MDB_val key, val;" "key.mv_size = klen; key.mv_data = kptr;" "int status = mdb_get(txn, dbi, &key, &val);" "*vlen = val.mv_size; *vptr = val.mv_data;" "C_return(status);") (current-transaction) dbi (blob/string-size key) key (location vlen) (location vptr))]) (cond [(zero? status) ................................................................................ "key.mv_size = klen; key.mv_data = kptr;" "val.mv_size = vlen; val.mv_data = vptr;" "C_return(mdb_put(txn, dbi, &key, &val, flags));") (current-transaction) dbi (blob/string-size key) key (blob/string-size val) val flags))))]) (values (getter-with-setter database-ref database-set!) database-set!))) (define (database-exists? dbi key) (let ([status ((foreign-lambda* int ([nonnull-transaction txn] [database dbi] [size_t klen] [scheme-pointer kptr]) "MDB_val key, val;" ................................................................................ "key.mv_size = klen; key.mv_data = kptr;" "val.mv_size = vlen; val.mv_data = vptr;" "C_return(mdb_del(txn, dbi, &key, &val));") (current-transaction) dbi (blob/string-size key) key (blob/string-size val) val))) ) ;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;; |
< | | | | > > | > | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
1 2 3 4 5 6 7 8 ... 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 ... 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 ... 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 ... 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 ... 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 |
(module lmdb (database-environment? current-database-environment open-database-environment close-database-environment copy-database-environment with-transaction database? open-database close-database drop-database ................................................................................ [#:no-sync "MDB_NOSYNC"] [#:map-async "MDB_MAPASYNC"] [#:no-lock "MDB_NOLOCK"] [#:no-read-ahead "MDB_NORDAHEAD"]) (define-values (no-tls no-subdirectory) (values (foreign-value "MDB_NOTLS" unsigned-int) (foreign-value "MDB_NOSUBDIR" unsigned-int))) (define (open-database-environment path . args) (let-keys+flags open-database-environment args ([#:mode mode #o666] [#:max-databases maxdbs #f] [#:max-readers maxreaders #f] [#:max-size mapsize #f]) ................................................................................ [#:reverse-duplicate "MDB_REVERSEDUP"] [#:create "MDB_CREATE"]) (define (open-database . args) (let-keys+flags open-database args ([0 name #f]) ([database-flags flags]) (let-location ([dbi database (wrap-database 0)]) (check-error 'open-database ((foreign-lambda int "mdb_dbi_open" nonnull-transaction c-string unsigned-int (nonnull-c-pointer database)) (current-transaction) name flags (location dbi))) ................................................................................ [#:no-overwrite "MDB_NOOVERWRITE"] [#:append "MDB_APPEND"] [#:append/duplicate "MDB_APPENDDUP"]) (define-values (database-ref database-set!) (letrec ([database-ref (lambda (dbi key #!optional [default (cut check-error 'database-ref not-found)]) (let-location ([vlen size_t 0] [vptr c-pointer #f]) (let ([status ((foreign-lambda* int ([nonnull-transaction txn] [database dbi] [size_t klen] [scheme-pointer kptr] [(c-pointer size_t) vlen] [(c-pointer c-pointer) vptr]) "int status;" "MDB_val key, val;" "key.mv_size = klen; key.mv_data = kptr;" "val.mv_size = 0; val.mv_data = NULL;" "status = mdb_get(txn, dbi, &key, &val);" "*vlen = val.mv_size; *vptr = val.mv_data;" "C_return(status);") (current-transaction) dbi (blob/string-size key) key (location vlen) (location vptr))]) (cond [(zero? status) ................................................................................ "key.mv_size = klen; key.mv_data = kptr;" "val.mv_size = vlen; val.mv_data = vptr;" "C_return(mdb_put(txn, dbi, &key, &val, flags));") (current-transaction) dbi (blob/string-size key) key (blob/string-size val) val flags))))]) (values (getter-with-setter database-ref database-set!) database-set!))) (define (database-exists? dbi key) (let ([status ((foreign-lambda* int ([nonnull-transaction txn] [database dbi] [size_t klen] [scheme-pointer kptr]) "MDB_val key, val;" ................................................................................ "key.mv_size = klen; key.mv_data = kptr;" "val.mv_size = vlen; val.mv_data = vptr;" "C_return(mdb_del(txn, dbi, &key, &val));") (current-transaction) dbi (blob/string-size key) key (blob/string-size val) val))) ;; Cursors (define-foreign-tagged-type (cursor nonnull-cursor "MDB_cursor") cursor? tag:cursor) (define close-cursor (foreign-lambda void "mdb_cursor_close" nonnull-cursor)) (define-values (cursor-set-range cursor-first cursor-next) (values (foreign-value "MDB_SET_RANGE" int) (foreign-value "MDB_FIRST" int) (foreign-value "MDB_NEXT" int))) (define (database-fold proc seed dbi #!key from to< to<=) (let-location ([cursor cursor #f]) (check-error 'database-fold ((foreign-lambda int "mdb_cursor_open" nonnull-transaction database (c-pointer cursor)) (current-transaction) dbi (location cursor))) (let ([complete? #f]) (dynamic-wind (lambda () (when complete? (error 'database-fold "cannot re-enter cursor walk"))) (lambda () (let loop ([op (if from cursor-set-range cursor-first)] [key from] [seed seed]) (let-location ([klen size_t 0] [kptr c-pointer #f] [vlen size_t 0] [vptr c-pointer #f]) (let ([status ((foreign-lambda* int ([nonnull-cursor cursor] [int op] [size_t k0len] [scheme-pointer k0ptr] [size_t k1len] [scheme-pointer k1ptr] [int inclusive] [(c-pointer size_t) klen] [(c-pointer c-pointer) kptr] [(c-pointer size_t) vlen] [(c-pointer c-pointer) vptr]) "int status;" "MDB_val key0, key1, val;" "key0.mv_size = k0len; key0.mv_data = k0ptr;" "key1.mv_size = k1len; key1.mv_data = k1ptr;" "val.mv_size = 0; val.mv_data = NULL;" "status = mdb_cursor_get(cursor, &key0, &val, op);" "if (status == 0 && key1.mv_data != NULL) {" " if (mdb_cmp(mdb_cursor_txn(cursor), mdb_cursor_dbi(cursor), &key0, &key1) >= inclusive) status = MDB_NOTFOUND;" "}" "if (status == 0) {" " *klen = key0.mv_size; *kptr = key0.mv_data;" " *vlen = val.mv_size; *vptr = val.mv_data;" "}" "C_return(status);") cursor op (blob/string-size key) key (blob/string-size (or to< to<=)) (or to< to<=) (if to< 0 1) (location klen) (location kptr) (location vlen) (location vptr))]) (cond [(zero? status) (let ([key (make-string klen)] [val (make-string vlen)]) (move-memory! kptr key klen) (move-memory! vptr val vlen) (loop cursor-next key (proc key val seed)))] [(eqv? status not-found) seed] [else (check-error 'database-ref status)]))))) (lambda () ((foreign-lambda void "mdb_cursor_close" nonnull-cursor) cursor) (set! complete? #t)))))) (define (database-walk proc dbi . args) (apply database-fold (lambda (key val seed) (proc key val) seed) (void) dbi args)) ) ;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;; |