[CMCc]: Purse provides simple-minded array persistence using variable traces and files.

======
 # purse makes tcl arrays purse-istant
 package provide Purse 0.1
  
 namespace eval ::purse {}
 
 # param - sets a purse's parameters
 # dir - directory in which purses are stored (default [pwd])
 proc ::purse::param {var val {control purse}} {
     variable $control
     upvar 0 $control cont
     
     if {![info exists cont]} {
         #::purse::purse $control $control
         set cont() [dict create dir [pwd]]
     }
     
     if {$var == "dir"} {
         file mkdir $val
     }
     dict set cont() $var $val
 }
 
 # purse - purses an array
 proc ::purse::purse {array {control purse}} {
     #puts stderr "purse $array $control"
     #set array [namespace which -variable $array]
     upvar $array arr
     variable $control
     upvar 0 $control cont
     
     if {![info exists cont]} {
         #::purse::purse $control $control
         set cont() [dict create]
     }
     
     if {![dict exists $cont() dir]} {
         param dir [pwd] $control
     }
     
     trace add variable arr read  [list ::purse::r $control $array]        ;# one shot load file
     trace add variable arr array [list ::purse::r $control $array]        ;# one shot load file
     trace add variable arr write [list ::purse::w $control $array]
     trace add variable arr unset [list ::purse::u $control $array]
     
     # register a single purse flush at exit
     set pfx ::exit_purse_[string map [list ":" ""] $control]_
     if { [info commands ${pfx}*] eq "" } {
         set newex ${pfx}[expr rand()]
         rename ::exit $newex
         proc ::exit {} [subst {
             #puts stderr "flush $control"
             ::purse::flush * $control
             $newex
         }]
     }
 }
 
 # initializes pursed array - one shot
 proc ::purse::r {control name array args} {
     upvar $array arr
     variable $control
     upvar 0 $control cont
     
     trace remove variable arr read  [list ::purse::r $control $name]        ;# one shot load file
     trace remove variable arr array [list ::purse::r $control $name]        ;# one shot load file
     trace remove variable arr write [list ::purse::w $control $name]
     trace remove variable arr unset [list ::purse::u $control $name]
     
     set file [file join [dict get $cont() dir] $name]
     
     if {[file exists $file]} {
         # if the purse exists, load its contents to array
         set fd [open $file r+]
         while {![eof $fd]} {
             array set arr [gets $fd]
         }
         close $fd
         
         set cont($name) [open $file w]
         fconfigure $cont($name) -buffering line
         puts $cont($name) [array get arr]
     } else {
         # brand new purse - create the file
         set cont($name) [open $file w]
         fconfigure $cont($name) -buffering line
     }
     
     # we no longer need a read trace
     trace add variable arr write [list ::purse::w $control $name]
     trace add variable arr unset [list ::purse::u $control $name]
 }
 
 # trace unset - writes an element to purse
 proc ::purse::w {control name array el op} {
     #puts stderr "write $control $name $array $el $op"
     upvar $array arr
     variable $control
     upvar 0 $control cont
     
     if {![info exists cont($name)]} {
         r $control $name arr
     }
     
     set fd $cont($name)
     array set junk [list $el $arr($el)]
     puts $fd [array get junk]
 }
 
 # trace unset - unsets an element in a pursed array
 proc ::purse::u {control name array el op} {
     #puts stderr "unset $control $name $array $el $op"
     upvar $array arr
     variable $control
     upvar 0 $control cont
     
     if {![info exists cont($name)]} {
         r $control $name arr
         if {$el != "" && [info exists arr($el)]} {
             unset arr($el)        ;# we have recreated the element - recurse
         }
         return
     }
     
     set file [file join [dict get $cont() dir] $name]
     if {$el == ""} {
         # removing the entire array - destroy the purse
         if {[file exists $file]} {
             file remove $file
         }
     } else {
         # removing an element - flush the purse
         close $cont($name)
         set cont($name) [open $file w]
         fconfigure $cont($name) -buffering line
         puts $cont($name) [array get arr]
     }
 }
 
 # flush arrays matching glob
 proc ::purse::flush {{glob *} {control purse}} {
     variable $control
     upvar 0 $control cont
     
     foreach {array fd} [array get cont $glob] {
         if {$array == ""} continue
         upvar #0 $array arr
         
         catch {close $cont($array)}
         
         set file [file join [dict get $cont() dir] $array]
         set cont($array) [open $file w]
         fconfigure $cont($array) -buffering line
         puts $cont($array) [array get arr]
     }
 }
 namespace export -clear purse
======

Now for some simple tests

======
 if {[info script] == $argv0} {
    purse::param dir [file join [pwd] .purse] ;# set the dir for purses
 
    purse::purse x        ;# purse the array x
    puts "initial: [array get x]"
    set x(1) [clock scan now]
    set x(2) [clock scan now]
    unset x(2)
    puts "subsequent: [array get x]"
     
    exit        ;# flushes the purse'd arrays
 }
======

Note that by the nature of the implementation, [[info exists]] will report 0 on every element of the array until the array is loaded.  We load lazily (although that would be easy to change) so it would make sense to perform an [[array size]] or similar to provoke loading, if you need to test existence on an element.

[EF] I modified slightly the original code so that:
   * It resists better to failures (abrupt end of the process) by forcing line buffering, which, in effect will write changes to disk as soon as they happen.
   * Removed the numerous exit functions, the previous code would create one exit function that would flush ALL pursed array for each purse array that would have been created. Instead, there is only one exit function that flushes all arrays for each known control purse, which is I believe was intended in the first place.
   * Changed the order of the flush procedure so that it better respect the rest of the API (i.e. the control purse is placed at the end).
   


<<categories>> Package