# $Id: TclGdbmStorage.xotcl,v 1.3 2005/09/09 21:09:01 neumann Exp $ package provide xotcl::store::tclgdbm 0.84 package require xotcl::store::gdbm package require xotcl::store package require XOTcl 1 namespace eval ::xotcl::store::tclgdbm { namespace import ::xotcl::* # # a simple GNU Gdbm DB Store Access based on TclGdbm # Class Storage=TclGdbm -superclass Storage Storage=TclGdbm instproc open f { my instvar persistenceDB ::set persistenceDB [gdbm_open -wrcreat $f] } Storage=TclGdbm instproc set args { my instvar persistenceDB ::set l [llength $args] if {$l == 1} {[::set persistenceDB] fetch [lindex $args 0] } elseif {$l == 2} {[::set persistenceDB] -replace store \ [lindex $args 0] [lindex $args 1] } else { next } } Storage=TclGdbm instproc exists k { my instvar persistenceDB $persistenceDB exists $k } Storage=TclGdbm instproc names {} { my instvar persistenceDB ::set list "" if {[::set key [$persistenceDB firstkey]] != ""} { lappend list $key while {[::set key [$persistenceDB nextkey $key]] != ""} { lappend list $key } } return $list } Storage=TclGdbm instproc close args { my instvar persistenceDB $persistenceDB close } Storage=TclGdbm instproc unset k { my instvar persistenceDB $persistenceDB delete $k } namespace export Storage=TclGdbm } namespace import ::xotcl::store::tclgdbm::*