Posted to tcl by dbohdan at Thu Sep 24 09:45:39 GMT 2020view raw

  1. #! /usr/bin/env tclsh
  2.  
  3. proc awksplit {0 {split default}} {
  4. if {$split eq "default"} {
  5. set t [lsearch -all -inline -not [split $0] {}]
  6. } else {
  7. set t [split $0 $split]
  8. }
  9.  
  10. set result [dict create]
  11. dict set result NF [llength $t]
  12.  
  13. set i 1
  14. foreach field $t {
  15. dict set result $i $field
  16. incr i
  17. }
  18.  
  19. return $result
  20. }
  21.  
  22. proc print args {
  23. upvar 1 OFS OFS
  24.  
  25. if {[catch {
  26. puts [join $args $OFS]
  27. }]} {
  28. exit 0
  29. }
  30. }
  31.  
  32. proc usage {} {
  33. puts "usage: owh patterns
  34. performs action (in Tcl) for each line (\$0) from stdin
  35. owh: Ousterhout - Welch - Hobbs, to name a few"
  36. }
  37.  
  38. proc main args {
  39. if {[llength $args] != 1} {
  40. usage
  41. exit -1
  42. }
  43.  
  44. set FS default
  45. set OFS { }
  46.  
  47. # Process $args.
  48. set __begin {}
  49. set __end {}
  50. set __patterns {}
  51. # Do not use [dict unset] to retain the key order in Jim Tcl 0.79 and
  52. # earlier.
  53. dict for {__expr __body} [lindex $args 0] {
  54. switch -- $__expr {
  55. BEGIN { set __begin $__body }
  56. END { set __end $__body }
  57. default { lappend __patterns $__expr $__body }
  58. }
  59. }
  60. unset args
  61.  
  62. # Prepare for the main loop.
  63. set NF 0
  64. set NR 0
  65.  
  66. eval $__begin
  67.  
  68. while true {
  69. if {[gets stdin 0] == -1} break
  70.  
  71. for {set __i 1} {$__i <= $NF} {incr __i} {
  72. unset $__i
  73. }
  74. unset __i
  75.  
  76. incr NR
  77.  
  78. set __split [awksplit $0 $FS]
  79. dict with __split {}
  80. unset __split
  81.  
  82. dict for {__expr __body} $__patterns {
  83. if $__expr { eval $__body }
  84. }
  85. }
  86.  
  87. set res [eval $__end]
  88. if {[string length $res]} {
  89. puts $res
  90. }
  91. }
  92.  
  93. main {*}$argv