#-- This is just a bait for [auto_index], because aliases aren't included there...
proc unix {} {return "unixy toolset 0.1 loaded"}
proc alias args {
# Set an alias: alias foo = bar grill
switch [llength $args] {
0 {join [map docstring [interp aliases]] \n}
1 {docstring $args}
default {
foreach {name eq} $args break
if {$eq ne "="} {error [docstring alias]}
eval [list interp alias {} $name {}] [lrange $args 2 end]
}
}
}
alias ? = set ::errorInfo
proc -f name {expr {[file exists $name] && [file type $name] eq "file"}}
alias -r = file readable
alias -w = file writable
alias -x = file executable
alias -z = string eq ""
proc at {time body} {
set dt [expr {[clock scan $time]-[clock sec]}]
if {$dt<0} {incr dt 86400}
after [expr {$dt*1000}] $body
}
proc cat files {
set res ""
foreach file [eval glob $files] {
set fp [open $file]
append res [read $fp]
close $fp
}
set res
}
alias cp = file copy -force
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
}
proc date {{x ""}} {
if {$x eq ""} {set x [clock seconds]}
clock format $x -format %Y-%m-%d,%H:%M:%S
}
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 grep {re args} {
foreach file [eval glob $args] {
set fp [open $file]
set n 0
while {[gets $fp line] >=0} {
incr n
if [regexp $re $line] {puts "$file:$n $line"}
}
close $fp
}
}
proc ll args {
if ![llength $args] {set args [glob *]}
set res {}
foreach f [lsort $args] {
lappend res "[date [file mtime $f]] [format %6d [file size $f]] $f"
}
join $res \n
}
proc ls {{x .}} {lsort [glob -nocom -dir $x *]}
alias mv = file rename
alias rm = file delete
proc touch file {close [open $file a]}
proc wc file {
# number of lines, words, characters in file
set l 0; set w 0; set c 0
set f [open $file]
while {[gets $f line]>=0} {
incr l
incr w [llength [split $line]]
incr c [string length $line]; incr c
}
close $f
list $l $w $c
}
proc wc-l file {lindex [wc $file] 0}
#------------------- name=value assignment
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]]]
}
}In alias, docstring is used, and map, which uses this simple implementation:
proc map {f list} {
set res {}
foreach el $list {lappend res [$f $el]}
set res
}rvb I was looking here for an exec-less tcl tail, and found tailf (tail -f), but didn't find tail -n (n last lines). Please add any improvements or corrections!
proc tail {args} {
set count 10
while {[llength $args] > 0} {
set arg [lindex $args 0]
set args [lrange $args 1 end]
switch -glob -- $arg {
-* {set count [expr -$arg]}
default {set file $arg}
}
}
set fd [open $file r]
seek $fd -1 end
set p [tell $fd]
set result {}
for {set i 0} {$i < $count} {incr i} {
set line ""
while {1} {
incr p -1
if {$p < 0} {break}
seek $fd $p
set c [read $fd 1]
seek $fd $p
if {[string match $c "\n"]} {
set result [linsert $result 0 $line]
break
}
set line $c$line
}
}
close $fd
return [join $result "\n"]
}Example:
set file /etc/passwd
puts [tail -5 $file]
puts "tcl [time {tail -10 $file} 100]"
puts "exec [time {exec tail -10 $file} 100]" 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"
}See also Playing Bourne shell
