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