Richard Suchenwirth 2002-04-15 - In my simple ways of Tcl programming, I have never before created a package. However, as I will have to teach Tcl programming, I finally could not avoid this point - and as usual with Tcl, it was little hassle but fun ;-) The following script creates a trivial but educational package futil, which in a namespace of same name implements two procs for reading and writing complete text files, and a little introspection helper, futil::?. The command to register the package (package provide) is executed only after all went well - this way, a buggy source, which raises an error, will not register. (Other bugs you'd have to spot and fix for yourself...)
Tcl has the good habit of profound testing, typically in a separate test directory. On the other hand, including self-test in the same file with the code makes editing easier, so after the package provide comes a section which is only executed if this file is sourced as top- level script, and exercises the commands defined in futil. Whether the string read should be equal to the string written, is debatable - the present implementation appends \n to the string if it doesn't end in one, because some tools complain or misbehave if they don't see a final newline.
If the tests do not run into an error either, even the required construction of a package index is fired - assuming the simplified case that the directory contains only one package. Otherwise, you'd better remove these lines, and take care of index creation yourself.
A script that uses this package will only have to contain the two lines
lappend ::auto_path <directory of this file> package require futil
You can even omit the first line, if you install (copy) the directory with the source and pkgIndex.tcl below .../tcl/lib. }
namespace eval futil {
set version 0.1
}
proc futil::read {filename} {
set fp [open $filename]
set string [::read $fp] ;# prevent name conflict with itself
close $fp
return $string
}
proc futil::write {filename string} {
set fp [open $filename w]
if {[string index $string end]!="\n"} {append string \n}
puts -nonewline $fp $string
close $fp
}
proc futil::? {} {lsort [info procs ::futil::*]}
# If execution comes this far, we have succeeded ;-)
package provide futil $futil::version
#--------------------------- Self-test code
if {[info ex argv0] && [file tail [info script]] == [file tail $argv0]} {
puts "package futil contains [futil::?]"
set teststring {
This is a teststring
in several lines...}
puts teststring:'$teststring'
futil::write test.tmp $teststring
set string2 [futil::read test.tmp]
puts string2:'$string2'
puts "strings are [expr {$teststring==$string2? {}:{not}}] equal"
file delete test.tmp ;# don't leave traces of testing
# Simple index generator, if the directory contains only this package
pkg_mkIndex -verbose [file dirn [info scr]] [file tail [info scr]]
}