summaryrefslogtreecommitdiffstats
path: root/tcllib/modules/tie
diff options
context:
space:
mode:
Diffstat (limited to 'tcllib/modules/tie')
-rw-r--r--tcllib/modules/tie/ChangeLog253
-rw-r--r--tcllib/modules/tie/pkgIndex.tcl9
-rw-r--r--tcllib/modules/tie/tie.man535
-rw-r--r--tcllib/modules/tie/tie.tcl511
-rw-r--r--tcllib/modules/tie/tie.test557
-rw-r--r--tcllib/modules/tie/tie_array.tcl124
-rw-r--r--tcllib/modules/tie/tie_array.test301
-rw-r--r--tcllib/modules/tie/tie_dsource.tcl54
-rw-r--r--tcllib/modules/tie/tie_file.tcl273
-rw-r--r--tcllib/modules/tie/tie_file.test392
-rw-r--r--tcllib/modules/tie/tie_growfile.tcl147
-rw-r--r--tcllib/modules/tie/tie_growfile.test345
-rw-r--r--tcllib/modules/tie/tie_log.tcl95
-rw-r--r--tcllib/modules/tie/tie_log.test240
-rw-r--r--tcllib/modules/tie/tie_rarray.tcl118
-rw-r--r--tcllib/modules/tie/tie_rarray.test331
-rw-r--r--tcllib/modules/tie/tie_rarray_comm.test218
-rw-r--r--tcllib/modules/tie/tie_std.man35
-rw-r--r--tcllib/modules/tie/tie_template.txt100
19 files changed, 4638 insertions, 0 deletions
diff --git a/tcllib/modules/tie/ChangeLog b/tcllib/modules/tie/ChangeLog
new file mode 100644
index 0000000..b2a2dd8
--- /dev/null
+++ b/tcllib/modules/tie/ChangeLog
@@ -0,0 +1,253 @@
+2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.15 ========================
+ *
+
+2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.14 ========================
+ *
+
+2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.13 ========================
+ *
+
+2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.12 ========================
+ *
+
+2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.11.1 ========================
+ *
+
+2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.11 ========================
+ *
+
+2008-05-16 Andreas Kupries <andreask@activestate.com>
+
+ * tie.man: Fixed the sectref argument order issues.
+
+2008-05-15 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie.man: Updated to changes in doctools (sub)section reference
+ handling.
+
+2008-03-16 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie_std.man: Added documentation for the internal packages of
+ this module, to clarify their nature as such.
+
+2008-02-27 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie_file.tcl (Replay): Fixed bug in the changes made in the last
+ * pkgIndex.tcl: commit. Tried to use a command (uplevel) removed
+ from the interp just a few lines above :( This fixes the SF
+ Tcllib bugs [1892687] and [1897850]. Version updated to
+ 1.0.4. Fixed a second bug, we inadvertently closed our main
+ channel after replaying the journal.
+
+2008-01-28 Andreas Kupries <andreask@activestate.com>
+
+ * tie_file.tcl (Replay): Accepted fix for [SF Tcllib Bug 1850838],
+ * pkgIndex.tcl: adding the missing use of the utf8 encoding.
+ Thanks to Richard Suchenwirth <suchenwi@users.sourceforge.net>
+ for report and fix. Version updated to 1.0.3.
+
+2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.10 ========================
+ *
+
+2007-08-01 Andreas Kupries <andreask@activestate.com>
+
+ * tie_rarray_comm.test: Updated to handle new 'snit' dependency in 'comm'.
+
+2007-05-01 Andreas Kupries <andreask@activestate.com>
+
+ * examples/tie/metakit.tcl (get): Updated to use {*} instead of
+ the deprecated {expand}. [Bug 1710639].
+
+2007-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie.man: Fixed all warnings due to use of now deprecated
+ commands. Added a section about how to give feedback.
+
+2006-10-11 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie_growfile.test: Marked the 8 permission dependent tests as
+ * tie_file.test: ... 'notRoot' as they cannot fail when the
+ superuser executes the testsuite.
+
+2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.9 ========================
+ *
+
+2006-09-19 Andreas Kupries <andreask@activestate.com>
+
+ * tie.man: Bumped version to 1.1
+ * tie.tcl:
+ * tie_file.tcl: Bumped version to 1.0.2
+ * pkgIndex.tcl:
+
+2006-09-19 Andreas Kupries <andreask@activestate.com>
+
+ * tie_file.tcl: Invokations of the builtin 'file' changed to
+ '::file' to ensure use of the builtin. In snit v2 this resolves
+ to the class itself apparently, choking the construction of an
+ instance. [Tcllib SF Bug 1560851].
+
+2006-03-07 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie_growfile.test: Created a new standard data source, the
+ * tie_growfile.tcl: ever-growing file, for never-shrinking
+ * pkgIndex.tcl: arrays. Updated package index, documentation,
+ * tie.man: extended the testsuite.
+ * tie.tcl:
+
+2006-01-28 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie_file.test: ...... Fixed creation and cleanup of temp. files
+ * tie_rarray_comm.test: by the testsuite.
+
+2006-01-26 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie.test: More boilerplate simplified via use of test support.
+ * tie_array.test:
+ * tie_file.test:
+ * tie_log.test:
+ * tie_rarray.test:
+ * tie_rarray_comm.test:
+
+2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie.test: Hooked into the new common test support code.
+ * tie_array.test:
+ * tie_file.test:
+ * tie_log.test:
+ * tie_rarray.test:
+ * tie_rarray_comm.test:
+
+2006-01-10 Andreas Kupries <andreask@activestate.com>
+
+ * tie_rarray_comm.test: Disabled the gratuitous puts commands
+ found in the tests. This unclutteres the output. This fixes the
+ [SF Tcllib Bug 1316063].
+
+ * tie_file.tcl (Compact): Accepted patch by Anton Osennikov
+ <wish2@users.sourceforge.net> for [SF Tcllib Patch
+ 1378556]. This fixes a bug in the configuration of the log file
+ after compaction, on Windows.
+
+2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.8 ========================
+ *
+
+2005-09-26 Andreas Kupries <andreask@activestate.com>
+
+ * tie_file.tcl: Fixed bug in cache invalidation. nothing to do
+ if the cache is already invalidated.
+
+2005-09-20 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie.test: Made results of tie-7.1 and -7.2 version-dependent,
+ using the proper tcltest commands from all.tcl.
+
+2005-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * ../examples/tie/metakit.tcl: Added an example backend for tieing
+ arrays to a metakit database.
+
+2005-03-02 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie.man (unsetv): Fixed a small documentation error. The
+ argument to unsetv is not optional. Thanks to Colin McCormack
+ <coldstore@users.sourceforge.net> for finding this.
+
+2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ *
+ * Released and tagged Tcllib 1.7 ========================
+ *
+
+2004-09-27 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie_file.tcl: Fixed problems with tests and implementation
+ * tie_file.test: on Windows.
+
+2004-09-23 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * pkgIndex.tcl: Fixed mismatch in the names of provided
+ vs. indexed packages, for the packages implementing the standard
+ types. Thanks to './sak.tcl validate'.
+
+ * tie_rarray_comm.test: Added code to abort tests when trying
+ * tie_rarray.test: to run them with a Tcl < 8.4.
+ * tie_array.test:
+ * tie_file.test:
+ * tie_log.test:
+ * tie.test:
+
+2004-09-22 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * tie_rarray_comm.test: Fixed test suite dependencies on
+ * tie_test: 'cmdline', ensuring source of local
+ implementation.
+
+2004-09-19 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * Bumped version to 1.0.
+
+ * tie_rarray.tcl: Fixed propagation of [unset] to use the option
+ -nocomplain. Required to avoid problems with circular ties.
+
+ * tie_rarray_comm.test: New tests for remote array involving true
+ remove communication, using [comm].
+
+ * tie_array.test: Updated to surely use the local revision of
+ * tie_file.test: snit when perfoming the tests.
+ * tie_log.test:
+ * tie_rarray.test:
+
+2004-09-16 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * pkgIndex.tcl: Updated, now version 0.9. Proxy renamed
+ * tie.man: to 'dsource'. Template renamed to .txt.
+ * tie.tcl: API frozen in simpler form, no -dsource,
+ * tie_array.tcl: only types. dsource functionality available
+ * tie_array.test: through the dsource/proxy type. Better
+ * tie_file.tcl: introspection. Untie api changed, always
+ * tie_file.test: taking a var-name. This allows tieing to
+ * tie_log.tcl: proc local variables. Full testsuite for
+ * tie_log.test: basic framework and all types.
+ * tie_dsource.tcl:
+ * tie_rarray.tcl:
+ * tie_rarray.test:
+ * tie_template.txt:
+
+2004-09-08 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * pkgIndex.tcl: Framework for tied array variables.
+ * tie.man: Documentation, standard data sources.
+ * tie.tcl:
+ * tie_array.tcl:
+ * tie_file.tcl:
+ * tie_log.tcl:
+ * tie_proxy.tcl:
+ * tie_rarray.tcl:
+ * tie_template.tcl:
diff --git a/tcllib/modules/tie/pkgIndex.tcl b/tcllib/modules/tie/pkgIndex.tcl
new file mode 100644
index 0000000..01fe6f1
--- /dev/null
+++ b/tcllib/modules/tie/pkgIndex.tcl
@@ -0,0 +1,9 @@
+if {![package vsatisfies [package provide Tcl] 8.4]} {return}
+package ifneeded tie 1.1 [list source [file join $dir tie.tcl]]
+package ifneeded tie::std::file 1.0.4 [list source [file join $dir tie_file.tcl]]
+package ifneeded tie::std::growfile 1.0 [list source [file join $dir tie_growfile.tcl]]
+package ifneeded tie::std::log 1.0 [list source [file join $dir tie_log.tcl]]
+package ifneeded tie::std::array 1.0 [list source [file join $dir tie_array.tcl]]
+package ifneeded tie::std::rarray 1.0.1 [list source [file join $dir tie_rarray.tcl]]
+package ifneeded tie::std::dsource 1.0 [list source [file join $dir tie_dsource.tcl]]
+
diff --git a/tcllib/modules/tie/tie.man b/tcllib/modules/tie/tie.man
new file mode 100644
index 0000000..f1458f9
--- /dev/null
+++ b/tcllib/modules/tie/tie.man
@@ -0,0 +1,535 @@
+[manpage_begin tie n 1.1]
+[keywords array]
+[keywords database]
+[keywords file]
+[keywords metakit]
+[keywords persistence]
+[keywords tie]
+[keywords untie]
+[copyright {2004-2008 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc {Tcl Data Structures}]
+[titledesc {Array persistence}]
+[category {Programming tools}]
+[require Tcl 8.4]
+[require tie [opt 1.1]]
+[description]
+
+The [package tie] package provides a framework for the creation of
+persistent Tcl array variables. It should be noted that the provided
+mechanism is generic enough to also allow its usage for the
+distribution of the contents of Tcl arrays over multiple threads and
+processes, i.e. communication.
+
+[para]
+
+This, persistence and communication, is accomplished by [term tying])
+a Tcl array variable to a [term {data source}]. Examples of data
+sources are other Tcl arrays and files.
+
+[para]
+
+It should be noted that a single Tcl array variable can be tied to
+more than one [term {data source}]. It is this feature which allows
+the framework to be used for communication as well. Just tie several
+Tcl arrays in many client processes to a Tcl array in a server and all
+changes to any of them will be distributed to all. Less centralized
+variants of this are of course possible as well.
+
+[section {USING TIES}]
+
+[subsection {TIE API}]
+
+This section describes the basic API used to establish and remove ties
+between Tcl array variables and data sources. This interface is the
+only one a casual user has to be concerned about. The following
+sections about the various internal interfaces can be safely skipped.
+
+[list_begin definitions]
+[call [cmd ::tie::tie] [arg arrayvarname] [arg options]... [arg dstype] [arg dsname]...]
+
+This command establishes a tie between the Tcl array whose name is
+provided by the argument [arg arrayvarname] and the
+
+[term {data source}] identified by the [arg dstype] and its series of
+[arg dsname] arguments. All changes made to the Tcl array after this
+command returns will be saved to the [term {data source}] for
+safekeeping (or distribution).
+
+[para]
+
+The result of the command is always a token which identifies the new
+tie. This token can be used later to destroy this specific tie.
+
+[list_begin arguments]
+[arg_def varname arrayvarname in]
+
+The name of the Tcl array variable to connect the new tie to.
+
+[arg_def name|command dstype in]
+
+This argument specifies the type of the [term {data source}] we wish
+to access.
+
+The [arg dstype] can be one of [const log], [const array],
+
+[const remotearray], [const file], [const growfile], or
+
+[const dsource]; in addition, the programmer can register additional
+data source types.
+
+Each [arg dstype] is followed by one or more arguments that identify
+the [term {data source}] to which the array is to be tied.
+
+[arg_def string dsname in]
+
+The series of [arg dsname] arguments coming after the [arg dstype]
+identifies the [term {data source}] we wish to connect to, and has to
+be appropriate for the chosen type.
+
+[list_end]
+[para]
+
+The command understands a number of additional options which guide the
+process of setting up the connection between Tcl array and
+[term {data source}].
+
+[para]
+
+[list_begin options]
+[opt_def -open]
+
+The Tcl array for the new tie is [term loaded] from the
+[term {data source}], and the previously existing contents of the Tcl
+array are erased. Care is taken to [emph not] erase the previous
+contents should the creation of the tie fail.
+
+[para]
+
+This option and the option [option -save] exclude each other. If
+neither this nor option [option -save] are specified then this option
+is assumed as default.
+
+[opt_def -save]
+
+The Tcl array for the new tie is [term saved] to the
+[term {data source}], and the previously existing contents of the
+[term {data source}] are erased.
+
+[para]
+
+This option and the option [option -open] exclude each other. If
+neither this nor option [option -open] are specified then option
+[option -open] is assumed as default.
+
+[opt_def -merge]
+
+Using this option prevents the erasure of any previously existing
+content and merges the data instead. It can be specified in
+conjunction with either [option -open] or [option -save]. They
+determine how data existing in both Tcl array and
+[term {data source}], i.e duplicates, are dealt with.
+
+[para]
+
+When used with [option -open] data in the [term {data source}] has
+precedence.
+
+In other words, for duplicates the data in the [term {data source}] is
+loaded into the Tcl array.
+
+[para]
+
+When used with [option -save] data in the Tcl array has precedence. In
+other words, for duplicates the data in the Tcl array is saved into
+the [term {data source}].
+
+[list_end]
+[para]
+
+[call [cmd ::tie::untie] [arg arrayvarname] [opt [arg token]]]
+
+This command dissolves one or more ties associated with the Tcl array
+named by [arg arrayvarname]. If no [arg token] is specified then all
+ties to that Tcl array are dissolved. Otherwise only the tie the token
+stands for is removed, if it is actually connected to the
+array. Trying to remove a specific tie not belonging to the provided
+array will cause an error.
+
+[para]
+
+It should be noted that while severing a tie will destroy management
+information internal to the package the [term {data source}] which was
+handled by the tie will not be touched, only closed.
+
+[para]
+
+After the command returns none of changes made to the array will be
+saved to the [term {data source}] anymore.
+
+[para]
+
+The result of the command is an empty string.
+
+[list_begin arguments]
+[arg_def varname arrayname in]
+
+The name of a Tcl array variable which may have ties.
+
+[arg_def handle token in]
+
+A handle representing a specific tie. This argument is optional.
+
+[list_end]
+[para]
+
+[call [cmd ::tie::info] [method ties] [arg arrayvarname]]
+
+This command returns a list of ties associated with the Tcl array
+variable named by [arg arrayvarname]. The result list will be empty if
+the variable has no ties associated with it.
+
+[call [cmd ::tie::info] [method types]]
+
+This command returns a dictionary of registered types, and the class
+commands they are associated with.
+
+[call [cmd ::tie::info] [method type] [arg dstype]]
+
+This command returns the fully resolved class command for a type
+name. This means that the command will follow a chain of type
+definitions ot its end.
+
+[list_end]
+
+[subsection {STANDARD DATA SOURCE TYPES}]
+
+This package provides the six following types as examples and standard
+data sources.
+
+[list_begin definitions]
+
+[def [const log]]
+
+This [term {data source}] does not maintain any actual data, nor
+persistence. It does not accept any identifying arguments. All changes
+are simply logged to [const stdout].
+
+[def [const array]]
+
+This [term {data source}] uses a regular Tcl array as the origin of
+the persistent data. It accepts a single identifying argument, the
+name of this Tcl array. All changes are mirrored to that array.
+
+[def [const remotearray]]
+
+This [term {data source}] is similar to [const array]. The difference
+is that the Tcl array to which we are mirroring is not directly
+accessible, but through a [cmd send]-like command.
+
+[para]
+
+It accepts three identifying arguments, the name of the other Tcl
+array, the command prefix for the [cmd send]-like accessor command,
+and an identifier for the remote entity hosting the array, in this
+order. All changes are mirrored to that array, via the command
+prefix. All commands will be executed in the context of the global
+namespace.
+
+[para]
+
+[cmd send]-like means that the command prefix has to have [cmd send]
+syntax and semantics. I.e. it is a channel over which we can send
+arbitrary commands to some other entity.
+
+The remote array [term {data source}] however uses only the commands
+[cmd set], [cmd unset], [cmd {array exists}], [cmd {array names}], [cmd {array set}], and
+[cmd {array get}] to retrieve and set values in the remote array.
+
+[para]
+
+The command prefix and the entity id are separate to allow the data
+source to use options like [option -async] when assembling the actual
+commands.
+
+[para]
+
+Examples of command prefixes, listed with the id of the remote entity,
+without options. In reality only the part before the id is the command
+prefix:
+
+[list_begin definitions]
+[def "[cmd send] [arg tkname]"]
+
+The Tcl array is in a remote interpreter and is accessed via Tk's X
+communication.
+
+[def "[cmd {comm::comm send}] [arg hostportid]"]
+
+The Tcl array is in a remote interpreter and is accessed through a
+socket.
+
+[def "[cmd {thread::send}] [arg threadid]"]
+
+The Tcl array is in a remote interpreter in a different thread of this
+process.
+
+[list_end]
+[para]
+
+[def [const file]]
+
+This [term {data source}] uses a single file as origin of the
+persistent data. It accepts a single identifying argument, the path to
+this file. The file has to be both readable and writable. It may not
+exist, the [term {data source}] will create it in that case. This (and
+only this) situation will require that the directory for the file
+exists and is writable as well.
+
+[para]
+
+All changes are saved in the file, as proper Tcl commands, one command
+per operation. In other words, the file will always contain a proper
+Tcl script.
+
+[para]
+
+If the file exists when the tie using it is set up, then it will be
+compacted, i.e. superfluous operations are removed, if the operations
+log stored in it contains either at least one operation clearing the
+whole array, or at least 1.5 times more operations than entries in the
+loaded array.
+
+[def [const growfile]]
+
+This [term {data source}] is like [const file] in terms of the storage
+medium for the array data, and how it is configured. In constrast to
+the former it however assumes and ensures that the tied array will
+never shrink. I.e. the creation of new array entries, and the
+modification of existing entries is allowed, but the deletion of
+entries is not, and causes the data source to throw errors.
+
+[para]
+
+This restriction allows us to simplify both file format and access to
+the file radically. For one, the file is read only once and the
+internal cache cannot be invalidated. Second, writing data is reduced
+to a simple append, and no compaction step is necessary. The format of
+the contents is the string representation of a dictionary which can be
+incrementally extended forever at the end.
+
+[def [const dsource]]
+
+This [term {data source}] uses an explicitly specified
+[term {data source object}] as the source for the persistent
+data. It accepts a single identifying argument, the command prefix,
+i.e. object command.
+
+[para]
+
+To use this type it is necessary to know how the framework manages
+ties and what [sectref dso {data source objects}] are.
+
+[para]
+
+All changes are delegated to the specified object.
+
+[list_end]
+
+[section {CREATING NEW DATA SOURCES}]
+
+This section is of no interest to the casual user of ties. Only
+developers wishing to create new data sources have to know the
+information provided herein.
+
+[subsection {DATA SOURCE OBJECTS} dso]
+
+All ties are represented internally by an in-memory object which
+mediates between the tie framework and the specific
+[term {data source}], like an array, file, etc.
+This is the [term {data source object}].
+
+[para]
+
+Its class, the [sectref dsc {data source class}] is [emph not] generic,
+but specific to the type of the [term {data source}]. Writing a new
+[term {data source}] requires us to write such a class, and then
+registering it with the framework as a new type.
+
+[para]
+
+The following subsections describe the various APIs a
+[sectref dsc {data source class}] and the objects it generates will have
+to follow to be compatible with the tie framework.
+
+[para]
+
+Data source objects are normally automatically created and destroyed
+by the framework when a tie is created, or removed. This management
+can be explicitly bypassed through the usage of the "dsource" type.
+
+The [term {data source}] for this type is a
+[term {data source object}] itself, and this object is outside of the
+scope of the tie framework and not managed by it.
+
+In other words, this type allows the creation of ties which talk to
+pre-existing [term {data source object}]s, and these objects will
+survive the removal of the ties using them as well.
+
+[subsection {REGISTERING A NEW DATA SOURCE CLASS}]
+
+After a [sectref dsc {data source class}] has been written it is necessary
+to register it as a new type with the framework.
+
+[list_begin definitions]
+[call [cmd ::tie::register] [arg dsclasscmd] [const as] [arg dstype]]
+
+Using this command causes the tie framework to remember the class
+command [arg dsclasscmd] of a [sectref dsc {data source class}] under the
+type name [arg dstype].
+
+[para]
+
+After the call the argument [arg dstype] of the basic user command
+[cmd ::tie::tie] will accept [arg dstype] as a type name and translate
+it internally to the appropriate class command for the creation of
+[sectref dso {data source objects}] for the new [term {data source}].
+
+[list_end]
+
+[subsection {DATA SOURCE CLASS} dsc]
+
+Each data source class is represented by a single command, also called
+the [term {class command}], or [term {object creation command}]. Its
+syntax is
+
+[list_begin definitions]
+
+[call [cmd {dsclasscmd}] [arg objname] [opt [arg dsname]...]]
+
+The first argument of the class command is the name of the
+[term {data source object}] to create.
+
+The framework itself will always supply the string [const %AUTO%], to
+signal that the class command has to generate not only the object, but
+the object name as well.
+
+[para]
+
+This is followed by a series of arguments identifying the data source
+the new object is for. These are the same [arg dsname] arguments which
+are given to the basic user command [cmd ::tie::tie]. Their actual
+meaning is dependent on the [term {data source class}].
+
+[para]
+
+The result of the class command has to be the fully-qualified name of
+the new [term {data source object}], i.e. the name of the
+[term {object command}].
+
+The interface this command has to follow is described in the section
+[sectref {DATA SOURCE OBJECT API}]
+
+[list_end]
+[para]
+
+[subsection {DATA SOURCE OBJECT API}]
+
+Please read the section [sectref dsc] first, to know
+how to generate new [term {object commands}].
+
+[para]
+
+Each [term {object command}] for a [term {data source}] object has to
+provide at least the methods listed below for proper inter-operation
+with the tie framework. Note that the names of most of the methods
+match the subcommands of the builtin [cmd array] command.
+
+[para]
+[list_begin definitions]
+[call [cmd ds] [method destroy]]
+
+This method is called when the object [cmd ds] is destroyed. It now
+has to release all its internal resources associated with the external
+data source.
+
+[call [cmd ds] [method names]]
+
+This command has to return a list containing the names of all keys
+found in the [term {data source}] the object talks to. This is
+equivalent to [cmd {array names}].
+
+[call [cmd ds] [method size]]
+
+This command has to return an integer number specifying the number of
+keys found in the [term {data source}] the object talks to. This is
+equivalent to [cmd {array size}].
+
+[call [cmd ds] [method get]]
+
+This command has to return a dictionary containing the data found in
+the [term {data source}] the object talks to. This is equivalent to
+[cmd {array get}].
+
+[call [cmd ds] [method set] [arg dict]]
+
+This command takes a dictionary and adds its contents to the data
+source the object talks to. This is equivalent to [cmd {array set}].
+
+[call [cmd ds] [method unset] [opt [arg pattern]]]
+
+This command takes a pattern and removes all elements whose keys
+matching it from the [term {data source}]. If no pattern is specified
+it defaults to [const *], causing the removal of all elements. This
+is nearly equivalent to [cmd {array unset}].
+
+[call [cmd ds] [method setv] [arg index] [arg value]]
+
+This command has to save the [arg value] in the [term {data source}]
+the object talks to, under the key [arg index].
+
+[para]
+
+The result of the command is ignored. If an error is thrown then this
+error will show up as error of the set operation which caused the
+method call.
+
+[call [cmd ds] [method unsetv] [arg index]]
+
+This command has to remove the value under the key [arg index] from
+the [term {data source}] the object talks to.
+
+[para]
+
+The result of the command is ignored. If an error is thrown then this
+error will show up as error of the unset operation which caused the
+method call.
+
+[call [cmd ds] [method getv] [arg index]]
+
+This command has to return the value for the key [arg index] in the
+[term {data source}] the object talks to.
+
+[list_end]
+
+And here a small table comparing the [term {data source}] methods to
+the regular Tcl commands for accessing an array.
+
+[para]
+[example {
+ Regular Tcl Data source
+ ----------- -----------
+ array names a ds names
+ array size a ds size
+ array get a ds get
+ array set a dict ds set dict
+ array unset a pattern ds unset ?pattern?
+ ----------- -----------
+ set a($idx) $val ds setv idx val
+ unset a($idx) ds unsetv idx
+ $a($idx) ds getv idx
+ ----------- -----------
+}]
+
+[vset CATEGORY tie]
+[include ../doctools2base/include/feedback.inc]
+[manpage_end]
diff --git a/tcllib/modules/tie/tie.tcl b/tcllib/modules/tie/tie.tcl
new file mode 100644
index 0000000..4aa3ec2
--- /dev/null
+++ b/tcllib/modules/tie/tie.tcl
@@ -0,0 +1,511 @@
+# tie.tcl --
+#
+# Tie arrays to persistence engines.
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tie.tcl,v 1.7 2006/09/19 23:36:18 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require snit
+package require cmdline
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+# ### ### ### ######### ######### #########
+## Public API
+
+namespace eval ::tie {}
+
+proc ::tie::tie {avar args} {
+ # Syntax : avar ?-open? ?-save? ?-merge? dstype dsargs...?
+
+ variable registry
+
+ upvar 1 $avar thearray
+
+ if {![array exists thearray]} {
+ return -code error "can't tie to \"$avar\": no such array variable"
+ }
+
+ # Create shortcuts for the options, and initialize them.
+ foreach k {open save merge} {upvar 0 opts($k) $k}
+ set open 0
+ set save 0
+ set merge 0
+
+ # Option processing ...
+
+ array set opts [GetOptions args]
+
+ # Basic validation ...
+
+ if {$open && $save} {
+ return -code error "-open and -save exclude each other"
+ } elseif {!$open && !$save} {
+ set open 1
+ }
+
+ if {![llength $args]} {
+ return -code error "dstype and type arguments missing"
+ }
+ set type [lindex $args 0]
+ set args [lrange $args 1 end]
+
+ # Create DS object from type (DS class) and args.
+ if {[::info exists registry($type)]} {
+ set type $registry($type)
+ }
+ set dso [eval [concat $type %AUTO% $args]]
+
+ Connect thearray $open $merge $dso
+ return [NewToken thearray $dso]
+}
+
+proc ::tie::untie {avar args} {
+ # Syntax : arrayvarname ?token?
+
+ variable mgr
+ variable tie
+
+ upvar 1 $avar thearray
+
+ switch -exact -- [llength $args] {
+ 0 {
+ # Remove all ties for the variable. Do nothing if there
+ # are no ties in place.
+
+ set mid [TraceManager thearray]
+ if {$mid eq ""} return
+ }
+ 1 {
+ # Remove a specific tie.
+
+ set tid [lindex $args 0]
+ if {![::info exists tie($tid)]} {
+ return -code error "Unknown tie \"$tid\""
+ }
+
+ foreach {mid dso} $tie($tid) break
+ set midvar [TraceManager thearray]
+
+ if {$mid ne $midvar} {
+ return -code error "Tie \"$tid\" not associated with variable \"$avar\""
+ }
+
+ set pos [lsearch -exact $mgr($mid) $tid]
+ set mgr($mid) [lreplace $mgr($mid) $pos $pos]
+
+ unset tie($tid)
+ $dso destroy
+
+ # Leave the manager in place if there still ties
+ # associated with the variable.
+ if {[llength $mgr($mid)]} return
+ }
+ default {
+ return -code error "wrong#args: array ?token?"
+ }
+ }
+
+ # Delegate full removal to common code.
+ Untie $mid thearray
+ return
+}
+
+proc ::tie::info {cmd args} {
+ variable mgr
+ if {$cmd eq "ties"} {
+ if {[llength $args] != 1} {
+ return -code error "wrong#args: should be \"tie::info ties avar\""
+ }
+ upvar 1 [lindex $args 0] thearray
+ set mid [TraceManager thearray]
+ if {$mid eq ""} {return {}}
+
+ return $mgr($mid)
+ } elseif {$cmd eq "types"} {
+ if {[llength $args] != 0} {
+ return -code error "wrong#args: should be \"tie::info types\""
+ }
+ variable registry
+ return [array get registry]
+ } elseif {$cmd eq "type"} {
+ if {[llength $args] != 1} {
+ return -code error "wrong#args: should be \"tie::info type dstype\""
+ }
+ variable registry
+ set type [lindex $args 0]
+ if {![::info exists registry($type)]} {
+ return -code error "Unknown type \"$type\""
+ }
+ return $registry($type)
+ } else {
+ return -code error "Unknown command \"$cmd\", should be ties, type, or types"
+ }
+}
+
+proc ::tie::register {dsclasscmd _as_ dstype} {
+ variable registry
+ if {$_as_ ne "as"} {
+ return -code error "wrong#args: should be \"tie::register command 'as' type\""
+ }
+
+ # Resolve a chain of type definitions right now.
+ while {[::info exists registry($dsclasscmd)]} {
+ set dsclasscmd $registry($dsclasscmd)
+ }
+
+ set registry($dstype) $dsclasscmd
+ return
+}
+
+# ### ### ### ######### ######### #########
+## Internal : Framework state
+
+namespace eval ::tie {
+ # Registry of short names and their associated class commands
+
+ variable registry
+ array set registry {}
+
+ # Management databases for the ties.
+ #
+ # mgr : mgr id -> list (tie id)
+ # tie : tie id -> (mgr id, dso cmd)
+ #
+ # array ==> mgr -1---n-> tie
+ # ^ |
+ # +-1-------n-+
+ #
+ # lock : mgr id x key -> 1/exists 0/!exists
+
+ # Database of managers for arrays.
+ # Also counter for the generation of mgr ids.
+
+ variable mgrcount 0
+ variable mgr ; array set mgr {}
+
+
+ # Database of ties (and their tokens).
+ # Also counter for the generation of tie ids.
+
+ variable tiecount 0
+ variable tie ; array set tie {}
+
+ # Database of locked arrays, keys, and data sources.
+
+ variable lock ; array set lock {}
+
+ # Key | Meaning
+ # --- + -------
+ # $mid,$idx | Propagation for index $idx is in progress.
+}
+
+# ### ### ### ######### ######### #########
+## Internal : Option processor
+
+proc ::tie::GetOptions {arglistVar} {
+ upvar 1 $arglistVar argv
+
+ set opts [lrange [::cmdline::GetOptionDefaults {
+ {open {}}
+ {save {}}
+ {merge {}}
+ } result] 2 end] ;# Remove ? and help.
+
+ set argc [llength $argv]
+ while {[set err [::cmdline::getopt argv $opts opt arg]]} {
+ if {$err < 0} {
+ set olist ""
+ foreach o [lsort $opts] {
+ if {[string match *.arg $o]} {
+ set o [string range $o 0 end-4]
+ }
+ lappend olist -$o
+ }
+ return -code error "bad option \"$opt\",\
+ should be one of\
+ [linsert [join $olist ", "] end-1 or]"
+ }
+ set result($opt) $arg
+ }
+ return [array get result]
+}
+
+# ### ### ### ######### ######### #########
+## Internal : Token generator
+
+proc ::tie::NewToken {avar dso} {
+ variable tiecount
+ variable tie
+ variable mgr
+
+ upvar 1 $avar thearray
+
+ set mid [NewTraceManager thearray]
+ set tid tie[incr tiecount]
+ set tie($tid) [list $mid $dso]
+ lappend mgr($mid) $tid
+ return $tid
+}
+
+# ### ### ### ######### ######### #########
+## Internal : Trace Management
+
+proc ::tie::TraceManager {avar} {
+ upvar 1 $avar thearray
+
+ set traces [trace info variable thearray]
+
+ foreach t $traces {
+ foreach {op cmd} $t break
+ if {
+ ([llength $cmd] == 2) &&
+ ([lindex $cmd 0] eq "::tie::Trace")
+ } {
+ # Our internal manager id is the first argument of the
+ # trace command we attached to the array.
+ return [lindex $cmd 1]
+ }
+ }
+ # No framework trace was found, there is no manager.
+ return {}
+}
+
+proc ::tie::NewTraceManager {avar} {
+ variable mgrcount
+ variable mgr
+
+ upvar 1 $avar thearray
+
+ set mid [TraceManager thearray]
+ if {$mid ne ""} {return $mid}
+
+ # No manager was found, we have to create a new one for the
+ # variable.
+
+ set mid [incr mgrcount]
+ set mgr($mid) [list]
+
+ trace add variable thearray \
+ {write unset} \
+ [list ::tie::Trace $mid]
+
+ return $mid
+}
+
+proc ::tie::Trace {mid avar idx op} {
+ #puts "[pid] Trace $mid $avar ($idx) $op"
+
+ variable mgr
+ variable tie
+ variable lock
+
+ upvar $avar thearray
+
+ if {($op eq "unset") && ($idx eq "")} {
+ # The variable as a whole is unset. This
+ # destroys all the ties placed on it.
+ # Note: The traces are already gone!
+
+ Untie $mid thearray
+ return
+ }
+
+ if {[::info exists lock($mid,$idx)]} {
+ #puts "%% locked $mid,$idx"
+ return
+ }
+ set lock($mid,$idx) .
+ #puts "%% lock $mid,$idx"
+
+ if {$op eq "unset"} {
+ foreach tid $mgr($mid) {
+ set dso [lindex $tie($tid) 1]
+ $dso unsetv $idx
+ }
+ } elseif {$op eq "write"} {
+ set value $thearray($idx)
+ foreach tid $mgr($mid) {
+ set dso [lindex $tie($tid) 1]
+ $dso setv $idx $value
+ }
+ } else {
+ #puts "%% unlock/1 $mid,$idx"
+ unset -nocomplain lock($mid,$idx)
+ return -code error "Bad trace call, unexpected operation \"$op\""
+ }
+
+ #puts "%% unlock/2 $mid,$idx"
+ unset -nocomplain lock($mid,$idx)
+ return
+}
+
+proc ::tie::Connect {avar open merge dso} {
+ upvar 1 $avar thearray
+
+ # Doing this as first operation is a convenient check that the ds
+ # object command exists.
+ set dsdata [$dso get]
+
+ if {$open} {
+ # Open DS and load data from it.
+
+ # Save current contents of array, for restoration in case of
+ # trouble.
+ set save [array get thearray]
+
+ if {$merge} {
+ # merge -> Remember the existing keys, so that we
+ # save their contents after loading the DS as well.
+ set wback [array names thearray]
+ } else {
+ # not merge -> Replace existing content.
+ array unset thearray *
+ }
+
+ if {[set code [catch {
+ array set thearray $dsdata
+ # ! Propagation through other ties.
+ } msg]]} {
+ # Errors found. Reset bogus contents, then reinsert the
+ # saved information to restore the previous state.
+ array unset thearray *
+ array set thearray $save
+
+ return -code $code \
+ -errorcode $::errorCode \
+ -errorinfo $::errorInfo $msg
+ }
+
+ if {$merge} {
+ # Now save everything we had before the tie was added into
+ # the DS. This may save data which came from the DS.
+ foreach idx $wback {
+ $dso setv $idx $thearray($idx)
+ }
+ }
+ } else {
+ # Save array data to DS.
+
+ # Save current contents of DS, for restoration in case of
+ # trouble.
+ # set save $dsdata
+
+ set source [array get thearray]
+
+ if {$merge} {
+ # merge -> Remember the existing keys, so that we
+ # read their contents after saving the array as well.
+ set rback [$dso names]
+ } else {
+ # not merge -> Replace existing content.
+ $dso unset
+ }
+
+ if {[set code [catch {
+ $dso set $source
+ } msg]]} {
+ $dso unset
+ $dso set $dsdata
+
+ return -code $code \
+ -errorcode $::errorCode \
+ -errorinfo $::errorInfo $msg
+ }
+
+ if {$merge} {
+ # Now read everything we had before the tie was added from
+ # the DS. This may read data which came from the array.
+ foreach idx $rback {
+ set thearray($idx) [$dso getv $idx]
+ # ! Propagation through other ties.
+ }
+ }
+ }
+ return
+}
+
+proc ::tie::Untie {mid avar} {
+ variable mgr
+ variable tie
+ variable lock
+
+ upvar 1 $avar thearray
+
+ trace remove variable thearray \
+ {write unset} \
+ [list ::tie::Trace $mid]
+
+ foreach tid $mgr($mid) {
+ foreach {mid dso} $tie($tid) break
+ # ASSERT: mid == mid
+
+ unset tie($tid)
+ $dso destroy
+ }
+
+ unset mgr($mid)
+ array unset lock ${mid},*
+ return
+}
+
+# ### ### ### ######### ######### #########
+## Test helper, peek into internals
+## Returns a serialized representation.
+
+proc ::tie::Peek {} {
+ variable mgr
+ variable tie
+
+ variable mgrcount
+ variable tiecount
+
+ list \
+ $mgrcount $tiecount \
+ mgr [Dictsort [array get mgr]] \
+ tie [Dictsort [array get tie]]
+}
+
+proc ::tie::Reset {} {
+ variable mgrcount 0
+ variable tiecount 0
+ return
+}
+
+proc ::tie::Dictsort {dict} {
+ array set a $dict
+ set out [list]
+ foreach key [lsort [array names a]] {
+ lappend out $key $a($key)
+ }
+ return $out
+}
+
+# ### ### ### ######### ######### #########
+## Standard DS classes
+# @mdgen NODEP: tie::std::log
+# @mdgen NODEP: tie::std::dsource
+# @mdgen NODEP: tie::std::array
+# @mdgen NODEP: tie::std::rarray
+# @mdgen NODEP: tie::std::file
+# @mdgen NODEP: tie::std::growfile
+
+::tie::register {package require tie::std::log ; ::tie::std::log} as log
+::tie::register {package require tie::std::dsource ; ::tie::std::dsource} as dsource
+::tie::register {package require tie::std::array ; ::tie::std::array} as array
+::tie::register {package require tie::std::rarray ; ::tie::std::rarray} as remotearray
+::tie::register {package require tie::std::file ; ::tie::std::file} as file
+::tie::register {package require tie::std::growfile ; ::tie::std::growfile} as growfile
+
+# ### ### ### ######### ######### #########
+## Ready to go
+
+package provide tie 1.1
diff --git a/tcllib/modules/tie/tie.test b/tcllib/modules/tie/tie.test
new file mode 100644
index 0000000..f289c92
--- /dev/null
+++ b/tcllib/modules/tie/tie.test
@@ -0,0 +1,557 @@
+# Tests for the tie module. -*- tcl -*-
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+# All rights reserved.
+#
+# RCS: @(#) $Id: tie.test,v 1.11 2006/10/09 21:41:42 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+ [file dirname [file dirname [file join [pwd] [info script]]]] \
+ devtools testutilities.tcl]
+
+testsNeedTcl 8.4
+testsNeedTcltest 1.0
+
+support {
+ use snit/snit.tcl snit
+ use cmdline/cmdline.tcl cmdline
+}
+testing {
+ useLocal tie.tcl tie
+ useLocal tie_dsource.tcl tie::std::dsource
+}
+
+# -------------------------------------------------------------------------
+
+proc group {dict} {
+ set res {}
+ foreach {k v} $dict {lappend res [list $k $v]}
+ return $res
+}
+
+proc ignore {dict args} {
+ array set tmp $dict
+ foreach k $args {unset tmp($k)}
+ array get tmp
+}
+
+# Fake data source, uses a fixed array, logs all invokations.
+proc note {item} {global res ; lappend res $item ; return}
+proc trackdb {dbvar args} {
+ upvar #0 $dbvar db
+ note [list $dbvar $args]
+ switch -exact -- [set m [lindex $args 0]] {
+ destroy {# nothing}
+ set {array set db [lindex $args 1]}
+ get {array get db}
+ unset {
+ set p [lindex $args 1]
+ if {$p eq ""} {set p *}
+ array unset db $p
+ }
+ names {array names db}
+ size {array size db}
+ setv {set db([lindex $args 1]) [lindex $args 2]}
+ getv {set db([lindex $args 1])}
+ unsetv {unset db([lindex $args 1])}
+ default {return -code error "Invoked unknown method \"$m\""}
+ }
+}
+proc initdb {dbvar dict} {upvar #0 $dbvar db ; unset -nocomplain db ; array set db $dict}
+
+interp alias {} track {} trackdb db
+interp alias {} trackb {} trackdb da
+interp alias {} trackav {} trackdb av
+
+interp alias {} init {} initdb db
+interp alias {} initb {} initdb da
+
+proc peek {resvar avar} {
+ upvar $resvar r $avar a
+ lappend r [dictsort [array get a]]
+ return
+}
+
+# -------------------------------------------------------------------------
+# Creation of ties.
+# Errors: Undefined variable, scalar, local variable
+
+test tie-1.0 {tie creation, undefined variable} {
+ unset -nocomplain av
+ catch {tie::tie av dsource track} msg
+ set msg
+} {can't tie to "av": no such array variable}
+
+test tie-1.1 {tie creation, variable defined, not an array} {
+ unset -nocomplain av ; set av SCALAR
+ catch {tie::tie av dsource track} msg
+ set msg
+} {can't tie to "av": no such array variable}
+
+test tie-1.2 {tie creation, variable defined, proc local} {
+ set res {}
+ proc foo {} {
+ unset -nocomplain av ; array set av {}
+ list [tie::tie av dsource track] [::tie::Peek] [trace info variable av]
+ # Token, has to have tie mgr structures, and the internal trace.
+ }
+ # And now the tie mgr structures have to be gone, with the local array.
+ lappend res [foo] [::tie::Peek]
+ rename foo {}
+ set res
+} {{db get} {tie1 {1 1 mgr {1 tie1} tie {tie1 {1 ::tie::dsource1}}} {{{write unset} {::tie::Trace 1}}}} {1 1 mgr {} tie {}}}
+
+test tie-1.3 {tie creation, bad option} {
+ unset -nocomplain av ; array set av {}
+ catch {tie::tie av -foo} msg
+ set msg
+} {bad option "foo", should be one of -merge, -open, or -save}
+
+test tie-1.4 {tie creation, open/save conflict} {
+ unset -nocomplain av ; array set av {}
+ catch {tie::tie av -open -save dsource foo} msg
+ set msg
+} {-open and -save exclude each other}
+
+test tie-1.5 {tie creation, dsource/type required} {
+ unset -nocomplain av ; array set av {}
+ catch {tie::tie av -open} msg
+ set msg
+} {dstype and type arguments missing}
+
+test tie-1.6 {tie creation, bad ds class command} {
+ unset -nocomplain av ; array set av {}
+ catch {tie::tie av foo bar} msg
+ set msg
+} {invalid command name "foo"}
+
+test tie-1.7 {tie creation, bad ds object command} {
+ unset -nocomplain av ; array set av {}
+ catch {tie::tie av dsource foo} msg
+ set msg
+} {invalid command name "foo"}
+
+# -------------------------------------------------------------------------
+# Creation, also testing untying in various ways
+
+test tie-2.0 {tie creation, destruction by untie, token} {
+ set res {}
+ unset -nocomplain av ; array set av {}
+ ::tie::Reset ; init {foo bar}
+
+ lappend res [set token [tie::tie av dsource track]]
+ lappend res [list [::tie::Peek] [trace info variable av]]
+
+ ::tie::untie av $token
+ lappend res [list [::tie::Peek] [trace info variable av]]
+ ::tie::Reset
+
+ join $res \n
+} {db get
+tie1
+{1 1 mgr {1 tie1} tie {tie1 {1 ::tie::dsource5}}} {{{write unset} {::tie::Trace 1}}}
+{1 1 mgr {} tie {}} {}}
+
+test tie-2.1 {tie creation, destruction by untie, all} {
+ set res {}
+ unset -nocomplain av ; array set av {}
+ ::tie::Reset ; init {foo bar}
+
+ lappend res [set token [tie::tie av dsource track]]
+ lappend res [list [::tie::Peek] [trace info variable av]]
+
+ ::tie::untie av
+ lappend res [list [::tie::Peek] [trace info variable av]]
+ ::tie::Reset
+
+ join $res \n
+} {db get
+tie1
+{1 1 mgr {1 tie1} tie {tie1 {1 ::tie::dsource7}}} {{{write unset} {::tie::Trace 1}}}
+{1 1 mgr {} tie {}} {}}
+
+test tie-2.2 {tie creation, destruction via unset} {
+ set res {}
+ unset -nocomplain av ; array set av {}
+ ::tie::Reset ; init {foo bar}
+
+ lappend res [set token [tie::tie av dsource track]]
+ lappend res [list [::tie::Peek] [trace info variable av]]
+
+ unset av
+ lappend res [list [::tie::Peek] [trace info variable av]]
+ ::tie::Reset
+
+ join $res \n
+} {db get
+tie1
+{1 1 mgr {1 tie1} tie {tie1 {1 ::tie::dsource9}}} {{{write unset} {::tie::Trace 1}}}
+{1 1 mgr {} tie {}} {}}
+
+# -------------------------------------------------------------------------
+# Go over the various connection modes.
+
+foreach {n mode merge avinit dbinit result} {
+ 1 -open {} {a 1 b 2} {b 4 c 3} {b 4 c 3}
+ 2 -open -merge {a 1 b 2} {b 4 c 3} {a 1 b 4 c 3}
+ 3 -save {} {a 1 b 2} {b 4 c 3} {a 1 b 2}
+ 4 -save -merge {a 1 b 2} {b 4 c 3} {a 1 b 2 c 3}
+} {
+ test tie-3.$n "tie creation modes: $mode $merge" {
+ set res {}
+ unset -nocomplain av ; array set av $avinit
+ ::tie::Reset ; init $dbinit
+
+ eval "tie::tie av $mode $merge dsource track"
+ tie::untie av
+
+ set res {}
+ lappend res [dictsort [array get av]] ; # Should be
+ lappend res [dictsort [array get db]] ; # identical
+
+ join $res \n
+ } [join [list $result $result] \n]
+}
+
+foreach {n mode merge avinit dbainit dbbinit result} {
+ 5 -open {} {a 1 b 2} {b 4 c 3} {d 5} {d 5}
+ 6 -open -merge {a 1 b 2} {b 4 c 3} {d 5} {a 1 b 4 c 3 d 5}
+ 7 -save {} {a 1 b 2} {b 4 c 3} {d 5} {a 1 b 2}
+ 8 -save -merge {a 1 b 2} {b 4 c 3} {d 5} {a 1 b 2 c 3 d 5}
+} {
+ test tie-3.$n "tie creation modes: $mode $merge, multi tie" {
+ set res {}
+ unset -nocomplain av ; array set av $avinit
+ ::tie::Reset ; init $dbainit
+ initb $dbbinit
+
+ eval "tie::tie av $mode $merge dsource track"
+ eval "tie::tie av $mode $merge dsource trackb"
+ tie::untie av
+
+ set res {}
+ lappend res [dictsort [array get av]] ; # Should be
+ lappend res [dictsort [array get db]] ; # identical
+ lappend res [dictsort [array get da]] ; #
+
+ join $res \n
+ } [join [list $result $result $result] \n]
+}
+
+# -------------------------------------------------------------------------
+# Test data propagation
+
+test tie-4.1 {array operations properly stored} {
+ set res {}
+ unset -nocomplain av ; array set av {}
+ ::tie::Reset ; init {a 1 b 2 c 3}
+
+ tie::tie av dsource track
+
+ set r {} ; peek r db
+ set av(a) 4 ; peek r db
+ set av(ax) foo ; peek r db
+ array unset av a* ; peek r db
+ array set av {b 5 d 6} ; peek r db
+
+ tie::untie av
+ join $r \n
+} {a 1 b 2 c 3
+a 4 b 2 c 3
+a 4 ax foo b 2 c 3
+b 2 c 3
+b 5 c 3 d 6}
+
+test tie-4.2 {array operations properly stored, multi-tie} {
+ set res {}
+ unset -nocomplain av ; array set av {}
+ ::tie::Reset ; init {}
+ initb {a 1 b 2 c 3}
+
+ tie::tie av dsource track
+ tie::tie av dsource trackb
+
+ set r {} ; peek r db ; peek r da
+ set av(a) 4 ; peek r db ; peek r da
+ set av(ax) foo ; peek r db ; peek r da
+ array unset av a* ; peek r db ; peek r da
+ array set av {b 5 d 6} ; peek r db ; peek r da
+
+ tie::untie av
+ join $r \n
+} {a 1 b 2 c 3
+a 1 b 2 c 3
+a 4 b 2 c 3
+a 4 b 2 c 3
+a 4 ax foo b 2 c 3
+a 4 ax foo b 2 c 3
+b 2 c 3
+b 2 c 3
+b 5 c 3 d 6
+b 5 c 3 d 6}
+
+# -------------------------------------------------------------------------
+# And circular connectivity (several ds's refering to each other).
+
+foreach {n mode merge avinit dbinit result} {
+ 1 -open {} {a 1 b 2} {b 4 c 3} {b 4 c 3}
+ 2 -open -merge {a 1 b 2} {b 4 c 3} {a 1 b 4 c 3}
+ 3 -save {} {a 1 b 2} {b 4 c 3} {a 1 b 2}
+ 4 -save -merge {a 1 b 2} {b 4 c 3} {a 1 b 2 c 3}
+ 5 -open {} {} {} {}
+ 6 -open {} {a 1} {} {}
+ 7 -open {} {} {a 1} {a 1}
+ 8 -open {} {b 2} {a 1} {a 1}
+ 9 -open -merge {} {} {}
+ 10 -open -merge {a 1} {} {a 1}
+ 11 -open -merge {} {a 1} {a 1}
+ 12 -open -merge {b 2} {a 1} {a 1 b 2}
+ 13 -save {} {} {} {}
+ 14 -save {} {a 1} {} {a 1}
+ 15 -save {} {} {a 1} {}
+ 16 -save {} {b 2} {a 1} {b 2}
+ 17 -save -merge {} {} {}
+ 18 -save -merge {a 1} {} {a 1}
+ 19 -save -merge {} {a 1} {a 1}
+ 20 -save -merge {b 2} {a 1} {a 1 b 2}
+} {
+ test tie-5.$n "circular tie, initialization $mode $merge" {
+ set res {}
+ unset -nocomplain av ; array set av $avinit
+ ::tie::Reset ; init $dbinit
+
+ eval "tie::tie av $mode $merge dsource track"
+ eval "tie::tie db $mode $merge dsource trackav"
+ tie::untie av
+ tie::untie db
+
+ set res {}
+ lappend res [dictsort [array get av]]
+ lappend res [dictsort [array get db]]
+
+ join $res \n
+ } [join [list $result $result] \n] ; # {}
+}
+
+test tie-6.1 {array operations properly stored, circular} {
+ set res {}
+ unset -nocomplain av ; array set av {}
+ ::tie::Reset ; init {a 1 b 2 c 3}
+
+ tie::tie av dsource track
+ tie::tie db dsource trackav
+
+ set r {} ; peek r db ; peek r av
+ set av(a) 4 ; peek r db ; peek r av
+ set av(ax) foo ; peek r db ; peek r av
+ array unset av a* ; peek r db ; peek r av
+ array set av {b 5 d 6} ; peek r db ; peek r av
+
+ tie::untie av
+ join $r \n
+} {a 1 b 2 c 3
+a 1 b 2 c 3
+a 4 b 2 c 3
+a 4 b 2 c 3
+a 4 ax foo b 2 c 3
+a 4 ax foo b 2 c 3
+b 2 c 3
+b 2 c 3
+b 5 c 3 d 6
+b 5 c 3 d 6}
+
+test tie-6.2 {array operations properly stored, circular} {
+ set res {}
+ unset -nocomplain av ; array set av {}
+ ::tie::Reset ; init {a 1 b 2 c 3}
+
+ tie::tie av dsource track
+ tie::tie db dsource trackav
+
+ set r {} ; peek r db ; peek r av
+ set db(a) 4 ; peek r db ; peek r av
+ set db(ax) foo ; peek r db ; peek r av
+ array unset db a* ; peek r db ; peek r av
+ array set db {b 5 d 6} ; peek r db ; peek r av
+
+ tie::untie av
+ join $r \n
+} {a 1 b 2 c 3
+a 1 b 2 c 3
+a 4 b 2 c 3
+a 4 b 2 c 3
+a 4 ax foo b 2 c 3
+a 4 ax foo b 2 c 3
+b 2 c 3
+b 2 c 3
+b 5 c 3 d 6
+b 5 c 3 d 6}
+
+# -------------------------------------------------------------------------
+# Untie error checking
+
+test tie-7.1 {untie, wrong#args} {
+ catch {tie::untie} msg
+ set msg
+} [tcltest::tooManyArgs tie::untie {avar args}]
+
+test tie-7.2 {untie, wrong#args} {
+ catch {tie::untie a b c} msg
+ set msg
+} {wrong#args: array ?token?}
+
+test tie-7.3 {untie, bad token} {
+ catch {tie::untie av a} msg
+ set msg
+} {Unknown tie "a"}
+
+test tie-7.4 {untie, bad token, for other array} {
+ ::tie::Reset
+ array set av {}
+ array set db {}
+
+ set ta [tie::tie av dsource track]
+ set tb [tie::tie db dsource trackb]
+
+ catch {tie::untie av $tb} msg
+ unset av db
+ set msg
+} {Tie "tie2" not associated with variable "av"}
+
+# -------------------------------------------------------------------------
+# Introspection
+
+test tie-8.0 {tie::info, wrong#args, not enough} {
+ catch {tie::info} msg
+ set msg
+} [tcltest::wrongNumArgs tie::info {cmd args} 0]
+
+test tie-8.1 {tie::info ties, wrong#args, not enough} {
+ catch {tie::info ties} msg
+ set msg
+} {wrong#args: should be "tie::info ties avar"}
+
+test tie-8.2 {tie::info, bad command} {
+ catch {tie::info foo bar} msg
+ set msg
+} {Unknown command "foo", should be ties, type, or types}
+
+test tie-8.3 {tie::info ties, wrong#args to many} {
+ catch {tie::info ties bar ex} msg
+ set msg
+} {wrong#args: should be "tie::info ties avar"}
+
+test tie-8.4 {tie::info ties, no ties} {
+ array set av {}
+ set res [tie::info ties av]
+ unset av
+ set res
+} {}
+
+test tie-8.5 {tie::info ties, one tie} {
+ ::tie::Reset
+ array set av {}
+ tie::tie av dsource track
+
+ set res [tie::info ties av]
+ unset av
+ set res
+} {tie1}
+
+test tie-8.6 {tie::info, multiple ties} {
+ ::tie::Reset
+ array set av {}
+ tie::tie av dsource track
+ tie::tie av dsource trackb
+
+ set res [tie::info ties av]
+ unset av
+ set res
+} {tie1 tie2}
+
+test tie-8.7 {tie::info types, standard} {
+ join [group [dictsort [tie::info types]]] \n
+} {array {package require tie::std::array ; ::tie::std::array}
+dsource ::tie::std::dsource
+file {package require tie::std::file ; ::tie::std::file}
+growfile {package require tie::std::growfile ; ::tie::std::growfile}
+log {package require tie::std::log ; ::tie::std::log}
+remotearray {package require tie::std::rarray ; ::tie::std::rarray}}
+
+
+test tie-8.8 {tie::info type, wrong#args} {
+ catch {tie::info type} msg
+ set msg
+} {wrong#args: should be "tie::info type dstype"}
+
+test tie-8.9 {tie::info type, wrong#args} {
+ catch {tie::info type a b} msg
+ set msg
+} {wrong#args: should be "tie::info type dstype"}
+
+test tie-8.10 {tie::info type, bad type} {
+ catch {tie::info type a} msg
+ set msg
+} {Unknown type "a"}
+
+# -------------------------------------------------------------------------
+# Registry of types.
+
+test tie-9.0 {register, wrong#args} {
+ catch {tie::register} msg
+ set msg
+} {wrong # args: should be "tie::register dsclasscmd _as_ dstype"}
+
+test tie-9.1 {register, wrong#args} {
+ catch {tie::register a} msg
+ set msg
+} {wrong # args: should be "tie::register dsclasscmd _as_ dstype"}
+
+test tie-9.2 {register, wrong#args} {
+ catch {tie::register a b} msg
+ set msg
+} {wrong # args: should be "tie::register dsclasscmd _as_ dstype"}
+
+test tie-9.3 {register, wrong#args} {
+ catch {tie::register a b c d} msg
+ set msg
+} {wrong # args: should be "tie::register dsclasscmd _as_ dstype"}
+
+test tie-9.4 {register, wrong#args} {
+ catch {tie::register a b c} msg
+ set msg
+} {wrong#args: should be "tie::register command 'as' type"}
+
+test tie-9.5 {register, simple definition} {
+ set res {}
+ catch {tie::info type c} msg ; lappend res $msg
+ lappend res [tie::register a as c]
+ lappend res [tie::info type c]
+} {{Unknown type "c"} {} a}
+
+test tie-9.6 {register, chained definition} {
+ set res {}
+
+ tie::register cmdc as cmda
+ tie::register cmda as b
+
+ list [tie::info type b] [dictsort [ignore [tie::info types] array file growfile log dsource remotearray c]]
+} {cmdc {b cmdc cmda cmdc}}
+
+test tie-9.7 {register, broken chain} {
+ set res {}
+
+ # chain resolution depends on order of definitions.
+
+ tie::register cmdy as x
+ tie::register cmdz as cmdy
+
+ list [tie::info type x] [dictsort [ignore [tie::info types] array file growfile log dsource remotearray c cmda b]]
+} {cmdy {cmdy cmdz x cmdy}}
+
+# -------------------------------------------------------------------------
+
+testsuiteCleanup
+return
diff --git a/tcllib/modules/tie/tie_array.tcl b/tcllib/modules/tie/tie_array.tcl
new file mode 100644
index 0000000..5267970
--- /dev/null
+++ b/tcllib/modules/tie/tie_array.tcl
@@ -0,0 +1,124 @@
+# tie_array.tcl --
+#
+# Data source: Tcl array.
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tie_array.tcl,v 1.3 2005/09/28 04:51:24 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require snit
+package require tie
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+snit::type ::tie::std::array {
+
+ # ### ### ### ######### ######### #########
+ ## Specials
+
+ pragma -hastypemethods no
+ pragma -hasinfo no
+ pragma -simpledispatch yes
+
+ # ### ### ### ######### ######### #########
+ ## API : Construction & Destruction
+
+ constructor {rvar} {
+ # Bring reference to the array into the object scope,
+ # i.e. namespace of the object. This will fail for proc local
+ # variables. This latter is enforced by the core, to prevent
+ # the existence of dangling references to the variable when
+ # the procedure goes away.
+
+ # upvar 3, because we have to skip 3 snit internal levels to
+ # access the callers level.
+
+ if {[catch {
+ upvar 3 $rvar ${selfns}::thesource
+ }]} {
+ return -code error "Illegal use of proc local array variable \"$rvar\""
+ }
+
+ # Now bring the variable into method scope as well, to check
+ # for its existence.
+
+ variable ${selfns}::thesource
+
+ if {![array exists thesource]} {
+ return -code error "Undefined source array variable \"$rvar\""
+ }
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## API : Data source methods
+
+ method get {} {
+ variable ${selfns}::thesource
+ return [array get thesource]
+ }
+
+ method set {dict} {
+ variable ${selfns}::thesource
+ return [array set thesource $dict]
+ }
+
+ method unset {{pattern *}} {
+ variable ${selfns}::thesource
+ array unset thesource $pattern
+ return
+ }
+
+ method names {} {
+ variable ${selfns}::thesource
+ return [array names thesource]
+ }
+
+ method size {} {
+ variable ${selfns}::thesource
+ return [array size thesource]
+ }
+
+ method getv {index} {
+ variable ${selfns}::thesource
+ return $thesource($index)
+ }
+
+ method setv {index value} {
+ variable ${selfns}::thesource
+ set thesource($index) $value
+ return
+ }
+
+ method unsetv {index} {
+ variable ${selfns}::thesource
+ unset thesource($index)
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## Internal : Instance data
+
+ ## During construction the source array variable is imported into
+ ## the namespace of the object, for direct access through a
+ ## constant name. This also allows a direct reference without
+ ## having to deal with changing stack scopes. This is possible if
+ ## and only if the imported array is a namespaced variable. Proc
+ ## local variables cannot be imported into a namespace in this
+ ## manner. Trying to do so results in an error.
+
+ # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready to go
+
+::tie::register ::tie::std::array as array
+package provide tie::std::array 1.0
diff --git a/tcllib/modules/tie/tie_array.test b/tcllib/modules/tie/tie_array.test
new file mode 100644
index 0000000..7517063
--- /dev/null
+++ b/tcllib/modules/tie/tie_array.test
@@ -0,0 +1,301 @@
+# Tests for the tie module. -*- tcl -*-
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+# All rights reserved.
+#
+# RCS: @(#) $Id: tie_array.test,v 1.7 2006/10/09 21:41:42 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+ [file dirname [file dirname [file join [pwd] [info script]]]] \
+ devtools testutilities.tcl]
+
+testsNeedTcl 8.4
+testsNeedTcltest 1.0
+
+support {
+ use snit/snit.tcl snit
+ useLocal tie.tcl tie
+}
+testing {
+ useLocal tie_array.tcl tie::std::array
+}
+
+# -------------------------------------------------------------------------
+
+proc group {dict} {
+ set res {}
+ foreach {k v} $dict {lappend res [list $k $v]}
+ return $res
+}
+
+proc ignore {dict args} {
+ array set tmp $dict
+ foreach k $args {unset tmp($k)}
+ array get tmp
+}
+
+# -------------------------------------------------------------------------
+# Creation of array data sources
+# Errors: Undefined variable, scalar, local variable
+
+test tie-array-1.0 {array creation, wrong#args} {
+ catch {tie::std::array} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::array::Snit_constructor type selfns win self rvar"}
+
+test tie-array-1.1 {array creation, wrong#args} {
+ catch {tie::std::array x} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::array::Snit_constructor type selfns win self rvar"}
+
+test tie-array-1.2 {array creation, wrong#args} {
+ catch {tie::std::array x y z} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::array::Snit_constructor type selfns win self rvar"}
+
+
+test tie-array-1.3 {array creation, fixed name, undefined array} {
+ catch {tie::std::array x y} msg
+ set msg
+} {Error in constructor: Undefined source array variable "y"}
+
+test tie-array-1.4 {array creation, fixed name, proc local array} {
+ proc foo {} {
+ global msg
+ catch {tie::std::array x y} msg
+ }
+ foo
+ set msg
+} {Error in constructor: Illegal use of proc local array variable "y"}
+
+test tie-array-1.5 {array creation, fixed name, scalar variable} {
+ unset -nocomplain av ; set av SCALAR
+ catch {tie::std::array x av} msg
+ set msg
+} {Error in constructor: Undefined source array variable "av"}
+
+test tie-array-1.6 {array creation, fixed name, array} {
+ unset -nocomplain av ; array set av {}
+ set msg [tie::std::array x av]
+ x destroy
+ set msg
+} {::x}
+
+test tie-array-1.7 {array creation, %AUTO%} {
+ unset -nocomplain av ; array set av {}
+ set msg [tie::std::array %AUTO% av]
+ $msg destroy
+ set msg
+} {::array9}
+
+# -------------------------------------------------------------------------
+## Methods
+
+test tie-array-2.0 {array get, wrong#args} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::array x av
+ catch {x get a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodget type selfns win self"}
+
+test tie-array-2.1 {array get} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::array x av
+ set res [dictsort [x get]]
+ x destroy
+ set res
+} {a 1 b 2}
+
+
+test tie-array-3.0 {array set, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ catch {x set} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodset type selfns win self dict"}
+
+test tie-array-3.1 {array set, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ catch {x set a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodset type selfns win self dict"}
+
+test tie-array-3.2 {array set} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ lappend res [x set {c 3 b 2 a 1}]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {a 1 b 2 c 3}}
+
+
+test tie-array-4.0 {array names, wrong#args} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::array x av
+ catch {x names a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodnames type selfns win self"}
+
+test tie-array-4.1 {array names} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::array x av
+ set res [lsort [x names]]
+ x destroy
+ set res
+} {a b}
+
+
+test tie-array-5.0 {array size, wrong#args} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::array x av
+ catch {x size a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodsize type selfns win self"}
+
+test tie-array-5.1 {array size} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::array x av
+ set res [x size]
+ x destroy
+ set res
+} 2
+
+
+test tie-array-6.0 {array unset, wrong#args} {
+ unset -nocomplain av ; array set av {foo bar fox snarf a 3}
+ tie::std::array x av
+ set res {}
+ catch {x unset a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodunset type selfns win self ?pattern?"}
+
+test tie-array-6.1 {array unset, default pattern} {
+ unset -nocomplain av ; array set av {foo bar fox snarf a 3}
+ tie::std::array x av
+ set res {}
+ lappend res [x unset]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {}}
+
+test tie-array-6.2 {array unset, by pattern} {
+ unset -nocomplain av ; array set av {foo bar fox snarf a 3}
+ tie::std::array x av
+ set res {}
+ lappend res [x unset f*]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {a 3}}
+
+
+test tie-array-7.0 {array getv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ catch {x getv} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodgetv type selfns win self index"}
+
+test tie-array-7.1 {array getv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ catch {x getv a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodgetv type selfns win self index"}
+
+test tie-array-7.2 {array getv} {
+ unset -nocomplain av ; array set av {a 3 b 4}
+ tie::std::array x av
+ set res {}
+ lappend res [x getv a]
+ x destroy
+ set res
+} 3
+
+
+test tie-array-8.0 {array setv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ catch {x setv} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodsetv type selfns win self index value"}
+
+test tie-array-8.1 {array setv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ catch {x setv a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodsetv type selfns win self index value"}
+
+test tie-array-8.2 {array setv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ catch {x setv a b c} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodsetv type selfns win self index value"}
+
+test tie-array-8.3 {array setv} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ lappend res [x setv fox snarf]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {fox snarf}}
+
+
+test tie-array-9.0 {array unsetv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ catch {x unsetv} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodunsetv type selfns win self index"}
+
+test tie-array-9.1 {array unsetv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::array x av
+ set res {}
+ catch {x unsetv a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::array::Snit_methodunsetv type selfns win self index"}
+
+test tie-array-9.2 {array unsetv} {
+ unset -nocomplain av ; array set av {a 3 b 4}
+ tie::std::array x av
+ set res {}
+ lappend res [x unsetv a]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {b 4}}
+
+testsuiteCleanup
+return
diff --git a/tcllib/modules/tie/tie_dsource.tcl b/tcllib/modules/tie/tie_dsource.tcl
new file mode 100644
index 0000000..d8b2c5f
--- /dev/null
+++ b/tcllib/modules/tie/tie_dsource.tcl
@@ -0,0 +1,54 @@
+# tie_dsource.tcl --
+#
+# Data source: Data source object. I.e. here we implement a proxy.
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tie_dsource.tcl,v 1.3 2005/09/28 04:51:24 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require snit
+package require tie
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+snit::type ::tie::std::dsource {
+
+ # ### ### ### ######### ######### #########
+ ## Specials
+
+ pragma -hastypemethods no
+ pragma -hasinfo no
+
+ # ### ### ### ######### ######### #########
+ ## API : Construction & Destruction
+
+ constructor {args} {
+ set delegate $args
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## API : Data source methods
+
+ delegate method * to delegate
+
+ # ### ### ### ######### ######### #########
+ ## Internal : Instance data
+
+ variable delegate ; # The object to delegate to.
+
+ # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready to go
+
+::tie::register ::tie::std::dsource as dsource
+package provide tie::std::dsource 1.0
diff --git a/tcllib/modules/tie/tie_file.tcl b/tcllib/modules/tie/tie_file.tcl
new file mode 100644
index 0000000..5592e42
--- /dev/null
+++ b/tcllib/modules/tie/tie_file.tcl
@@ -0,0 +1,273 @@
+# tie_file.tcl --
+#
+# Data source: Files.
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tie_file.tcl,v 1.11 2008/02/28 06:19:56 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require snit
+package require tie
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+snit::type ::tie::std::file {
+ # ### ### ### ######### ######### #########
+ ## Notes
+
+ ## This data source maintains an internal cache for higher
+ ## efficiency, i.e. to avoid having to go out to the slow file.
+
+ ## This cache is handled as follows
+ ##
+ ## - All write operations invalidate the cache and write directly
+ ## to the file.
+ ##
+ ## - All read operations load from the file if the cache is
+ ## invalid, and from the cache otherwise
+
+ ## This scheme works well in the following situations:
+
+ ## (a) The data source is created, and then only read from.
+ ## (b) The data source is created, and then only written to.
+ ## (c) The data source is created, read once, and then only
+ ## written to.
+
+ ## This scheme works badly if the data source is opened and then
+ ## randomly read from and written to. The cache is useless, as it
+ ## is continuously invalidated and reloaded.
+
+ ## This no problem from this developers POV of view however.
+ ## Consider the context. If you have this situation just tie the
+ ## DS to an array A after creation. The tie framework operates on
+ ## the DS in mode (c) and A becomes an explicit cache for the DS
+ ## which is not invalidated by writing to it. IOW this covers
+ ## exactly the situation the DS by itself is not working well for.
+
+ # ### ### ### ######### ######### #########
+ ## Specials
+
+ pragma -hastypemethods no
+ pragma -hasinfo no
+ pragma -simpledispatch yes
+
+ # ### ### ### ######### ######### #########
+ ## API : Construction & Destruction
+
+ constructor {thepath} {
+ # Locate and open the journal file.
+
+ set path [::file normalize $thepath]
+ if {[::file exists $path]} {
+ set chan [open $path {RDWR EXCL APPEND}]
+ } else {
+ set chan [open $path {RDWR EXCL CREAT APPEND}]
+ }
+ fconfigure $chan -buffering none -encoding utf-8
+ return
+ }
+
+ destructor {
+ # Release the channel to the journal file, should it be open.
+ if {$chan ne ""} {close $chan}
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## API : Data source methods
+
+ method get {} {
+ if {![::file size $path]} {return {}}
+ $self LoadJournal
+ return [array get cache]
+ }
+
+ method set {dict} {
+ puts $chan [list array set $dict]
+ $self Invalidate
+ return
+ }
+
+ method unset {{pattern *}} {
+ puts $chan [list array unset $pattern]
+ $self Invalidate
+ return
+ }
+
+ method names {} {
+ if {![::file size $path]} {return {}}
+ $self LoadJournal
+ return [array names cache]
+ }
+
+ method size {} {
+ if {![::file size $path]} {return 0}
+ $self LoadJournal
+ return [array size cache]
+ }
+
+ method getv {index} {
+ if {![::file size $path]} {
+ return -code error "can't read \"$index\": no such variable"
+ }
+ $self LoadJournal
+ return $cache($index)
+ }
+
+ method setv {index value} {
+ puts $chan [list set $index $value]
+ $self Invalidate
+ return
+ }
+
+ method unsetv {index} {
+ puts $chan [list unset $index]
+ $self Invalidate
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## Internal : Instance data
+
+ variable chan {} ; # Channel to write the journal.
+ variable path {} ; # Path to journal file.
+
+ # Journal loading, and cache.
+
+ variable count 0 ; # #Operations in the journal.
+ variable cvalid 0 ; # Validity of the cache.
+ variable cache -array {} ; # Cache for journal
+
+ # Management of the cache: See notes at beginning.
+
+ # ### ### ### ######### ######### #########
+ ## Internal: Loading from the journal.
+
+ method LoadJournal {} {
+ if {$cvalid} return
+ $self Replay
+ $self Compact
+ return
+ }
+
+ method Replay {} {
+ # Use a safe interp for the evaluation of the journal file.
+ # (Empty safe for the hidden commands and the aliases we insert).
+
+ # Called for !cvalid, implies cache does not exist
+
+ set ip [interp create -safe]
+ foreach c [$ip eval {info commands}] {
+ if {$c eq "rename"} continue
+ $ip eval [list rename $c {}]
+ }
+ $ip eval {rename rename {}}
+
+ interp alias $ip set {} $self Set
+ interp alias $ip unset {} $self Unset
+ interp alias $ip array {} $self Array
+
+ array set cache {}
+ set count 0
+
+ set jchan [open $path r]
+ fconfigure $jchan -encoding utf-8
+ set data [read $jchan]
+ close $jchan
+
+ $ip eval $data
+ interp delete $ip
+
+ set cvalid 1
+ return
+ }
+
+ method Compact {} {
+ # Compact the journal
+
+ #puts @@/2*$count/3*[array size temp]/=/[expr {2*$count >= 3*[array size temp]}]
+
+ # ASSERT cvalid
+
+ # do not compact <=>
+ # 2*ops < 3*size <=>
+ # ops < 3/2*size <=>
+ # ops < 1.5*size
+
+ if {(2*$count) < (3*[array size cache])} return
+
+ ::file delete -force ${path}.new
+ set new [open ${path}.new {RDWR EXCL CREAT APPEND}]
+ fconfigure $new -buffering none -encoding utf-8
+
+ # Compress current contents into a single multi-key load operation.
+ puts $new [list array set [array get cache]]
+
+ if {$::tcl_platform(platform) eq "windows"} {
+ # For windows the open channels prevent us from
+ # overwriting the old file. We have to leave
+ # attackers a (small) window of opportunity for
+ # replacing the file with something they own :(
+ close $chan
+ close $new
+ ::file rename -force ${path}.new $path
+ set chan [open ${path} {RDWR EXCL APPEND}]
+ fconfigure $chan -buffering none -encoding utf-8
+ } else {
+ # Copy compacted journal over the existing one.
+ ::file rename -force ${path}.new $path
+ close $chan
+ set chan $new
+ }
+ return
+ }
+
+ method Set {index value} {
+ set cache($index) $value
+ incr count
+ return
+ }
+
+ method Unset {index} {
+ unset cache($index)
+ incr count
+ return
+ }
+
+ method Array {cmd detail} {
+ # syntax : set dict
+ # ...... : unset pattern
+
+ if {$cmd eq "set"} {
+ array set cache $detail
+ } elseif {$cmd eq "unset"} {
+ array unset cache $detail
+ } else {
+ return -code error "Illegal command \"$cmd\""
+ }
+ incr count
+ return
+ }
+
+ method Invalidate {} {
+ if {!$cvalid} return
+ set cvalid 0
+ unset cache
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready to go
+
+::tie::register ::tie::std::file as file
+package provide tie::std::file 1.0.4
diff --git a/tcllib/modules/tie/tie_file.test b/tcllib/modules/tie/tie_file.test
new file mode 100644
index 0000000..59ab914
--- /dev/null
+++ b/tcllib/modules/tie/tie_file.test
@@ -0,0 +1,392 @@
+# Tests for the tie module. -*- tcl -*-
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+# All rights reserved.
+#
+# RCS: @(#) $Id: tie_file.test,v 1.10 2006/10/12 04:45:57 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+ [file dirname [file dirname [file join [pwd] [info script]]]] \
+ devtools testutilities.tcl]
+
+testsNeedTcl 8.4
+testsNeedTcltest 1.0
+
+support {
+ use snit/snit.tcl snit
+ useLocal tie.tcl tie
+}
+testing {
+ useLocal tie_file.tcl tie::std::file
+}
+
+# -------------------------------------------------------------------------
+# Creation of array data sources
+# Errors: Undefined variable, scalar, local variable
+
+test tie-file-1.0 {file creation, wrong#args} {
+ catch {tie::std::file} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::file::Snit_constructor type selfns win self thepath"}
+
+test tie-file-1.1 {file creation, wrong#args} {
+ catch {tie::std::file x} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::file::Snit_constructor type selfns win self thepath"}
+
+test tie-file-1.2 {file creation, wrong#args} {
+ catch {tie::std::file x y z} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::file::Snit_constructor type selfns win self thepath"}
+
+test tie-file-1.3 {file creation, ok args, unwritable file} {unixOnly notRoot} {
+ set f [makeFile {} journal]
+ file attributes $f -permissions ugo-w
+ catch {tie::std::file x $f} msg
+ removeFile journal
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-file-1.4 {file creation, ok args, unwritable file} {winOnly} {
+ set f [makeFile {} journal]
+ file attributes $f -readonly 1
+ catch {tie::std::file x $f} msg
+ file attributes $f -readonly 0
+ removeFile journal
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-file-1.5 {file creation, ok args, unreadable file} {unixOnly notRoot} {
+ set f [makeFile {} journal]
+ file attributes $f -permissions ugo-r
+ catch {tie::std::file x $f} msg
+ removeFile journal
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-file-1.6 {file creation, ok args, uncreateable file} {unixOnly notRoot} {
+ set d [makeDirectory jtest]
+ set f [makeFile {} jtest/journal]
+
+ # Delete the created file, we want the tie code to try to generate
+ # it (and expect it to fail).
+ file delete $f
+
+ file attributes $d -permissions ugo-w
+
+ catch {tie::std::file x $f} msg
+
+ removeDirectory jtest
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-file-1.7 {file creation, ok args, uncreateable file} {knownBug winOnly notRoot} {
+ set d [makeDirectory jtest]
+ set f [makeFile {} jtest/journal]
+ removeFile jtest/journal
+ file attributes $d -readonly 1
+
+ catch {tie::std::file x $f} msg
+
+ removeFile jtest/journal
+ removeDirectory jtest
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-file-1.8 {file creation, fixed name, array} {
+ set f [makeFile {} journal]
+ set msg [tie::std::file x $f]
+ x destroy
+ removeFile journal
+ set msg
+} {::x}
+
+test tie-file-1.9 {file creation, %AUTO%} {
+ set f [makeFile {} journal]
+ set msg [tie::std::file %AUTO% $f]
+ $msg destroy
+ removeFile journal
+ string match ::file\[679] $msg
+} 1
+
+# -------------------------------------------------------------------------
+## Methods
+
+test tie-file-2.0 {file get, wrong#args} {
+ set f [makeFile {array set {b 2 a 1}} journal]
+ tie::std::file x $f
+ catch {x get a} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodget type selfns win self"}
+
+test tie-file-2.1 {file get} {
+ set f [makeFile {array set {b 2 a 1}} journal]
+ tie::std::file x $f
+ set res [dictsort [x get]]
+ x destroy
+ removeFile journal
+ set res
+} {a 1 b 2}
+
+
+test tie-file-3.0 {file set, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x set} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodset type selfns win self dict"}
+
+test tie-file-3.1 {file set, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x set a b} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodset type selfns win self dict"}
+
+test tie-file-3.2 {file set} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ lappend res [x set {c 3 b 2 a 1}]
+ lappend res [viewFile journal]
+ x destroy
+ removeFile journal
+ set res
+} {{} {
+array set {c 3 b 2 a 1}}}
+
+
+test tie-file-4.0 {file names, wrong#args} {
+ set f [makeFile {array set {b 2 a 1}} journal]
+ tie::std::file x $f
+ catch {x names a} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodnames type selfns win self"}
+
+test tie-file-4.1 {file names} {
+ set f [makeFile {array set {b 2 a 1}} journal]
+ tie::std::file x $f
+ set res [lsort [x names]]
+ x destroy
+ removeFile journal
+ set res
+} {a b}
+
+
+test tie-file-5.0 {file size, wrong#args} {
+ set f [makeFile {array set {b 2 a 1}} journal]
+ tie::std::file x $f
+ catch {x size a} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodsize type selfns win self"}
+
+test tie-file-5.1 {file size} {
+ set f [makeFile {array set {b 2 a 1}} journal]
+ tie::std::file x $f
+ set res [x size]
+ x destroy
+ removeFile journal
+ set res
+} 2
+
+
+test tie-file-6.0 {file unset, wrong#args} {
+ set f [makeFile {array set {foo bar fox snarf a 3}} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x unset a b} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodunset type selfns win self ?pattern?"}
+
+test tie-file-6.1 {file unset, default pattern} {
+ set f [makeFile {array set {foo bar fox snarf a 3}} journal]
+ tie::std::file x $f
+ set res {}
+ lappend res [x unset]
+ lappend res [viewFile journal]
+ x destroy
+ removeFile journal
+ set res
+} {{} {array set {foo bar fox snarf a 3}
+array unset *}}
+
+test tie-file-6.2 {file unset, by pattern} {
+ set f [makeFile {array set {foo bar fox snarf a 3}} journal]
+ tie::std::file x $f
+ set res {}
+ lappend res [x unset f*]
+ lappend res [viewFile journal]
+ x destroy
+ removeFile journal
+ set res
+} {{} {array set {foo bar fox snarf a 3}
+array unset f*}}
+
+
+test tie-file-7.0 {file getv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x getv} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodgetv type selfns win self index"}
+
+test tie-file-7.1 {file getv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x getv a b} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodgetv type selfns win self index"}
+
+test tie-file-7.2 {file getv} {
+ set f [makeFile {array set {a 3 b 4}} journal]
+ tie::std::file x $f
+ set res {}
+ lappend res [x getv a]
+ x destroy
+ removeFile journal
+ set res
+} 3
+
+
+test tie-file-8.0 {file setv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x setv} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodsetv type selfns win self index value"}
+
+test tie-file-8.1 {file setv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x setv a} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodsetv type selfns win self index value"}
+
+test tie-file-8.2 {file setv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x setv a b c} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodsetv type selfns win self index value"}
+
+test tie-file-8.3 {file setv} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ lappend res [x setv fox snarf]
+ lappend res [viewFile journal]
+ x destroy
+ removeFile journal
+ set res
+} {{} {
+set fox snarf}}
+
+
+test tie-file-9.0 {file unsetv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x unsetv} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodunsetv type selfns win self index"}
+
+test tie-file-9.1 {file unsetv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::file x $f
+ set res {}
+ catch {x unsetv a b} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::file::Snit_methodunsetv type selfns win self index"}
+
+test tie-file-9.2 {file unsetv} {
+ set f [makeFile {array set {a 3 b 4}} journal]
+ tie::std::file x $f
+ set res {}
+ lappend res [x unsetv a]
+ lappend res [viewFile journal]
+ x destroy
+ removeFile journal
+ set res
+} {{} {array set {a 3 b 4}
+unset a}}
+
+# -------------------------------------------------------------------------
+## File compaction
+
+test tie-file-10.0 {file compaction} {
+ set f [makeFile {
+ set aa 3
+ set ab 4
+ set ac 5
+ set ad 6
+ set ae 7
+ set f 8
+ array unset a*
+ } journal] ; # {}
+ tie::std::file x $f
+ x names ; # This loads the journal and causes compaction
+ x destroy
+ set res [viewFile journal]
+ removeFile journal
+ set res
+} {array set {f 8}}
+
+test tie-file-10.1 {file compaction, not} {
+ set f [makeFile {
+ set aa 3
+ set ab 4
+ set ac 5
+ set ad 6
+ set ae 7
+ } journal] ; # {}
+ tie::std::file x $f
+ x names ; # This loads the journal and causes compaction
+ x destroy
+ set res [viewFile journal]
+ removeFile journal
+ set res
+} {
+ set aa 3
+ set ab 4
+ set ac 5
+ set ad 6
+ set ae 7
+ }
+
+testsuiteCleanup
+return
diff --git a/tcllib/modules/tie/tie_growfile.tcl b/tcllib/modules/tie/tie_growfile.tcl
new file mode 100644
index 0000000..c2575fc
--- /dev/null
+++ b/tcllib/modules/tie/tie_growfile.tcl
@@ -0,0 +1,147 @@
+# tie_growfile.tcl --
+#
+# Data source: Files.
+#
+# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tie_growfile.tcl,v 1.1 2006/03/08 04:55:58 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require snit
+package require tie
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+snit::type ::tie::std::growfile {
+ # ### ### ### ######### ######### #########
+ ## Notes
+
+ ## This data source is geared towards the storage of arrays which
+ ## will never shrink over time. Data is always appended to the
+ ## files associated with this driver. Nothing is ever
+ ## removed. Compaction does not happen either, so modification of
+ ## array entries will keep the old information around in the history.
+
+ # ### ### ### ######### ######### #########
+ ## Specials
+
+ pragma -hastypemethods no
+ pragma -hasinfo no
+ pragma -simpledispatch yes
+
+ # ### ### ### ######### ######### #########
+ ## API : Construction & Destruction
+
+ constructor {thepath} {
+ # Locate and open the journal file.
+
+ set path [file normalize $thepath]
+ if {[file exists $path]} {
+ set chan [open $path {RDWR EXCL APPEND}]
+ } else {
+ set chan [open $path {RDWR EXCL CREAT APPEND}]
+ }
+ fconfigure $chan -buffering none -encoding utf-8
+ return
+ }
+
+ destructor {
+ # Release the channel to the journal file, should it be open.
+ if {$chan ne ""} {close $chan}
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## API : Data source methods
+
+ method get {} {
+ if {![file size $path]} {return {}}
+ $self LoadJournal
+ return [array get cache]
+ }
+
+ method names {} {
+ if {![file size $path]} {return {}}
+ $self LoadJournal
+ return [array names cache]
+ }
+
+ method size {} {
+ if {![file size $path]} {return 0}
+ $self LoadJournal
+ return [array size cache]
+ }
+
+ method getv {index} {
+ if {![file size $path]} {
+ return -code error "can't read \"$index\": no such variable"
+ }
+ $self LoadJournal
+ return $cache($index)
+ }
+
+ method set {dict} {
+ puts -nonewline $chan $dict
+ puts -nonewline $chan { }
+ flush $chan
+ return
+ }
+
+ method setv {index value} {
+ puts -nonewline $chan [list $index $value]
+ puts -nonewline $chan { }
+ flush $chan
+ return
+ }
+
+ method unset {{pattern *}} {
+ return -code error \
+ "Deletion of entries is not allowed by this data source"
+ }
+
+ method unsetv {index} {
+ return -code error \
+ "Deletion of entries is not allowed by this data source"
+ }
+
+ # ### ### ### ######### ######### #########
+ ## Internal : Instance data
+
+ variable chan {} ; # Channel to write the journal.
+ variable path {} ; # Path to journal file.
+
+ # Journal loading, and cache.
+
+ variable count 0 ; # #Operations in the journal.
+ variable cvalid 0 ; # Validity of the cache.
+ variable cache -array {} ; # Cache for journal
+
+ # Management of the cache: See notes at beginning.
+
+ # ### ### ### ######### ######### #########
+ ## Internal: Loading from the journal.
+
+ method LoadJournal {} {
+ if {$cvalid} return
+ set cvalid 1
+
+ set in [open $path r]
+ array set cache [read $in]
+ close $in
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready to go
+
+::tie::register ::tie::std::growfile as growfile
+package provide tie::std::growfile 1.0
diff --git a/tcllib/modules/tie/tie_growfile.test b/tcllib/modules/tie/tie_growfile.test
new file mode 100644
index 0000000..46fcde3
--- /dev/null
+++ b/tcllib/modules/tie/tie_growfile.test
@@ -0,0 +1,345 @@
+# Tests for the tie module. -*- tcl -*-
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+# All rights reserved.
+#
+# RCS: @(#) $Id: tie_growfile.test,v 1.3 2006/10/12 04:45:57 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+ [file dirname [file dirname [file join [pwd] [info script]]]] \
+ devtools testutilities.tcl]
+
+testsNeedTcl 8.4
+testsNeedTcltest 1.0
+
+support {
+ use snit/snit.tcl snit
+ useLocal tie.tcl tie
+}
+testing {
+ useLocal tie_growfile.tcl tie::std::growfile
+}
+
+# -------------------------------------------------------------------------
+# Creation of array data sources
+# Errors: Undefined variable, scalar, local variable
+
+test tie-growfile-1.0 {file creation, wrong#args} {
+ catch {tie::std::growfile} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::growfile::Snit_constructor type selfns win self thepath"}
+
+test tie-growfile-1.1 {file creation, wrong#args} {
+ catch {tie::std::growfile x} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::growfile::Snit_constructor type selfns win self thepath"}
+
+test tie-growfile-1.2 {file creation, wrong#args} {
+ catch {tie::std::growfile x y z} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::growfile::Snit_constructor type selfns win self thepath"}
+
+test tie-growfile-1.3 {file creation, ok args, unwritable file} {unixOnly notRoot} {
+ set f [makeFile {} journal]
+ file attributes $f -permissions ugo-w
+ catch {tie::std::growfile x $f} msg
+ removeFile journal
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-growfile-1.4 {file creation, ok args, unwritable file} {winOnly} {
+ set f [makeFile {} journal]
+ file attributes $f -readonly 1
+ catch {tie::std::growfile x $f} msg
+ file attributes $f -readonly 0
+ removeFile journal
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-growfile-1.5 {file creation, ok args, unreadable file} {unixOnly notRoot} {
+ set f [makeFile {} journal]
+ file attributes $f -permissions ugo-r
+ catch {tie::std::growfile x $f} msg
+ removeFile journal
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-growfile-1.6 {file creation, ok args, uncreateable file} {unixOnly notRoot} {
+ set d [makeDirectory jtest]
+ set f [makeFile {} jtest/journal]
+
+ # Delete the created file, we want the tie code to try to generate
+ # it (and expect it to fail).
+ file delete $f
+
+ file attributes $d -permissions ugo-w
+
+ catch {tie::std::growfile x $f} msg
+
+ removeDirectory jtest
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-growfile-1.7 {file creation, ok args, uncreateable file} {knownBug winOnly notRoot} {
+ set d [makeDirectory jtest]
+ set f [makeFile {} jtest/journal]
+ removeFile jtest/journal
+ file attributes $d -readonly 1
+
+ catch {tie::std::growfile x $f} msg
+
+ removeFile jtest/journal
+ removeDirectory jtest
+ string map [list $f @] $msg
+} {Error in constructor: couldn't open "@": permission denied}
+
+test tie-growfile-1.8 {file creation, fixed name, array} {
+ set f [makeFile {} journal]
+ set msg [tie::std::growfile x $f]
+ x destroy
+ removeFile journal
+ set msg
+} {::x}
+
+test tie-growfile-1.9 {file creation, %AUTO%} {
+ set f [makeFile {} journal]
+ set msg [tie::std::growfile %AUTO% $f]
+ $msg destroy
+ removeFile journal
+ string match ::growfile\[679] $msg
+} 1
+
+# -------------------------------------------------------------------------
+## Methods
+
+test tie-growfile-2.0 {file get, wrong#args} {
+ set f [makeFile {b 2 a 1} journal]
+ tie::std::growfile x $f
+ catch {x get a} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodget type selfns win self"}
+
+test tie-growfile-2.1 {file get} {
+ set f [makeFile {b 2 a 1} journal]
+ tie::std::growfile x $f
+ set res [dictsort [x get]]
+ x destroy
+ removeFile journal
+ set res
+} {a 1 b 2}
+
+
+test tie-growfile-3.0 {file set, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x set} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodset type selfns win self dict"}
+
+test tie-growfile-3.1 {file set, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x set a b} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodset type selfns win self dict"}
+
+test tie-growfile-3.2 {file set} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ lappend res [x set {c 3 b 2 a 1}]
+ lappend res [viewFile journal]
+ x destroy
+ removeFile journal
+ set res
+} {{} {
+c 3 b 2 a 1 }}
+
+
+test tie-growfile-4.0 {file names, wrong#args} {
+ set f [makeFile {b 2 a 1} journal]
+ tie::std::growfile x $f
+ catch {x names a} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodnames type selfns win self"}
+
+test tie-growfile-4.1 {file names} {
+ set f [makeFile {b 2 a 1} journal]
+ tie::std::growfile x $f
+ set res [lsort [x names]]
+ x destroy
+ removeFile journal
+ set res
+} {a b}
+
+
+test tie-growfile-5.0 {file size, wrong#args} {
+ set f [makeFile {b 2 a 1} journal]
+ tie::std::growfile x $f
+ catch {x size a} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodsize type selfns win self"}
+
+test tie-growfile-5.1 {file size} {
+ set f [makeFile {b 2 a 1} journal]
+ tie::std::growfile x $f
+ set res [x size]
+ x destroy
+ removeFile journal
+ set res
+} 2
+
+
+test tie-growfile-6.0 {file unset, wrong#args} {
+ set f [makeFile {foo bar fox snarf a 3} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x unset a b} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodunset type selfns win self ?pattern?"}
+
+test tie-growfile-6.1 {file unset, default pattern} {
+ set f [makeFile {foo bar fox snarf a 3} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x unset} msg
+ x destroy
+ removeFile journal
+ set msg
+} {Deletion of entries is not allowed by this data source}
+
+test tie-growfile-6.2 {file unset, by pattern} {
+ set f [makeFile {foo bar fox snarf a 3} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x unset f*} msg
+ x destroy
+ removeFile journal
+ set msg
+} {Deletion of entries is not allowed by this data source}
+
+
+test tie-growfile-7.0 {file getv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x getv} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodgetv type selfns win self index"}
+
+test tie-growfile-7.1 {file getv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x getv a b} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodgetv type selfns win self index"}
+
+test tie-growfile-7.2 {file getv} {
+ set f [makeFile {a 3 b 4} journal]
+ tie::std::growfile x $f
+ set res {}
+ lappend res [x getv a]
+ x destroy
+ removeFile journal
+ set res
+} 3
+
+
+test tie-growfile-8.0 {file setv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x setv} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodsetv type selfns win self index value"}
+
+test tie-growfile-8.1 {file setv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x setv a} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodsetv type selfns win self index value"}
+
+test tie-growfile-8.2 {file setv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x setv a b c} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodsetv type selfns win self index value"}
+
+test tie-growfile-8.3 {file setv} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ lappend res [x setv fox snarf]
+ lappend res [viewFile journal]
+ x destroy
+ removeFile journal
+ set res
+} {{} {
+fox snarf }}
+
+
+test tie-growfile-9.0 {file unsetv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x unsetv} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodunsetv type selfns win self index"}
+
+test tie-growfile-9.1 {file unsetv, wrong#args} {
+ set f [makeFile {} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x unsetv a b} msg
+ x destroy
+ removeFile journal
+ set msg
+} {wrong # args: should be "::tie::std::growfile::Snit_methodunsetv type selfns win self index"}
+
+test tie-growfile-9.2 {file unsetv} {
+ set f [makeFile {a 3 b 4} journal]
+ tie::std::growfile x $f
+ set res {}
+ catch {x unsetv a} msg
+ x destroy
+ removeFile journal
+ set msg
+} {Deletion of entries is not allowed by this data source}
+
+# -------------------------------------------------------------------------
+
+testsuiteCleanup
+return
diff --git a/tcllib/modules/tie/tie_log.tcl b/tcllib/modules/tie/tie_log.tcl
new file mode 100644
index 0000000..bec66ca
--- /dev/null
+++ b/tcllib/modules/tie/tie_log.tcl
@@ -0,0 +1,95 @@
+# tie_log.tcl --
+#
+# Data source: /dev/null. Just log changes.
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tie_log.tcl,v 1.3 2005/09/28 04:51:24 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require snit
+package require log
+package require tie
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+package require snit
+snit::type ::tie::std::log {
+
+ # ### ### ### ######### ######### #########
+ ## Specials
+
+ pragma -hastypemethods no
+ pragma -hasinfo no
+ pragma -simpledispatch yes
+
+ # ### ### ### ######### ######### #########
+ ## API : Construction & Destruction
+
+ constructor {} {
+ ::log::log debug "$self construction"
+ return
+ }
+
+ destructor {
+ ::log::log debug "$self destruction"
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## API : Data source methods
+
+ method get {} {
+ ::log::log debug "$self get (nothing)"
+ return {}
+ }
+
+ method set {dict} {
+ ::log::log debug "$self set [list $dict]"
+ return
+ }
+
+ method unset {{pattern *}} {
+ ::log::log debug "$self unset $pattern"
+ return
+ }
+
+ method names {} {
+ ::log::log debug "$self names (nothing)"
+ return {}
+ }
+
+ method size {} {
+ ::log::log debug "$self size (0)"
+ return 0
+ }
+
+ method getv {index} {
+ ::log::log debug "$self get ($index)"
+ return {}
+ }
+
+ method setv {index value} {
+ ::log::log debug "$self set ($index) = \[$value\]"
+ return
+ }
+
+ method unsetv {index} {
+ ::log::log debug "$self unset ($index)"
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready to go
+
+::tie::register ::tie::std::log as log
+package provide tie::std::log 1.0
diff --git a/tcllib/modules/tie/tie_log.test b/tcllib/modules/tie/tie_log.test
new file mode 100644
index 0000000..2316d9e
--- /dev/null
+++ b/tcllib/modules/tie/tie_log.test
@@ -0,0 +1,240 @@
+# Tests for the tie module. -*- tcl -*-
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+# All rights reserved.
+#
+# RCS: @(#) $Id: tie_log.test,v 1.7 2006/10/09 21:41:42 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+ [file dirname [file dirname [file join [pwd] [info script]]]] \
+ devtools testutilities.tcl]
+
+testsNeedTcl 8.4
+testsNeedTcltest 1.0
+
+support {
+ use snit/snit.tcl snit
+ useLocal tie.tcl tie
+}
+testing {
+ useLocal tie_log.tcl tie::std::log
+}
+
+# -------------------------------------------------------------------------
+
+proc note {level text} {global res ; lappend res $text ; return}
+log::lvCmdForall note
+log::lvSuppressLE critical 0
+
+# -------------------------------------------------------------------------
+# Creation of array daat sources
+# Errors: Undefined variable, scalar, local variable
+
+test tie-log-1.0 {log creation, wrong#args} {
+ catch {tie::std::log x y z} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::log::Snit_constructor type selfns win self"}
+
+test tie-log-1.1 {log creation, %AUTO%} {
+ set res {}
+ lappend res [tie::std::log x]
+ x destroy
+ set res
+} {{::x construction} ::x {::x destruction}}
+
+test tie-log-1.2 {log creation, %AUTO%} {
+ set res {}
+ lappend res [set msg [tie::std::log %AUTO%]]
+ $msg destroy
+ set res
+} {{::log3 construction} ::log3 {::log3 destruction}}
+
+# -------------------------------------------------------------------------
+## Methods
+
+test tie-log-2.0 {log get, wrong#args} {
+ tie::std::log x
+ catch {x get a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodget type selfns win self"}
+
+test tie-log-2.1 {log get} {
+ set res {}
+ tie::std::log x
+ lappend res [x get]
+ x destroy
+ set res
+} {{::x construction} {::x get (nothing)} {} {::x destruction}}
+
+
+test tie-log-3.0 {log set, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x set} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodset type selfns win self dict"}
+
+test tie-log-3.1 {log set, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x set a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodset type selfns win self dict"}
+
+test tie-log-3.2 {log set} {
+ set res {}
+ tie::std::log x
+ lappend res [x set {c 3 b 2 a 1}]
+ x destroy
+ set res
+} {{::x construction} {::x set {c 3 b 2 a 1}} {} {::x destruction}}
+
+
+test tie-log-4.0 {log names, wrong#args} {
+ tie::std::log x
+ catch {x names a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodnames type selfns win self"}
+
+test tie-log-4.1 {log names} {
+ set res {}
+ tie::std::log x
+ lappend res [x names]
+ x destroy
+ set res
+} {{::x construction} {::x names (nothing)} {} {::x destruction}}
+
+
+test tie-log-5.0 {log size, wrong#args} {
+ tie::std::log x
+ catch {x size a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodsize type selfns win self"}
+
+test tie-log-5.1 {log size} {
+ set res {}
+ tie::std::log x
+ lappend res [x size]
+ x destroy
+ set res
+} {{::x construction} {::x size (0)} 0 {::x destruction}}
+
+
+test tie-log-6.0 {log unset, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x unset a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodunset type selfns win self ?pattern?"}
+
+test tie-log-6.1 {log unset, default pattern} {
+ set res {}
+ tie::std::log x
+ lappend res [x unset]
+ x destroy
+ set res
+} {{::x construction} {::x unset *} {} {::x destruction}}
+
+test tie-log-6.2 {log unset, by pattern} {
+ set res {}
+ tie::std::log x
+ lappend res [x unset f*]
+ x destroy
+ set res
+} {{::x construction} {::x unset f*} {} {::x destruction}}
+
+
+test tie-log-7.0 {log getv, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x getv} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodgetv type selfns win self index"}
+
+test tie-log-7.1 {log getv, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x getv a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodgetv type selfns win self index"}
+
+test tie-log-7.2 {log getv} {
+ set res {}
+ tie::std::log x
+ lappend res [x getv a]
+ x destroy
+ set res
+} {{::x construction} {::x get (a)} {} {::x destruction}}
+
+
+test tie-log-8.0 {log setv, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x setv} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodsetv type selfns win self index value"}
+
+test tie-log-8.1 {log setv, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x setv a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodsetv type selfns win self index value"}
+
+test tie-log-8.2 {log setv, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x setv a b c} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodsetv type selfns win self index value"}
+
+test tie-log-8.3 {log setv} {
+ set res {}
+ tie::std::log x
+ lappend res [x setv fox snarf]
+ x destroy
+ set res
+} {{::x construction} {::x set (fox) = [snarf]} {} {::x destruction}}
+
+
+test tie-log-9.0 {log unsetv, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x unsetv} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodunsetv type selfns win self index"}
+
+test tie-log-9.1 {log unsetv, wrong#args} {
+ tie::std::log x
+ set res {}
+ catch {x unsetv a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::log::Snit_methodunsetv type selfns win self index"}
+
+test tie-log-9.2 {log unsetv} {
+ set res {}
+ tie::std::log x
+ lappend res [x unsetv a]
+ x destroy
+ set res
+} {{::x construction} {::x unset (a)} {} {::x destruction}}
+
+# Switch off logging
+log::lvSuppressLE critical 1
+testsuiteCleanup
+return
diff --git a/tcllib/modules/tie/tie_rarray.tcl b/tcllib/modules/tie/tie_rarray.tcl
new file mode 100644
index 0000000..eb4d6d5
--- /dev/null
+++ b/tcllib/modules/tie/tie_rarray.tcl
@@ -0,0 +1,118 @@
+# tie_rarray.tcl --
+#
+# Data source: Remote Tcl array.
+#
+# Copyright (c) 2004-2015 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tie_rarray.tcl,v 1.3 2005/09/28 04:51:24 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require snit
+package require tie
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+snit::type ::tie::std::rarray {
+
+ # ### ### ### ######### ######### #########
+ ## Specials
+
+ pragma -hastypemethods no
+ pragma -hasinfo no
+ pragma -simpledispatch yes
+
+ # ### ### ### ######### ######### #########
+ ## API : Construction & Destruction
+
+ constructor {rvar cmdpfx id} {
+ set remotevar $rvar
+ set cmd $cmdpfx
+ set rid $id
+
+ if {![$self Call array exists $rvar]} {
+ return -code error "Undefined source array variable \"$rvar\""
+ }
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## API : Data source methods
+
+ method get {} {
+ return [$self Call array get $remotevar]
+ }
+
+ method set {dict} {
+ $self Call array set $remotevar $dict
+ return
+ }
+
+ method unset {{pattern *}} {
+ $self Call array unset $remotevar $pattern
+ return
+ }
+
+ method names {} {
+ return [$self Call array names $remotevar]
+ }
+
+ method size {} {
+ return [$self Call array size $remotevar]
+ }
+
+ method getv {index} {
+ return [$self Call set ${remotevar}($index)]
+ }
+
+ method setv {index value} {
+ $self Call set ${remotevar}($index) $value
+ return
+ }
+
+ method unsetv {index} {
+ $self Call unset -nocomplain ${remotevar}($index)
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## Internal : Instance data
+
+ variable remotevar {} ; # Name of rmeote array
+ variable cmd {} ; # Send command prefix
+ variable rid {} ; # Id of entity hosting the array.
+
+ # ### ### ### ######### ######### #########
+ ## Internal: Calling to the remote entity.
+
+ ## All calls are synchronous. Asynchronous operations would
+ ## created problems with circular ties. Because the operation may
+ ## came back so much later that the origin is already in a
+ ## completely new state. This is avoied in synchronous mode as the
+ ## origin waits for the change to be acknowledged, and the
+ ## operation came back in this time. The change made by it is no
+ ## problem. The trace is still running, thus any write does _not_
+ ## re-invoke our trace. The only possible problem is an unset for
+ ## an element already gone. This was solved by using -nocomplain
+ ## when propagating this type of change.
+
+ method Call {args} {
+ set c $cmd
+ lappend c $rid
+ lappend c $args
+ return [uplevel #0 $c]
+ }
+
+ # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready to go
+
+::tie::register ::tie::std::rarray as remotearray
+package provide tie::std::rarray 1.0.1
diff --git a/tcllib/modules/tie/tie_rarray.test b/tcllib/modules/tie/tie_rarray.test
new file mode 100644
index 0000000..ff8cd9f
--- /dev/null
+++ b/tcllib/modules/tie/tie_rarray.test
@@ -0,0 +1,331 @@
+# Tests for the tie module. -*- tcl -*-
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+# All rights reserved.
+#
+# RCS: @(#) $Id: tie_rarray.test,v 1.7 2006/10/09 21:41:42 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+ [file dirname [file dirname [file join [pwd] [info script]]]] \
+ devtools testutilities.tcl]
+
+testsNeedTcl 8.4
+testsNeedTcltest 1.0
+
+support {
+ use snit/snit.tcl snit
+ useLocal tie.tcl tie
+}
+testing {
+ useLocal tie_rarray.tcl tie::std::rarray
+}
+
+# -------------------------------------------------------------------------
+
+proc mysend {args} {
+ # A fake send command, also local receiver, in a way.
+ # args = options?... id cmd arg...
+ # Options used is -async. Id is irrelevant here.
+
+ set async [expr {[lindex $args 0] eq "-async"}]
+ if {$async} {set args [lrange $args 1 end]}
+ set args [lrange $args 1 end]
+ set cmd [linsert $args 0 uplevel 1]
+ #puts stderr ||<<[join $cmd {>> <<}]>>||
+ set code [catch $cmd msg]
+ if {$async} return
+ return -code $code $msg
+}
+
+# -------------------------------------------------------------------------
+# Creation of remote array data sources
+# Errors: Undefined variable, scalar, local variable
+
+test tie-rarray-1.0 {remote array creation, wrong#args} {
+ catch {tie::std::rarray} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::rarray::Snit_constructor type selfns win self rvar cmdpfx id"}
+
+test tie-rarray-1.1 {remote array creation, wrong#args} {
+ catch {tie::std::rarray x} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::rarray::Snit_constructor type selfns win self rvar cmdpfx id"}
+
+test tie-rarray-1.2 {remote array creation, wrong#args} {
+ catch {tie::std::rarray x y} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::rarray::Snit_constructor type selfns win self rvar cmdpfx id"}
+
+test tie-rarray-1.3 {remote array creation, wrong#args} {
+ catch {tie::std::rarray x y z} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::rarray::Snit_constructor type selfns win self rvar cmdpfx id"}
+
+test tie-rarray-1.4 {remote array creation, wrong#args} {
+ catch {tie::std::rarray x y z a b} msg
+ set msg
+} {Error in constructor: wrong # args: should be "::tie::std::rarray::Snit_constructor type selfns win self rvar cmdpfx id"}
+
+
+test tie-rarray-1.5 {remote array creation, fixed name, undefined array acceptable} {
+ catch {tie::std::rarray x y mysend _DUMMY_ID_} msg
+ set msg
+} {Error in constructor: Undefined source array variable "y"}
+
+test tie-rarray-1.6 {remote array creation, bad send command} {
+ unset -nocomplain av ; set av {}
+ catch {tie::std::rarray x av foosend _DUMMY_ID_} msg
+ set msg
+} {Error in constructor: invalid command name "foosend"}
+
+test tie-rarray-1.7 {remote array creation, fixed name, scalar variable} {
+ unset -nocomplain av ; set av SCALAR
+ catch {tie::std::rarray x av mysend _DUMMY_ID_} msg
+ set msg
+} {Error in constructor: Undefined source array variable "av"}
+
+
+test tie-rarray-1.8 {remote array creation, fixed name, array} {
+ unset -nocomplain av ; array set av {}
+ set msg [tie::std::rarray x av mysend _DUMMY_ID_]
+ x destroy
+ set msg
+} {::x}
+
+test tie-rarray-1.9 {remote array creation, %AUTO%} {
+ unset -nocomplain av ; array set av {}
+ set msg [tie::std::rarray %AUTO% av mysend _DUMMY_ID_]
+ $msg destroy
+ set msg
+} {::rarray11}
+
+# -------------------------------------------------------------------------
+## Methods
+
+test tie-rarray-2.0 {remote array get, wrong#args} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ catch {x get a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodget type selfns win self"}
+
+test tie-rarray-2.1 {remote array get} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res [dictsort [x get]]
+ x destroy
+ set res
+} {a 1 b 2}
+
+
+test tie-rarray-3.0 {remote array set, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x set} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodset type selfns win self dict"}
+
+test tie-rarray-3.1 {remote array set, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x set a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodset type selfns win self dict"}
+
+test tie-rarray-3.2 {remote array set} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ lappend res [x set {c 3 b 2 a 1}]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {a 1 b 2 c 3}}
+
+
+test tie-rarray-4.0 {remote array names, wrong#args} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ catch {x names a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodnames type selfns win self"}
+
+test tie-rarray-4.1 {remote array names} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res [lsort [x names]]
+ x destroy
+ set res
+} {a b}
+
+
+test tie-rarray-5.0 {remote array size, wrong#args} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ catch {x size a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodsize type selfns win self"}
+
+test tie-rarray-5.1 {remote array size} {
+ unset -nocomplain av ; array set av {b 2 a 1}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res [x size]
+ x destroy
+ set res
+} 2
+
+
+test tie-rarray-6.0 {remote array unset, wrong#args} {
+ unset -nocomplain av ; array set av {foo bar fox snarf a 3}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x unset a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodunset type selfns win self ?pattern?"}
+
+test tie-rarray-6.1 {remote array unset, default pattern} {
+ unset -nocomplain av ; array set av {foo bar fox snarf a 3}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ lappend res [x unset]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {}}
+
+test tie-rarray-6.2 {remote array unset, by pattern} {
+ unset -nocomplain av ; array set av {foo bar fox snarf a 3}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ lappend res [x unset f*]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {a 3}}
+
+
+test tie-rarray-7.0 {remote array getv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x getv} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodgetv type selfns win self index"}
+
+test tie-rarray-7.1 {remote array getv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x getv a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodgetv type selfns win self index"}
+
+test tie-rarray-7.2 {remote array getv} {
+ unset -nocomplain av ; array set av {a 3 b 4}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ lappend res [x getv a]
+ x destroy
+ set res
+} 3
+
+
+test tie-rarray-8.0 {remote array setv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x setv} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodsetv type selfns win self index value"}
+
+test tie-rarray-8.1 {remote array setv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x setv a} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodsetv type selfns win self index value"}
+
+test tie-rarray-8.2 {remote array setv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x setv a b c} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodsetv type selfns win self index value"}
+
+test tie-rarray-8.3 {remote array setv} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ lappend res [x setv fox snarf]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {fox snarf}}
+
+test tie-rarray-8.4 {remote array setv, value containing space} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ lappend res [x setv fox {snarf it}]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {fox {snarf it}}}
+
+test tie-rarray-8.5 {remote array setv, varname containing space} {
+ unset -nocomplain {a v} ; array set {a v} {}
+ tie::std::rarray x {a v} mysend _DUMMY_ID_
+ set res {}
+ lappend res [x setv fox {snarf it}]
+ lappend res [dictsort [array get {a v}]]
+ x destroy
+ set res
+} {{} {fox {snarf it}}}
+
+test tie-rarray-9.0 {remote array unsetv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x unsetv} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodunsetv type selfns win self index"}
+
+test tie-rarray-9.1 {remote array unsetv, wrong#args} {
+ unset -nocomplain av ; array set av {}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ catch {x unsetv a b} msg
+ x destroy
+ set msg
+} {wrong # args: should be "::tie::std::rarray::Snit_methodunsetv type selfns win self index"}
+
+test tie-rarray-9.2 {remote array unsetv} {
+ unset -nocomplain av ; array set av {a 3 b 4}
+ tie::std::rarray x av mysend _DUMMY_ID_
+ set res {}
+ lappend res [x unsetv a]
+ lappend res [dictsort [array get av]]
+ x destroy
+ set res
+} {{} {b 4}}
+
+testsuiteCleanup
+return
diff --git a/tcllib/modules/tie/tie_rarray_comm.test b/tcllib/modules/tie/tie_rarray_comm.test
new file mode 100644
index 0000000..6f2ff45
--- /dev/null
+++ b/tcllib/modules/tie/tie_rarray_comm.test
@@ -0,0 +1,218 @@
+# Tests for the tie module. -*- tcl -*-
+#
+# Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+# All rights reserved.
+#
+# This is a tie for remote array ties, actually using separate
+# processes. This is based on the package "comm", also in Tcllib.
+#
+# RCS: @(#) $Id: tie_rarray_comm.test,v 1.11 2007/08/01 22:53:18 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+ [file dirname [file dirname [file join [pwd] [info script]]]] \
+ devtools testutilities.tcl]
+
+testsNeedTcl 8.4
+testsNeedTcltest 1.0
+
+support {
+ use comm/comm.tcl comm
+ use snit/snit.tcl snit
+ use cmdline/cmdline.tcl cmdline
+ useLocal tie.tcl tie
+}
+testing {
+ useLocal tie_rarray.tcl tie::std::rarray
+}
+
+# -------------------------------------------------------------------------
+
+set comm_code [tcllibPath comm/comm.tcl]
+set cmdline_code [tcllibPath cmdline/cmdline.tcl]
+set snit_code [tcllibPath snit/snit.tcl]
+set tie_code [localPath tie.tcl]
+set tie_ra_code [localPath tie_rarray.tcl]
+
+# ------------------------------------------------------------------------
+#
+# First order of things is to spawn a separate tclsh into the background
+# and have it execute comm too, with some general code to respond to our
+# requests
+
+set path(spawn) [makeFile {
+ ##puts [set fh [open ~/foo w]] $argv ; close $fh
+
+ set master [lindex $argv 2]
+ source [lindex $argv 1] ; # load 'snit'
+ source [lindex $argv 0] ; # load 'comm'
+ # and wait for commands. But first send our
+ # own server socket to the initiator
+ ::comm::comm send $master [list slaveat [::comm::comm self]]
+ #comm::comm debug 1
+ vwait forever
+} spawn]
+
+proc slaveat {id} {
+ #puts "Slave @ $id"
+ proc slave {} [list return $id]
+ set ::go .
+}
+
+#puts "self @ [::comm::comm self]"
+
+exec [info nameofexecutable] $path(spawn) $comm_code $snit_code [::comm::comm self] &
+
+#puts "Waiting for spawned comm system to boot"
+# Wait for the slave to initialize itself.
+vwait ::go
+
+interp alias {} csend {} comm::comm send [slave]
+interp alias {} csenda {} comm::comm send -async [slave]
+
+#puts "Running tests"
+#::comm::comm debug 1
+# ------------------------------------------------------------------------
+
+# -------------------------------------------------------------------------
+# We wish to test the regular remote communication, and circular
+# communication, i.e. (1) a tie from A to remote B, and (2) ties from
+# A to B and back.
+
+# We assume that the regular tests for 'rarray' were successful.
+
+test tie-rarray-comm-1.0 {init from remote} {
+ unset -nocomplain av ; array set av {}
+
+ csend {
+ unset -nocomplain av
+ array set av {a 3 ab 4 fox snarf foo bar x {a b}}
+ }
+
+ tie::tie av remotearray av {comm::comm send} [slave]
+ tie::untie av
+
+ set res [dictsort [array get av]]
+ unset av
+ set res
+} {a 3 ab 4 foo bar fox snarf x {a b}}
+
+test tie-rarray-comm-1.1 {persistence to remote} {
+ unset -nocomplain av ; array set av {}
+
+ csend {
+ unset -nocomplain av
+ array set av {a 1 b 2 c 3}
+ }
+
+ tie::tie av remotearray av {comm::comm send} [slave]
+
+ proc peek {} {
+ global r
+ lappend r [dictsort [csend {array get av}]]
+ return
+ }
+
+ set r {} ; peek
+ set av(a) 4 ; peek
+ set av(ax) foo ; peek
+ array unset av a* ; peek
+ array set av {b 5 d 6} ; peek
+ set av(x) {a b} ; peek
+ array unset av * ; peek
+ array set av {b {d e}} ; peek
+
+ tie::untie av
+ rename peek {}
+ unset av
+ join $r \n
+} {a 1 b 2 c 3
+a 4 b 2 c 3
+a 4 ax foo b 2 c 3
+b 2 c 3
+b 5 c 3 d 6
+b 5 c 3 d 6 x {a b}
+
+b {d e}}
+
+
+
+# -------------------------------------------------------------------------
+# Circular ties between local and remote array
+
+test tie-rarray-comm-2.0 {circular init to remote} {
+ unset -nocomplain av ; array set av {}
+
+ csend {
+ unset -nocomplain av
+ array set av {a 3 ab 4 fox snarf foo bar}
+ }
+
+ tie::tie av remotearray av {comm::comm send} [slave]
+
+ csend [list source $cmdline_code]
+ csend [list source $snit_code]
+ csend [list source $tie_code]
+ csend [list source $tie_ra_code]
+ set msg [csend {
+ tie::tie av remotearray av {comm::comm send} $master
+ }] ; # {}
+ tie::untie av
+ csend {tie::untie av}
+
+ set res [dictsort [array get av]]
+ unset av
+ list $msg $res
+} {tie1 {a 3 ab 4 foo bar fox snarf}}
+
+test tie-rarray-comm-2.1 {circular persistence to remote} {
+ unset -nocomplain av ; array set av {}
+
+ csend {
+ unset -nocomplain av
+ array set av {a 1 b 2 c 3}
+ }
+
+ tie::tie av remotearray av {comm::comm send} [slave]
+ csend [list source $cmdline_code]
+ csend [list source $snit_code]
+ csend [list source $tie_code]
+ csend [list source $tie_ra_code]
+ set msg [csend {
+ tie::tie av remotearray av {comm::comm send} $master
+ }] ; # {}
+
+ proc peek {} {
+ global r
+ lappend r [dictsort [csend {array get av}]]
+ return
+ }
+
+ set r {} ; peek
+ set av(a) 4 ; peek
+ set av(ax) foo ; peek
+ array unset av a* ; peek
+ array set av {b 5 d 6} ; peek
+
+ tie::untie av
+ rename peek {}
+ unset av
+ join $r \n
+} {a 1 b 2 c 3
+a 4 b 2 c 3
+a 4 ax foo b 2 c 3
+b 2 c 3
+b 5 c 3 d 6}
+
+# -------------------------------------------------------------------------
+# As part of the cleanup ensure that the slave we used here is killed.
+
+csenda {{exit}}
+::comm::comm abort
+
+interp alias {} csend
+removeFile spawn
+
+testsuiteCleanup
+return
diff --git a/tcllib/modules/tie/tie_std.man b/tcllib/modules/tie/tie_std.man
new file mode 100644
index 0000000..bd0cbdb
--- /dev/null
+++ b/tcllib/modules/tie/tie_std.man
@@ -0,0 +1,35 @@
+[manpage_begin tie n 1.1]
+[keywords array]
+[keywords database]
+[keywords file]
+[keywords metakit]
+[keywords persistence]
+[keywords tie]
+[keywords untie]
+[copyright {2008-2015 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc {Tcl Data Structures}]
+[titledesc {Array persistence, standard data sources}]
+[category {Programming tools}]
+[require Tcl 8.4]
+[require tie::std::log [opt 1.0]]
+[require tie::std::array [opt 1.0]]
+[require tie::std::rarray [opt 1.0.1]]
+[require tie::std::file [opt 1.0.4]]
+[require tie::std::growfile [opt 1.0]]
+[require tie::std::dsource [opt 1.0]]
+[description]
+
+The packages listed as requirements for this document are internal
+packages providing the standard data sources of package [package tie],
+as described in section [term {STANDARD DATA SOURCE TYPES}] of
+[package tie]'s documentation.
+
+[para]
+
+They are automatically loaded and registered by [package tie] when it
+itself is requested, and as such there is no need to request them on
+their own, although it is possible to do so.
+
+[vset CATEGORY tie]
+[include ../doctools2base/include/feedback.inc]
+[manpage_end]
diff --git a/tcllib/modules/tie/tie_template.txt b/tcllib/modules/tie/tie_template.txt
new file mode 100644
index 0000000..52a3a53
--- /dev/null
+++ b/tcllib/modules/tie/tie_template.txt
@@ -0,0 +1,100 @@
+# tie___TEMPLATE__.tcl --
+#
+# Tie arrays to persistence engines.
+# Replace __TEMPLATE__ with correct name of package.
+#
+# Copyright (c) ??? FILL IN !!
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tie_template.txt,v 1.3 2005/09/28 04:51:24 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require snit
+package require tie
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+snit::type __TEMPLATE__ {
+
+ # ### ### ### ######### ######### #########
+ ## Specials
+
+ pragma -hastypemethods no
+ pragma -hasinfo no
+ pragma -simpledispatch yes
+
+ # ### ### ### ######### ######### #########
+ ## API : Construction & Destruction
+
+ constructor {args} {
+ # Set up data source
+ return
+ }
+
+ destructor {
+ # Release resources
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## API : Data source methods
+
+ method get {} {
+ # Retrieve data source contents and return them
+ return {}
+ }
+
+ method set {dict} {
+ # Merge data to data source contents
+ return {}
+ }
+
+ method unset {{pattern *}} {
+ # Unset data source elements by glob pattern
+ return {}
+ }
+
+ method names {} {
+ # Return list of keys in data source.
+ return {}
+ }
+
+ method size {} {
+ # Return number of keys in data source.
+ return 0
+ }
+
+ method getv {index} {
+ # Return value at key
+ return {}
+ }
+
+ method setv {index value} {
+ # Set key to new value
+ return
+ }
+
+ method unsetv {index} {
+ # Unset a key
+ return
+ }
+
+ # ### ### ### ######### ######### #########
+ ## Internal : Instance data
+
+ # ### ### ### ######### ######### #########
+ ## Internal: ...
+
+ # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready to go
+
+::tie::register __TEMPLATE__ as __TEMPLATE__/shortform
+package provide __TEMPLATE__ 1.0
generated by cgit v0.12 at 2025-08-29 23:54:17 (GMT)