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 -e 'puts "hello world"'
and an implementation of wc
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 the
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 $argvLV 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.