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
|
package provide xotcl::store::textfile 0.84
package require xotcl::store
Class Storage=TextFile -superclass Storage -parameter {
filename
reorgCounter
reorgMaxValue
}
Storage=TextFile instproc init args {
[self] instvar reorgCounter reorgMaxValue searchID
::set reorgCounter 0
::set reorgMaxValue 1000
::set searchID ""
next
}
Storage=TextFile instproc reorganizeDB {} {
[self] instvar noreorg reorgCounter reorgMaxValue filename keys
::set reorgCounter -1
#puts "***reorganizeDB"
if {[::info exists filename]} {
::set noreorg 1
::array set bkeys [::array get keys]
::array set keys {}
# parray bkeys
::set bak $filename.orig
file rename -force $filename $bak
foreach k [::array names bkeys] {
::set bf [::open $bak r]
seek $bf [lindex $bkeys($k) 0]
::set c [read $bf [lindex $bkeys($k) 1]]
::close $bf
#puts "***STORING $k [lindex $c 1]"
[self] set $k [lindex $c 1]
}
file delete -force $bak
::unset noreorg
}
}
Storage=TextFile instproc open fn {
[self] instvar keys filename
::array set keys {}
::set position 0
::set filename $fn
if {[file exists $filename]} {
::set f [::open $filename r]
::set c [read $f]
::close $f
::set positions ""
foreach {k v} $c {
::incr position [string first $k [string range $c $position end]]
::set filepos $position
#puts "+++ '[string index $c [expr $filepos - 1]]' pos=$position"
while {[string index $c [expr {$filepos - 1}]] == "\{"} {
incr filepos -1
}
if {[::info exists keys($k)]} {
# no clean close
puts "Storage Open -- key duplicated in $filename: $k"
}
::set keys($k) $filepos
if {[info exists lastKey]} {
lappend keys($lastKey) [expr {$filepos - $keys($lastKey)}]
}
::set lastKey $k
::incr position 2
}
if {[info exists lastKey]} {
lappend keys($lastKey) [expr {[string length $c] - $filepos}]
}
}
# parray keys
}
Storage=TextFile instproc exists key {
[self] instvar keys
::info exists keys($key)
}
Storage=TextFile instproc set args {
[self] instvar keys noreorg reorgCounter reorgMaxValue filename
::set key [lindex $args 0]
::set l [llength $args]
if {$l == 1} { ;# fetch
if {[::info exists keys($key)]} {
::set f [::open $filename r]
#puts "***fetch -- $keys($key)"
seek $f [lindex $keys($key) 0]
::set c [read $f [lindex $keys($key) 1]]
::close $f
return [lindex $c 1]
} else {
error "no such variable '$key'"
}
} elseif {$l == 2} { ;# store
if {![::info exists noreorg] && [::info exists keys($key)]} {
::incr reorgCounter
}
::set f [::open $filename a+]
::set position [tell $f]
#puts "***store -- putting [::list $key [lindex $args 1]] at $position"
::set c [::list $key [lindex $args 1]]
puts $f $c
::close $f
::set keys($key) [::list $position [expr {[string length $c] + 1}]]
# parray keys
if {$reorgCounter > $reorgMaxValue} {
[self] reorganizeDB
}
} else { next }
}
Storage=TextFile instproc names {} {
::array names [self]::keys
}
Storage=TextFile instproc close {} {
[self] instvar filename keys
[self] reorganizeDB
::unset filename
::unset keys
}
Storage=TextFile instproc unset key {
[self] instvar keys
if {[::info exists keys($key)]} {
::unset keys($key)
}
[self] reorganizeDB
}
Storage=TextFile instproc firstkey {} {
[self] instvar keys searchID
if {$searchID != ""} {
array donesearch keys $searchID
}
::set searchID [array startsearch keys]
return [array nextelement keys $searchID]
}
Storage=TextFile instproc nextkey {} {
[self] instvar keys searchID
if {$searchID == ""} {
error "[self class]: firstkey was not invoked on storage search"
}
::set elt [array nextelement keys $searchID]
if {$elt == ""} {
# if array end is reach search is terminated automatically!!
::set searchID ""
}
return $elt
}
|
