Richard Suchenwirth (2002-01-31) will have to exercise Tcl with colleagues who are familiar with the Bourne shell (/bin/sh - see Tcl heritage for the influences it had on Tcl!), and one task will be to replace /bin/sh scripts with equivalent Tcl scripts.
To make this migration easier, I am planning to introduce some syntactic sugar (Salt and sugar), so familiar built-ins can still be used. Most simply with interp alias, for which we first create a shorter version:
proc alias {new args} {eval [list interp alias {} $new {}] $args}Or a modern eval-less version (John Lunzer, 2019-12-03):
proc alias {new old} {interp alias {} $new {} {*}$old} alias echo puts stdout
alias read gets stdin ;# if we don't need the real [read]
alias cp file copy -force
alias rm file delete
alias mkdir file mkdir
# alias whoami subst $::tcl_platform(user)
# raises cryptic error message when called with args, hence:
proc whoami {} {set ::tcl_platform(user)}
alias -r file readable
alias -w file writable
alias -x file executableNote however that this echo 's output cannot be redirected to a file, or through a pipe. Things like
foo=`echo $bar | grep "^grill"`
would have to be restructured:
set foo [exec grep ^grill <<$bar]
which also has its charms, but needs habituation. (On the other foot, a Tcl'er would prefer regexp anyway...) Or see below, for a more powerful reimplementation which allows > and >> redirection.
The following one-liner emulates a frequently used part of /bin/sh's test command:
proc -f name {expr {[file exists $name] && [file type $name]=="file"}}
proc -z string {expr {[string length $string]==0}}This way, /bin/sh code written like this:
if [ -f $filename ] ...
needs no rewriting - but be aware that this is not a complete emulation of tests switches, so
if [ $# -ne 1 ] ...
would have to rewritten in expr syntax (braced condition, C operators), but we even emulate the Perlish special variable ?# :
set # [llength $argv]
if {${#} != 1 } ...This fills most of the shell special variables:
# Create some shellish variables:
proc sh'specials {} {
global argv
set ::0 $::argv0
set n 0
foreach i $argv {set ::[incr n] $i}
set ::# [llength $argv]
set ::\$ [pid]
set ::? 0 ;# exit status of last command
}The following wrapper for exec emulates the behavior that errors are not propagated (do not cause evaluation to stop), but may be detected from the special $? variable:
proc ! args {
if [catch {eval exec $args} res] {
if {[lindex $::errorCode 0]=="CHILDSTATUS"} {
set ::? [lindex $::errorCode 2]
}
}
set res
} ;# and an echoing version...
proc !! args {puts $args; puts [eval ! $args]}This wraps the required clock calls into a lookalike of UNIX's date command:
proc date {args} {
set cmd {clock format [clock sec]}
foreach arg $args {
if {$arg=="-u"} {
append cmd " -gmt 1"
} elseif [regexp {\+(.+)} $arg -> fmt] {
append cmd " -format [list $fmt]"
} else {error "usage: date ?-u? ?+%H%M%S...?"}
}
eval $cmd
}To tell the truth, this is not a Bourne shell issue, but in sh scripts, system executables are often called which may not be present (or with different behavior) on other platforms.
proc : args {set ::? 0} ;# sh's no-op - but resets exit codeFor the path-aware . in sh see source. And while we're at it, and after hinting at many more such example scripts everybody should have, here's some more Unix toolets partly reimplemented in Tcl (want more? write more!):
proc echo {string {redirector -} {file -}} {
set postcmd {close $fp}
switch -- $redirector {
> {set fp [open $file w]}
>> {set fp [open $file a]}
default {set fp stdout; set postcmd ""}
}
puts $fp $string
eval $postcmd
}
proc cat files {
set res ""
foreach file [eval glob $files] {
set fp [open $file]
append res [read $fp [file size $file]]
close $fp
}
set res
}Somehow my suspicion gets stronger that besides many other things, Tcl is a "lightweight operatting system" riding on top of the "real" one... See also Unixy minitools.
Here's an approximation to /bin/du which gives the disk usage in and below a given directory - but even after turning off the rounding up, it reports about 0.25% more than fileutils/du ;-(:
proc du {{directory .}} {
set res 0
foreach item [glob -nocomplain $directory/*] {
switch -- [file type $item] {
directory {incr res [du $item]}
file {
set res [expr {$res+([file size $item]+0)/1024}]
}
}
}
set res
} ;# RSLV 2007 Jan 30
I tried this du function, using tclsh8.5, wondering if any improvement was present. Here's what I get:
srv29 (814) $ du
14160 ./var
48 ./teapot/repository
32 ./teapot/config/1.0
48 ./teapot/config
11840 ./teapot/indexcache/teapot.activestate.com
11856 ./teapot/indexcache
11968 ./teapot
211264 ./Pages
624352 .
srv29 (815) $ tclsh8.5
% proc du {{directory .}} {
set res 0
foreach item [glob -nocomplain $directory/*] {
switch -- [file type $item] {
directory {incr res [du $item]}
file {
set res [expr {$res+([file size $item]+0)/1024}]
}
}
}
set res
} ;# RS
% du
250661
% gdu --si
7.3M ./var
25k ./teapot/repository
17k ./teapot/config/1.0
25k ./teapot/config
6.1M ./teapot/indexcache/teapot.activestate.com
6.1M ./teapot/indexcache
6.2M ./teapot
109M ./Pages
320M .I don't see a du in fileutil or I would try that and report its result as well.
Years later, here's how to mimic the Bourne shell's assignment - we let unknown know that a command of the pattern left=right shall assign the value right to the variable left:
proc know what {proc unknown args $what\n[info body unknown]}
know {if [regexp (.+)=(.+) [lindex $args 0] -> left right] {
return [uplevel 1 [list set $left [lreplace $args 0 0 $right]]]
}
}Now we can interact (or code) like this:
% i=1 1 % j=2 2 % expr $i+$j 3 % k=hello world hello world % set k hello world
RS 2008-02-29 - Another cuteness: if you have many calls to /bin/date, try this converter to clock calls:
proc /bin/date {{fmt ""}} {
switch -- $fmt {
"" {clock format [clock seconds]}
+%s {clock seconds}
default {clock format [clock seconds] -format [string range $fmt 1 end]}
}
}LV 2008 March 25 One function that I frequently have programmers ask me about, which isn't currently available from tcllib or, as far as I am aware, other libraries, is a function which would take a shell script and read it, setting $env variables in the tcl environment as if the tcl script had the ability to source in the shell variables. In the environment these programmers are coming from, various databases require variables set up, depending on the specific database instance, type of database, etc. While certainly the developers could create a sibling routine that did, in tcl, the same things as need to be done in shell, that duplication would result in more maintenance and possibilities of breakage. So, what was done was a script was created which spins off a shell that executes a shell . script command, then does a shell set to a file. The shell script then reads the created file, and ensures that the current tclsh's $env has the variables, and values, as were present in the shell.
jbr - 20110329 We solve this by writing all our environment setups file in tcsh style using "setenv". Then for sh we have:
setenv() {
eval export $1="$2"
}and for Tcl we have:
proc setenv { name value } { set ::env($name) $value }Cheers - John
29mar2011 gavino
a tcl vmstat inspired by dastat which a clone of would be ultimate goal
new-host$ ./tclstat3.tcl
r b w freememG pagin-out cpu-us-sy-id contextswitches
4 0 0 1.90 0 0 11 3 86 701
0 0 0 1.90 0 0 2 2 96 672
1 0 0 1.90 0 0 2 0 97 815
0 0 0 1.90 0 0 6 2 91 741
^C
new-host$ cat ./tclstat3.tcl
#!/apps/tcl/bin/tclsh8.6
puts "r b w freememG pagin-out cpu-us-sy-id contextswitches"
while {1} {
set raw [exec vmstat -c 3]
set rawsplit [split $raw "\n"]
set raw5 [lindex $rawsplit 4]
set proc [lrange $raw5 0 2]
set freemem [expr [lindex $raw5 4] / 1048576.0]
set nicemem [format %.2f $freemem]
set pageinout [lrange $raw5 7 8]
set ussysid [lrange $raw5 16 18]
set cswitch [lindex $raw5 15]
puts "$proc $nicemem $pageinout $ussysid $cswitch"
}