/usr/share/tcltk/xotcl1.6.7-store/TclGdbmStorage.xotcl is in xotcl 1.6.7-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | # $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
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::*
|