package provide xotcl::store::textfile 1.0 package require -exact xotcl::store 1.0 package require XOTcl 1 namespace eval ::xotcl::store::textfile { namespace import ::xotcl::* Class Storage=TextFile -superclass Storage -parameter { filename reorgCounter reorgMaxValue } Storage=TextFile instproc init args { my instvar reorgCounter reorgMaxValue searchID ::set reorgCounter 0 ::set reorgMaxValue 1000 ::set searchID "" next } Storage=TextFile instproc reorganizeDB {} { my 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]" my set $k [lindex $c 1] } file delete -force $bak ::unset noreorg } } Storage=TextFile instproc open fn { my 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 foreach {k v} $c { lappend keyList $k } ::set f [::open $filename r] while {1} { set position [tell $f] if {!([gets $f line] >= 0)} { break } set k [lindex $keyList 0] if {[string match $k* $line]} { set lastLength [string length $line] set keys($k) [concat $position $lastLength] set lastKey $k set lastPosition $position set keyList [lreplace $keyList 0 0] } elseif {[info exists lastKey]} { set lastLength [expr $lastLength + [string length $line] + 1] set keys($lastKey) [concat $lastPosition $lastLength] } } ::close $f #parray keys } } Storage=TextFile instproc exists key { my instvar keys info exists keys($key) } Storage=TextFile instproc set args { my 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} { my reorganizeDB } } else { next } } Storage=TextFile instproc names {} { my array names keys } Storage=TextFile instproc close {} { my instvar filename keys my reorganizeDB ::unset filename ::unset keys } Storage=TextFile instproc unset key { my instvar keys if {[::info exists keys($key)]} { ::unset keys($key) } my reorganizeDB } Storage=TextFile instproc firstkey {} { my instvar keys searchID if {$searchID ne ""} { array donesearch keys $searchID } ::set searchID [array startsearch keys] return [array nextelement keys $searchID] } Storage=TextFile instproc nextkey {} { my instvar keys searchID if {$searchID eq ""} { error "[self class]: firstkey was not invoked on storage search" } ::set elt [array nextelement keys $searchID] if {$elt eq ""} { # if array end is reach search is terminated automatically!! ::set searchID "" } return $elt } namespace export Storage=TextFile } namespace import ::xotcl::store::textfile::*