/usr/share/tcltk/xotcl1.6.7-store/Storage.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 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | # $Id: Storage.xotcl,v 1.3 2005/09/09 21:09:01 neumann Exp $
package provide xotcl::store 0.84
package require XOTcl
namespace eval ::xotcl::store {
namespace import ::xotcl::*
@ @File {
description {
Simple generic storage interface for hashtable-like (persistent)
storages. There are several different existing stores, including
a memory storage, a GDBM storage, a SDBM storage, and a
TextFile storage.
}
date { $Date: 2005/09/09 21:09:01 $ }
}
#
# abstract interface for storage access
#
@ Class Storage {
description {
Abstract storage interface class (superclass of all storages).
}
}
Class Storage -parameter {{dirName .} fileName}
###
@ Storage instproc open {
filename "database filename (or filename base, if more
than one file has to be created)"
} {
Description {
Each storage object represents exactly one database table. The db
has to be opened, before it can it used. If it is not opened all
other methods return errors.
}
return "empty string"
}
Storage abstract instproc open filename
###
@ Storage instproc close {} {
Description {
Close associated database.
}
return "empty string"
}
Storage abstract instproc close {}
###
@ Storage instproc exists {
key {Key to be searched for.}
} {
Description {
Search for a key whether it exists or not.
}
return {1, if key exists in the database, otherwise 0}
}
Storage abstract instproc exists key
###
@ Storage instproc set {
key {Key to be set.}
?value? {Optional value that might be set}
} {
Description {
Set or query a database key in the same way as Tcl's set functions.
}
return {Key value.}
}
Storage abstract instproc set {key ?value?}
###
@ Storage instproc unset {
key {Key to be unset.}
} {
Description {
Unset a database key in the same way as Tcl's unset functions.
}
return {empty string}
}
Storage abstract instproc unset key
###
@ Storage instproc names {} {
Description {
Return a list of keys in the database (functions in the same
way as Tcl's array names)
}
return {List of keys in the db.}
}
Storage abstract instproc names {}
###
@ Storage instproc firstkey {} {
Description {
Start a traversal of the database, starting with any key.
}
return {Name of first key.}
}
Storage abstract instproc firstkey {}
###
@ Storage instproc nextkey {} {
Description {
Proceed with the db traversal. Requires a firstkey before
first usage, otherwise it returns an error.
}
return {Name of next key, if one exists. Otherwise an empty string is returned.}
}
Storage abstract instproc nextkey {}
Storage instproc traceFilter args {
set context "[self callingclass]->[self callingproc]"
set method [self calledproc]
set dargs $args
puts "CALL $context> [self]->$method $dargs"
set result [next]
puts "EXIT $context> [self]->$method ($result)"
return $result
}
###
@ Storage proc someNewChildStore {} {
Description {
Create a childStore according to a preference list depending on
which storages are available. Currently the preference list has
the following order: Gdbm, Sdbm and TextFile.
}
return {name of the created storage object.}
}
Storage proc someNewChildStore {} {
foreach store {Gdbm Sdbm TextFile} {
if {![catch {package require xotcl::store::[string tolower $store]}]} {
set s [Storage=$store new -childof [self]]
break
}
}
return $s
}
Storage instproc checkDir {} {
my instvar dirName
if {[info exists dirName]} {
if {![file exists $dirName]} {
file mkdir $dirName
} elseif {![file isdirectory $dirName]} {
error "specified directory $dirName is no directory!"
}
}
}
Storage instproc mkFileName {} {
my instvar dirName fileName
if {[info exists dirName]} {
return [file join $dirName $fileName]
} else {
return $fileName
}
}
Storage instproc dbOpen {} {
my checkDir
my open [my mkFileName]
}
Storage proc defaultPackage {} {
return Sdbm
}
namespace export Storage
}
namespace import ::xotcl::store::*
|