Perl-like command line options

glennj I've often seen people comparing Tcl to Perl and disparaging Tcl's lack of command line facility. They claim the ease of Perl's

  perl -e 'print "hello world"'

And Tcl'ers counter with

  echo 'puts "hello world"' | tclsh

I put together the following script to use many of Perl's command line options: -e, -n, -p, -a. Examples:

  tcl.tcl -e 'puts "hello world"'

and an implementation of wc

  tcl.tcl -begin 'set l [set w [set c 0]]' -end 'puts [join [list $l $w $c] \t]' -a -n -e 'incr l; incr w [llength $F]; incr c [string length $lines]' *.txt

Here's the script:

  #! /usr/bin/env tclsh
  #
  # vim: set ft=tcl

  package require cmdline

  ################################################################################
  proc main {argv} {
      array set opts [cmdLine argv]

      set interp [interp create]

      execute $interp $opts(begin) 

      if { ! ($opts(p) || $opts(n))} {
          execute $interp $opts(e)
      } else {
          if {$opts(a)} {
              interp eval $interp {
                  package require textutil
                  namespace import ::textutil::splitx
              }
          }
          if {[llength $argv] == 0} {
              processStdin $interp $opts(e) $opts(p) $opts(a) $opts(F)
          } else {
              foreach file $argv {
                  processFile $interp $opts(e) $file $opts(p) $opts(a) $opts(F)
              }
          }
      }

      execute $interp $opts(end)
  }

  ################################################################################
  proc cmdLine {varName} {
      upvar $varName argv

      set options {
          {e.arg "" "tcl script to execute"}
          {p "process script for each line of input, and print input"}
          {n "process script for each line of input, without printing input"}
          {a "split each line into a list named 'F'.  Split on the pattern given by -F"}
          {F.arg  {\s+} "the pattern on which a line is split"}
          {begin.arg "" "a begin block"}
          {end.arg   "" "an end block"}
          {d "enable debugging"}
      }
      set myself [file tail $::argv0]
      set usage {: incorporate perl's command line switches}
      append usage \n "usage: $myself \[options] -e script \[file ...]"
      append usage \n "options:"
      set notes {special variables:
  I use these variables in the way Perl does:
      _   the current line
      .   the current line number of the file being processed
      F   if -a is specified, the list F holds this line's fields (delimited by
          the argument to -F).

  examples:
  Hello world:
      $myself -e 'puts "hello world"'

  An implementation of wc, but it doesn't count line ending characters:
      $myself -begin 'set l [set w [set c 0]]' \\
          -end 'puts [join [list $l $w $c] \t]' \\
          -a -n -e 'incr l; incr w [llength $F]; incr c [string length $_]' *.txt
  }
      set notes [string map [list \$myself $myself \\\\ \\] $notes]

      if {[catch {
          array set opts [::cmdline::getoptions argv $options $usage]
      } output] != 0} {
          puts stderr $output
          puts stderr $notes
          exit 1
      }

      set ::debugging $opts(d)
      if {$::debugging} then {parray opts}

      if {$opts(p) && $opts(n)} {
          puts stderr "error: cannot specify both -n and -p"
          exit 1
      }
      if {$opts(e) eq ""} {
          puts stderr "error: no script specified"
          exit 1
      }
      return [array get opts]
  }

  proc debug {msg} {
      if {$::debugging} then {puts $msg}
  }

  proc debugProc {args} {
      debug [concat ">>" [lindex [info level -1] 0] $args]
  }

  ################################################################################

  proc execute {interp script} {
      debugProc $interp $script
      if {$script ne ""} {
          interp eval $interp $script
      }
  }

  ################################################################################
  proc processStdin {interp script p a F} {
      debugProc $interp $script $p $a $F
      processChan $interp $script stdin $p $a $F
  }

  proc processFile {interp script file p a F} {
      debugProc $interp $script $file $p $a $F

      if {[catch {open $file r} chan] != 0} {
          puts stderr "error: $chan"
      } else {
          interp share {} $chan $interp
          processChan $interp $script $chan $p $a $F
          close $chan
      }
  }

  proc processChan {interp script chan p a F} {
      debugProc $interp $script $chan $p $a $F

      set code [format {
              set . 0
              while {[gets %s _] != -1} {
                  incr .
                  %s
                  set rc [catch {%s} output]
                  %s
                  switch -exact -- $rc {
                      1 {return -code error $output}
                      2 {return}
                      3 {break}
                      4 {continue}
                  }
              }
              close %s
          } \
          $chan \
          [expr {$a ? [format {set F [splitx [string trim $_] {%s}]} $F] : ""}] \
          $script \
          [expr {$p ? {puts $_} : ""}] \
          $chan]
      debug ">>>> evaluating: [list $code]"
      interp eval $interp $code
  }

  ################################################################################
  main $argv

LV Alas, I suspect showing how much code it takes to emulate what Perl already has built in won't impress the judges so to speak.

glennj I counter by wondering how much code is required for Perl to do what it does?


EMJ I think a better reply to the disparagers would be to point out that Tcl is a fully interactive interpreter, and Perl isn't (although [1 ] constitutes evidence to the contrary).


RS If the echo solution looks too ugly, a tiny bash macro can add sugar on that:

 $ tcl() { echo $1 | tclsh; }
 $ tcl 'puts [expr sqrt(2)]'
 1.41421356237

glennj Except that the echo solution precludes the tcl script from reading stdin, or processing text files without opening them and iterating over them. To me, that is the most convenient aspect of perl one-liners. These examples dumps tcl script while stripping comments and blank lines

 $ perl -ne 'print unless /^\s*($|#)/' *.tcl
 $ tcl.tcl -n -e 'if {![regexp {^\s*($|#)} $_]} {puts $_}' *.tcl
 $ echo 'foreach file [glob *.tcl] {set f [open $file]; while {[gets $f _]>-1} {if {![regexp {^\s*($|#)} $_]} {puts $_}}; close $f} | tclsh

Category Example