# $Id$
package provide xotcl::store::mem 0.84
package require xotcl::store 0.84

Object xotcl::memStoragePool
xotcl::memStoragePool proc add {filename} {
  [self] set memStores($filename) [Object newChild]
}
xotcl::memStoragePool proc get {filename} {
  if {[[self] exists memStores($filename)]} {
    return [[self] set memStores($filename)]
  }
  return ""
}
xotcl::memStoragePool proc remove {filename} {
  catch {
    set store [[self] set memStores($filename)]
    $store destroy
    [self] 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
Storage=Mem instproc init args {
  ::set [self]::searchID ""
}
Storage=Mem instproc names  {}   {
  [::set [self]::store] array names v
}
Storage=Mem instproc exists name {
  [::set [self]::store] exists v($name)
}
Storage=Mem instproc unset name  {
  [::set [self]::store] unset v($name)
}
Storage=Mem instproc set args {
  ::set l [llength $args]
  if {$l == 1} {
    [::set [self]::store] set v([lindex $args 0])
  } elseif {$l == 2} {
    [::set [self]::store] set v([lindex $args 0]) [lindex $args 1]
  } else {
    eval [::set [self]::store] set $args
  }
}
Storage=Mem instproc close {} {
  ::unset [self]::store
}
Storage=Mem instproc open filename {
  if {[::set [self]::store [xotcl::memStoragePool get $filename]] == ""} {
    ::set [self]::store [xotcl::memStoragePool add $filename]
  }
}
Storage=Mem instproc firstkey {} {
  [::set [self]::store] instvar v
  [self] instvar searchID
  if {$searchID != ""} {
    array donesearch v $searchID
  }
  ::set searchID [array startsearch v]
  return [array nextelement v $searchID]
}
Storage=Mem instproc nextkey {} {
  [::set [self]::store] instvar v
  [self] 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...
