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
}