# $Id: MemStorage.xotcl,v 1.2 2005/09/09 21:07:23 neumann Exp $

package provide xotcl::store::mem 0.84
package require xotcl::store 0.84
package require XOTcl

namespace eval ::xotcl::store::mem {
  namespace import ::xotcl::*

  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
  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...

  namespace export Storage=Mem
}

namespace import ::xotcl::store::mem::*
#namespace eval ::xotcl {namespace import ::xotcl::store::mem::*}