Posted to tcl by dbohdan at Thu Sep 24 09:45:39 GMT 2020view pretty
#! /usr/bin/env tclsh
proc awksplit {0 {split default}} {
if {$split eq "default"} {
set t [lsearch -all -inline -not [split $0] {}]
} else {
set t [split $0 $split]
}
set result [dict create]
dict set result NF [llength $t]
set i 1
foreach field $t {
dict set result $i $field
incr i
}
return $result
}
proc print args {
upvar 1 OFS OFS
if {[catch {
puts [join $args $OFS]
}]} {
exit 0
}
}
proc usage {} {
puts "usage: owh patterns
performs action (in Tcl) for each line (\$0) from stdin
owh: Ousterhout - Welch - Hobbs, to name a few"
}
proc main args {
if {[llength $args] != 1} {
usage
exit -1
}
set FS default
set OFS { }
# Process $args.
set __begin {}
set __end {}
set __patterns {}
# Do not use [dict unset] to retain the key order in Jim Tcl 0.79 and
# earlier.
dict for {__expr __body} [lindex $args 0] {
switch -- $__expr {
BEGIN { set __begin $__body }
END { set __end $__body }
default { lappend __patterns $__expr $__body }
}
}
unset args
# Prepare for the main loop.
set NF 0
set NR 0
eval $__begin
while true {
if {[gets stdin 0] == -1} break
for {set __i 1} {$__i <= $NF} {incr __i} {
unset $__i
}
unset __i
incr NR
set __split [awksplit $0 $FS]
dict with __split {}
unset __split
dict for {__expr __body} $__patterns {
if $__expr { eval $__body }
}
}
set res [eval $__end]
if {[string length $res]} {
puts $res
}
}
main {*}$argv