! Copyright (C) 2010 Dmitry Shubin.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.data alien.destructors
-alien.enums classes.struct combinators destructors gdbm.ffi io.backend
-kernel libc locals math namespaces sequences serialize strings ;
+alien.enums alien.syntax classes.struct combinators destructors
+gdbm.ffi io.backend kernel libc locals math namespaces sequences
+serialize strings ;
IN: gdbm
+ENUM: gdbm-role reader writer wrcreat newdb ;
+
TUPLE: gdbm
{ name string }
{ block-size integer }
{ role initial: wrcreat }
{ sync boolean }
{ nolock boolean }
- { mode integer initial: OCT: 644 } ;
+ { mode integer initial: 0o644 } ;
: <gdbm> ( -- gdbm ) gdbm new ;
+ENUM: gdbm-error
+ gdbm-no-error
+ gdbm-malloc-error
+ gdbm-block-size-error
+ gdbm-file-open-error
+ gdbm-file-write-error
+ gdbm-file-seek-error
+ gdbm-file-read-error
+ gdbm-bad-magic-number
+ gdbm-empty-database
+ gdbm-cant-be-reader
+ gdbm-cant-be-writer
+ gdbm-reader-cant-delete
+ gdbm-reader-cant-store
+ gdbm-reader-cant-reorganize
+ gdbm-unknown-update
+ gdbm-item-not-found
+ gdbm-reorganize-failed
+ gdbm-cannot-replace
+ gdbm-illegal-data
+ gdbm-option-already-set
+ gdbm-illegal-option ;
+
<PRIVATE
-: gdbm-throw ( -- * ) gdbm_errno throw ;
+: gdbm-throw ( -- * ) gdbm_errno gdbm-error number>enum throw ;
: check-error ( ret -- ) 0 = [ gdbm-throw ] unless ;
: gdbm-store ( key content flag -- )
[
- { [ dbf ] [ object>datum ] [ object>datum ] [ ] } spread
+ [ dbf ] 3dip
+ [ object>datum ] [ object>datum ] [ ] tri*
gdbm_store check-error
] with-destructors ;
: gdbm-info ( -- str ) gdbm_version ;
-: gdbm-error-message ( error -- msg ) gdbm_strerror ;
+: gdbm-error-message ( error -- msg )
+ enum>number gdbm_strerror ;
: replace ( key content -- ) GDBM_REPLACE gdbm-store ;
: insert ( key content -- ) GDBM_INSERT gdbm-store ;
: first-key ( -- key/f ) first-key* drop ;
: next-key ( key -- key/f ) next-key* drop ;
+:: each-key ( ... quot: ( ... key -- ... ) -- ... )
+ first-key*
+ [ [ next-key* ] [ quot keep ] do while ] when drop ; inline
+
+: each-value ( ... quot: ( ... value -- ... ) -- ... )
+ [ fetch ] prepose each-key ; inline
+
+: each-record ( ... quot: ( ... key value -- ... ) -- ... )
+ [ dup fetch ] prepose each-key ; inline
+
: reorganize ( -- ) dbf gdbm_reorganize check-error ;
: synchronize ( -- ) dbf gdbm_sync ;
: with-gdbm ( gdbm quot -- )
[ gdbm-open &gdbm-close current-dbf set ] prepose curry
[ with-scope ] curry with-destructors ; inline
+
+:: with-gdbm-role ( name role quot -- )
+ <gdbm> name >>name role >>role quot with-gdbm ; inline
+
+: with-gdbm-reader ( name quot -- )
+ reader swap with-gdbm-role ; inline
+
+: with-gdbm-writer ( name quot -- )
+ writer swap with-gdbm-role ; inline
+