#
# zsource.tcl
#   - adds 'zsource' which can be used to load gzipped tcl scripts
#   - based on an idea by Sup
#
# Copyright (C) 2001 Jeff Fisher <guppy@eggheads.org>
#
# updates
# -------
#	v1.00: first version -- not made public
#   v1.01: complete rewrite to act more like "source"
#	v1.02: do not load if there is no compression module found
#

if {[info commands uncompressfile] != "uncompressfile"} {
	putlog "* please load the compression module before loading zsource."
	return 0
}

proc zsource {args} {
	global temp-path
	if {[llength [info level 0]] != 2} {
		error "wrong # args: should be \"zsource fileName\""
	} else {
		set file [lindex $args 0]
	}

	if {![file exists $file]} {
		error "couldn't read file \"$file\": no such file or directory"
	} elseif {[file isdirectory $file]} {
		error "couldn't read file \"$file\": illegal operation on a directory"
	} elseif {![file readable $file]} {
		error "couldn't read file \"$file\": permission denied"
	} elseif {![iscompressed $file]} {
		error "couldn't read file \"$file\": it is not compressed"
	}
	set loop 1
	while {$loop == 1} {
		set tmpfile "${temp-path}zs[pid]."
    	for {set x 0} {$x < 10} {incr x} {
			append tmpfile [string index "abcdefghijklmnopqrstuvwxyz0123456789" [rand 36]]
	 	}
 		append tmpfile ".tcl"
 		if {![file exists $tmpfile]} {
 			set loop 0
 	 	}
	}
 	uncompressfile $file $tmpfile
	if {[file exists $tmpfile]} {
		if {[catch {uplevel #0 "source $tmpfile"} err]} {
			file delete -force $tmpfile
  			error $err
		} else {
			file delete -force $tmpfile
			return $err
	    }
	} else {
		error "couldn't read file \"$tmpfile\": decompression didn't work"
	}
}

putlog "* loaded: zsource.tcl v1.02"
Published in: TCL
Download

Related snippets