FF 2008-04-21 - Here's my GetOpt-like library
it works as follows:
getopt::init {
{verbose v ::verbose}
{input i {::input ::input_file}}
{output o {::output ::output_file}}
}
set argv2 [getopt::getopt $argv]you can call yourScript.tcl -vio input.txt output.txt, which is equivalent to yourScript.tcl --verbose --input input.txt --output output.txt. the ::verbose variable will be set to 1 in case the --verbose switch is present. the other variables specified in getopt::init will hold the value of required arguments.
namespace eval getopt {
# list of option vars (keys are long option names)
variable optlist
# map short option names to long option names
variable stl_map
}
proc getopt::init {optdata} {
variable optlist
variable stl_map
array set optlist {}
array set stl_map {}
foreach item $optdata {
foreach {longname shortname varlist} $item {
set optlist($longname) $varlist
set stl_map($shortname) $longname
}
}
}
proc getopt::expandOptNames {argv} {
variable optlist
variable stl_map
set argv2 {}
set argc [llength $argv]
for {set i 0} {$i < $argc} {} {
set argv_i [lindex $argv $i]
incr i
if [isShortOpt $argv_i] {
set argv_i_opts [split [regsub {^-} $argv_i {}] {}]
foreach shortOpt $argv_i_opts {
if [info exists stl_map($shortOpt)] {
set longOpt $stl_map($shortOpt)
lappend argv2 --$longOpt
set n_required_opt_args [expr {-1+[llength $optlist($longOpt)]}]
while {$n_required_opt_args > 0} {
incr n_required_opt_args -1
if {$i >= $argc} {
puts "error: not enough arguments for option -$shortOpt"
exit 3
}
lappend argv2 [lindex $argv $i]
incr i
}
} else {
puts "error: unknown option: -$shortOpt"
exit 2
}
}
continue
}
lappend argv2 $argv_i
}
return $argv2
}
proc getopt::isShortOpt {o} {
return [regexp {^-[a-zA-Z0-9]+} $o]
}
proc getopt::isLongOpt {o} {
return [regexp {^--[a-zA-Z0-9][a-zA-Z0-9]*} $o]
}
proc getopt::getopt {argv} {
variable optlist
set argv [expandOptNames $argv]
set argc [llength $argv]
set residualArgs {}
for {set i 0} {$i < $argc} {} {
set argv_i [lindex $argv $i]
incr i
if [isLongOpt $argv_i] {
set optName [regsub {^--} $argv_i {}]
if [info exists optlist($optName)] {
set varlist $optlist($optName)
uplevel [list set [lindex $optlist($optName) 0] 1]
set n_required_opt_args [expr {-1+[llength $varlist]}]
set j 1
while {$n_required_opt_args > 0} {
incr n_required_opt_args -1
if {$i >= $argc} {
puts "error: not enough arguments for option --$optName"
exit 5
}
uplevel [list set [lindex $varlist $j] [lindex $argv $i]]
incr j
incr i
}
} else {
puts "error: unknown option: --$optName"
exit 4
}
continue
}
lappend residualArgs $argv_i
}
return $residualArgs
}| enter categories here |
|---|