Index: xotcl/library/comm/PCache.xotcl
===================================================================
diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r435b41481fb51bf000ebe736d8574fefbeec1710
--- xotcl/library/comm/PCache.xotcl	(.../PCache.xotcl)	(revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8)
+++ xotcl/library/comm/PCache.xotcl	(.../PCache.xotcl)	(revision 435b41481fb51bf000ebe736d8574fefbeec1710)
@@ -1,4 +1,4 @@
-# -*- Tcl -*- $Id: PCache.xotcl,v 1.1 2004/05/23 22:50:39 neumann Exp $
+# -*- Tcl -*- $Id: PCache.xotcl,v 1.2 2005/09/09 21:07:23 neumann Exp $
 # Persistent Cache object, using gdbm
 
 # Configuration:
@@ -19,228 +19,241 @@
 package provide xotcl::comm::pcache 0.9
 #package require xotcl::package
 
-if {![info exists CACHE_DIR]} {
-  if {![info exists homeDir]} {
-    set homeDir /tmp
-  }
-  set CACHE_DIR $homeDir/cache2
-}
+package require XOTcl
 
-Object persistentCache
-persistentCache set dir $CACHE_DIR
-persistentCache proc flush { {cmd {}} } {
-  my instvar DBID
-  if {[info exists DBID]} { $DBID close }
-  if {[string compare {} $cmd]} {
-    if {[catch {eval $cmd} err]} {puts stderr err=$err}
-  }
-  my open  ;# UZ: wenn hier das self weggenommen wird, crashed das lintFilter
-  #open  ;# UZ: wenn hier das self weggenommen wird, crashed das lintFilter
+namespace eval ::xotcl::comm::pcache {
+    namespace import ::xotcl::*
 
-}
-# the open method for the first invocation
-persistentCache proc open {} {
-  my instvar dir DBID 
-  package require xotcl::store
-  set DBID [Storage someNewChildStore]
-  if {![file isdirectory $dir]} {
-    # if the cache directory does not exist, create it..
-    file mkdir $dir
-  }
-  # the open method for later invocations, doing the real work
-  my proc open {} {
-    my instvar dir DBID
-    $DBID open $dir/index
-  }
-  # invoke the method
-  open
-}
-persistentCache proc clear {} {
-  my instvar cacheFileName contentType meta entry validated dir
-  my flush [list eval file delete -force  $dir/index \
-		    [glob -nocomplain $dir/\[0-9\]*::*]]
-  foreach var {cacheFileName contentType meta entry validated} {
-    catch {unset $var}
-  }
-}
-persistentCache proc clearEntry {url} {
-  my instvar DBID cacheFileName contentType meta entry validated
-  my inCache $url
-  if {[info exists cacheFileName($url)]} {
-    my flush [list eval file delete -force $cacheFileName($url)]
-    foreach var {cacheFileName contentType meta entry validated} {
-      my showMsg "unset ${var}($url)"
-      catch {unset ${var}($url)}
+    variable CACHE_DIR
+    variable homeDir
+
+    if {![info exists CACHE_DIR]} {
+	if {![info exists homeDir]} {
+	    set homeDir /tmp
+	}
+	set CACHE_DIR $homeDir/cache2
     }
-    catch {$DBID unset $url}
-  }
-}
-persistentCache proc lazyFlush {} {
-  my instvar flushPending
-  if {[info exists flushPending]} { after cancel $flushPending }
-  set flushPending [after 100 [self] flush]
-}
-persistentCache proc newEntry {url access doCache name} {
-  my instvar cacheFileName contentType meta dir
-  if {$name != ""} {
-    #$access set caching 0
-    return $name
-  } elseif {$doCache} {
-    set cacheFileName($url) $dir/[pid]-$access
-    set contentType($url)   [$access set contentType]
-    set meta($url)          [$access set meta]
-    return $cacheFileName($url)
-  } else {
-    # we use the Memory cache only for non-persistent cache entries
-    # which are deleted when the program terminates
-    set fileName $dir/v[pid]-$access
-    MemoryCache + $url $fileName
-    return $fileName
-  }
-}
-persistentCache proc entryDone {url} {
-  my instvar entry cacheFileName contentType DBID meta
-  if {![info exists DBID]} { open }
-  $DBID set $url [list \
-		      cacheFileName $cacheFileName($url) \
-		      contentType   $contentType($url)   \
-		      meta          $meta($url)          ]
-  my lazyFlush
-  #my showMsg "size=[file size $cacheFileName($url)]"
-  set entry($url) 1
-  my set validated($url) 1
-}
-persistentCache proc inCache {url} {
-  my instvar entry
-  if {[info exists entry($url)]} {
-    set result 1
-  } else {
-    my instvar cacheFileName contentType meta DBID
-    if {![info exists DBID]} { open }
-    set result [$DBID set $url]
-    my lazyFlush
-    if {[string compare "" $result]} {
-      set entry($url) 1
-      array set r $result
-      set cacheFileName($url) $r(cacheFileName)
-      set contentType($url)   $r(contentType)
-      set meta($url)          $r(meta)
-      set result 1
-    } else {
-      set result 0
+
+    Object persistentCache
+    persistentCache set dir $CACHE_DIR
+    persistentCache proc flush { {cmd {}} } {
+	my instvar DBID
+	if {[info exists DBID]} { $DBID close }
+	if {[string compare {} $cmd]} {
+	    if {[catch {eval $cmd} err]} {puts stderr err=$err}
+	}
+	my open  ;# UZ: wenn hier das self weggenommen wird, crashed das lintFilter
+	#open  ;# UZ: wenn hier das self weggenommen wird, crashed das lintFilter
+
     }
-  }
-  return $result
-}
-persistentCache proc validated {url} {
-  my set validated($url) 1
-}
-persistentCache proc invalidate {url} {
-  if {[my exists validated($url)]} {
-    my unset validated($url)
-  }
-}
-persistentCache proc isValidated {url} {
-  if {[my exists validated($url)]} {
-    return 1
-  }
-  return 0
-}
-persistentCache proc ifModifiedHeader {url ifModVar} {
-  set result 0
-  if {[my inCache $url]} {
-    #puts stderr inCache:$url
-    upvar [self callinglevel] $ifModVar ifModifiedHeader
-    my instvar meta
-    array set m $meta($url)
-    if {[info exists m(last-modified)]} {
-      set ifModifiedHeader [list If-Modified-Since $m(last-modified)]
-      set result 1
+    # the open method for the first invocation
+    persistentCache proc open {} {
+	my instvar dir DBID 
+	package require xotcl::store
+	set DBID [Storage someNewChildStore]
+	if {![file isdirectory $dir]} {
+	    # if the cache directory does not exist, create it..
+	    file mkdir $dir
+	}
+	# the open method for later invocations, doing the real work
+	my proc open {} {
+	    my instvar dir DBID
+	    $DBID open $dir/index
+	}
+	# invoke the method
+	open
     }
-  } else {
-    #puts stderr "url=$url is not in cache"
-  }
-  return $result
-}
-persistentCache proc dump {} {
-  my instvar DBID
-  puts stderr DUMP:
-  foreach k [$DBID names] {
-    puts stderr $k
-    puts stderr "    [$DBID set $k]"
-  }
-}
-persistentCache proc cacheFileName {url} {
-  my instvar cacheFileName
-  return $cacheFileName($url)
-}
-persistentCache proc contentType {url} {
-  my instvar contentType
-  return $contentType($url)
-}
-persistentCache proc meta {url} {
-  my instvar meta
-  return $meta($url)
-}
-persistentCache proc destroy {} {
-  #my showCall
-  next
-}
-#persistentCache flush
+    persistentCache proc clear {} {
+	my instvar cacheFileName contentType meta entry validated dir
+	my flush [list eval file delete -force  $dir/index \
+		      [glob -nocomplain $dir/\[0-9\]*::*]]
+	foreach var {cacheFileName contentType meta entry validated} {
+	    catch {unset $var}
+	}
+    }
+    persistentCache proc clearEntry {url} {
+	my instvar DBID cacheFileName contentType meta entry validated
+	my inCache $url
+	if {[info exists cacheFileName($url)]} {
+	    my flush [list eval file delete -force $cacheFileName($url)]
+	    foreach var {cacheFileName contentType meta entry validated} {
+		my showMsg "unset ${var}($url)"
+		catch {unset ${var}($url)}
+	    }
+	    catch {$DBID unset $url}
+	}
+    }
+    persistentCache proc lazyFlush {} {
+	my instvar flushPending
+	if {[info exists flushPending]} { after cancel $flushPending }
+	set flushPending [after 100 [self] flush]
+    }
+    persistentCache proc newEntry {url access doCache name} {
+	my instvar cacheFileName contentType meta dir
+	if {$name != ""} {
+	    #$access set caching 0
+	    return $name
+	} elseif {$doCache} {
+	    set cacheFileName($url) $dir/[pid]-$access
+	    set contentType($url)   [$access set contentType]
+	    set meta($url)          [$access set meta]
+	    return $cacheFileName($url)
+	} else {
+	    # we use the Memory cache only for non-persistent cache entries
+	    # which are deleted when the program terminates
+	    set fileName $dir/v[pid]-$access
+	    MemoryCache + $url $fileName
+	    return $fileName
+	}
+    }
+    persistentCache proc entryDone {url} {
+	my instvar entry cacheFileName contentType DBID meta
+	if {![info exists DBID]} { open }
+	$DBID set $url [list \
+			    cacheFileName $cacheFileName($url) \
+			    contentType   $contentType($url)   \
+			    meta          $meta($url)          ]
+	my lazyFlush
+	#my showMsg "size=[file size $cacheFileName($url)]"
+	set entry($url) 1
+	my set validated($url) 1
+    }
+    persistentCache proc inCache {url} {
+	my instvar entry
+	if {[info exists entry($url)]} {
+	    set result 1
+	} else {
+	    my instvar cacheFileName contentType meta DBID
+	    if {![info exists DBID]} { open }
+	    set result [$DBID set $url]
+	    my lazyFlush
+	    if {[string compare "" $result]} {
+		set entry($url) 1
+		array set r $result
+		set cacheFileName($url) $r(cacheFileName)
+		set contentType($url)   $r(contentType)
+		set meta($url)          $r(meta)
+		set result 1
+	    } else {
+		set result 0
+	    }
+	}
+	return $result
+    }
+    persistentCache proc validated {url} {
+	my set validated($url) 1
+    }
+    persistentCache proc invalidate {url} {
+	if {[my exists validated($url)]} {
+	    my unset validated($url)
+	}
+    }
+    persistentCache proc isValidated {url} {
+	if {[my exists validated($url)]} {
+	    return 1
+	}
+	return 0
+    }
+    persistentCache proc ifModifiedHeader {url ifModVar} {
+	set result 0
+	if {[my inCache $url]} {
+	    #puts stderr inCache:$url
+	    upvar [self callinglevel] $ifModVar ifModifiedHeader
+	    my instvar meta
+	    array set m $meta($url)
+	    if {[info exists m(last-modified)]} {
+		set ifModifiedHeader [list If-Modified-Since $m(last-modified)]
+		set result 1
+	    }
+	} else {
+	    #puts stderr "url=$url is not in cache"
+	}
+	return $result
+    }
+    persistentCache proc dump {} {
+	my instvar DBID
+	puts stderr DUMP:
+	foreach k [$DBID names] {
+	    puts stderr $k
+	    puts stderr "    [$DBID set $k]"
+	}
+    }
+    persistentCache proc cacheFileName {url} {
+	my instvar cacheFileName
+	return $cacheFileName($url)
+    }
+    persistentCache proc contentType {url} {
+	my instvar contentType
+	return $contentType($url)
+    }
+    persistentCache proc meta {url} {
+	my instvar meta
+	return $meta($url)
+    }
+    persistentCache proc destroy {} {
+	#my showCall
+	next
+    }
+    #persistentCache flush
 
 
 
-########################################################### Cache
-Object MemoryCache
-MemoryCache proc query {url entry} {
-  my instvar cache
-  if {[info exists cache($url)]} {
-    upvar [self callinglevel] $entry e
-    #puts stderr "-->[self] [self proc] finds: $url"
-    set e $cache($url)
-    return 1
-  }
-  return 0
-}
-MemoryCache proc + {url entry} {
-  #puts stderr "-->[self class]:[self] [self proc] $url"
-  my set cache($url) $entry
-}
-MemoryCache proc - {url} {
-  #puts stderr "-->[self class]:[self] [self proc] $url"
-  catch {my unset cache($url)}
-}
-MemoryCache proc destroy {} {
-  my instvar cache
-  foreach url [array names cache] {
-    set f $cache($url)
-    if {[regexp ^/ $f]} {
-      #my showMsg "trying to remove $f [file exists $f]"
-      file delete -force $f
+    ########################################################### Cache
+    Object MemoryCache
+    MemoryCache proc query {url entry} {
+	my instvar cache
+	if {[info exists cache($url)]} {
+	    upvar [self callinglevel] $entry e
+	    #puts stderr "-->[self] [self proc] finds: $url"
+	    set e $cache($url)
+	    return 1
+	}
+	return 0
     }
-  }
-  next
-}
+    MemoryCache proc + {url entry} {
+	#puts stderr "-->[self class]:[self] [self proc] $url"
+	my set cache($url) $entry
+    }
+    MemoryCache proc - {url} {
+	#puts stderr "-->[self class]:[self] [self proc] $url"
+	catch {my unset cache($url)}
+    }
+    MemoryCache proc destroy {} {
+	my instvar cache
+	foreach url [array names cache] {
+	    set f $cache($url)
+	    if {[regexp ^/ $f]} {
+		#my showMsg "trying to remove $f [file exists $f]"
+		file delete -force $f
+	    }
+	}
+	next
+    }
 
 
-Object instproc allInstances {} {
-  # Diese Methode ermittelt rekursiv alle direkten und indirekten
-  # Instanzen einer Klasse
-  ::set inst [my info instances]
-  foreach s [my info subclass] {
-    foreach i [$s allInstances] { ::lappend inst $i }
-  }
-  return $inst
-}
+    Object instproc allInstances {} {
+	# Diese Methode ermittelt rekursiv alle direkten und indirekten
+	# Instanzen einer Klasse
+	::set inst [my info instances]
+	foreach s [my info subclass] {
+	    foreach i [$s allInstances] { ::lappend inst $i }
+	}
+	return $inst
+    }
 
-# onExit is automatically called when wafe terminates
-proc onExit {} {
-  #puts stderr "allinstances of Access: [Access allInstances]"
-  #foreach i [Access allInstances] {
-  #  if {[info command $i] == ""} continue
-  #  $i destroy
-  #}
-  #MemoryCache clear
-  persistentCache flush
-  #Trace statReport
+    # onExit is automatically called when wafe terminates
+    proc onExit {} {
+	#puts stderr "allinstances of Access: [Access allInstances]"
+	#foreach i [Access allInstances] {
+	#  if {[info command $i] == ""} continue
+	#  $i destroy
+	#}
+	#MemoryCache clear
+	persistentCache flush
+	#Trace statReport
+    }
+
+    namespace export persistentCache MemoryCache
 }
+
+namespace import ::xotcl::comm::pcache::*