# $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::*
