# $Id: s.MemStorage.xotcl 1.9 01/10/11 18:37:45+02:00 neumann@mohegan.wu-wien.ac.at $
package provide xotcl::store::mem 0.84
package require xotcl::store 0.84

Object xotcl::memStoragePool
xotcl::memStoragePool proc add {filename} {
  my set memStores($filename) [Object new -childof [self]]
}
xotcl::memStoragePool proc get {filename} {
  if {[my exists memStores($filename)]} {
    return [my set memStores($filename)]
  }
  return ""
}
xotcl::memStoragePool proc remove {filename} {
  catch {
    set store [my set memStores($filename)]
    $store destroy
    my unset memStores($filename)
  }
}

#
# a class using an XOTcl Object for memory storage
#the following line worked due to a bug in parameter before...
#Class Storage=Mem -parameter {{searchID ""}}
Class Storage=Mem -superclass Storage
Storage=Mem instproc init args {
  my instvar searchID
  ::set searchID ""
}
Storage=Mem instproc names  {}   {
  my instvar store
  $store array names v
}
Storage=Mem instproc exists name {
  my instvar store
  $store exists v($name)
}
Storage=Mem instproc unset name  {
  my instvar store
  $store unset v($name)
}
Storage=Mem instproc set args {
  my instvar store
  ::set l [llength $args]
  if {$l == 1} {
    $store set v([lindex $args 0])
  } elseif {$l == 2} {
    $store set v([lindex $args 0]) [lindex $args 1]
  } else {
    eval $store set $args
  }
}
Storage=Mem instproc close {} {
  my instvar store
  ::unset store
}
Storage=Mem instproc open filename {
  my instvar store
  if {[::set store [xotcl::memStoragePool get $filename]] == ""} {
    ::set store [xotcl::memStoragePool add $filename]
  }
}
Storage=Mem instproc firstkey {} {
  my instvar store
  $store instvar v
  my instvar searchID
  if {$searchID != ""} {
    array donesearch v $searchID
  }
  ::set searchID [array startsearch v]
  return [array nextelement v $searchID]
}
Storage=Mem instproc nextkey {} {
  my instvar store
  $store instvar v
  my instvar searchID
  if {$searchID == ""} {
    error "[self class]: firstkey was not invoked on storage search"
  }
  
  ::set elt [array nextelement v $searchID]
  if {$elt == ""} {
    # if array end is reach search is terminated automatically!!
    ::set searchID ""
  }
  return $elt
}

### warum geht eigentlich folgendes nicht:
##  Object o; o set a::b::c 1
### dann koennte man sich das set und exists schenken...
