diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2016-09-07 15:27:33 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2016-09-07 15:27:33 +0300 |
commit | 9186ad1ff7a1a01315a2a9ad358081b0c9f83324 (patch) | |
tree | fed03abac109367d989159052ce178f3911ccbbf | |
parent | c7acb6b242b5df3b6d2fdc15b8fd57b1ef4e9378 (diff) | |
download | rex-9186ad1ff7a1a01315a2a9ad358081b0c9f83324.tar.gz rex-9186ad1ff7a1a01315a2a9ad358081b0c9f83324.tar.bz2 |
Move getopt to a separate namespace
-rwxr-xr-x | rex.exp | 452 |
1 files changed, 237 insertions, 215 deletions
@@ -169,6 +169,239 @@ proc hostname {arg} { } # ####################################################################### +# A parser for GNU-style command line syntax. +# Almost compatible with getopt_long(3), excepting several quirks. +# ####################################################################### +namespace eval getopt { + namespace export getopt optarg optind opterr optchar optopt + + variable optarg + variable optind + variable opterr 1 + variable optchar + variable optopt + + proc init {} { + variable optarg + set optarg "" + + variable optind + set optind 0 + + variable optchar + set optchar "" + + variable optopt + set optopt "" + } + + # getopt [-progname name] [-longopts list] argc argv shortopts script + proc getopt {args} { + while 1 { + if {[llength args] == 0} { + error "getopt: bad number of arguments" + } + switch -- [lindex $args 0] { + "-longopts" { + array set longopts [lindex $args 1] + set longnames [lsort [array names longopts]] + set args [lreplace $args 0 1] + } + "-progname" { + set progname "[lindex $args 1]: " + set args [lreplace $args 0 1] + } + default { + break + } + } + } + + if ![info exists progname] { + set progname "" + } + + if {[llength $args] != 4} { + error "getopt: bad number of arguments" + } + + set argc [lindex $args 0] + set argv [lindex $args 1] + set shortopts [lindex $args 2] + set script [lindex $args 3] + + variable optarg + variable optind + variable opterr + variable optchar + variable optopt + + for { set optind 0 } { $optind < $argc } { incr optind } { + set arg [lindex $argv $optind] + set chl [split $arg ""] + set j 0 + set optarg "" + + if {[lindex $chl 0] != "-"} { + return 0 + } + set chl [lreplace $chl 0 0] + incr j + + if {[lindex $chl 0] == "-"} { + set chl [lreplace $chl 0 0] + incr j + + if {[llength $chl] == 0} { + incr optind + return 0 + } + if [info exists longopts] { + set k [string first "=" $arg] + if {$k == -1} { + set name [string range $arg 2 end] + } else { + set name [string range $arg 2 [expr $k - 1]] + } + + set namelen [string length $name] + + unset -nocomplain found ambig + foreach s $longnames { + if {$s == $name} { + set found $s + break + } + + if [string equal -length $namelen $s $name] { + if {[info exists ambig]} { + puts stderr "${progname} --$s" + } elseif {[info exists found]} { + if $opterr { + puts stderr "${progname}ambiguous option $arg; possible candidates:" + puts stderr "${progname} --$found" + puts stderr "${progname} --$s" + set ambig 1 + } + set optchar "?" + set optopt $arg + eval $script + if !$opterr { + return -1 + } + } else { + set found $s + } + } elseif [info exists ambig] { + return -1 + } + } + + if ![info exists found] { + if $opterr { + puts stderr "${progname}unknown option '$arg'" + } + set optopt $arg + set optchar "?" + eval $script + return -1 + } + + set optchar $longopts($found) + switch -- $optchar { + - { set argument 0 + set optchar $found + } + = { set argument 1 + set optchar $found + } + default { + set pos [string first $optchar $shortopts] + if {$pos == -1} { + error "longopt $found refers to undeclared short option $optchar" + } + if {[string index $shortopts [expr $pos + 1]] == ":"} { + set argument 1 + } else { + set argument 0 + } + } + } + if $argument { + # FIXME: Handle optional arguments (::) + if {$k == -1} { + incr optind + if {$optind < [llength $argv]} { + set optarg [lindex $argv $optind] + } else { + if $opterr { + puts stderr "${progname}option '--$found' requires argument" + } + set optopt $optchar + set optchar "?" + eval $script + return -1 + } + } else { + set optarg [string range $arg [expr $k + 1] end] + } + } + eval $script + } else { + if $opterr { + puts stderr "${progname}unknown option '$arg'" + } + set optopt $arg + set optchar "?" + eval $script + return -1 + } + } else { + foreach optchar $chl { + # puts "looking for $ch in $shortopts" + set pos [string first $optchar $shortopts] + if {$pos == -1} { + if $opterr { + puts stderr "${progname}unknown option '-$optchar'" + } + set optopt $optchar + set optchar "?" + eval $script + return -1 + } + incr j + if {[string index $shortopts [expr $pos + 1]] == ":"} { + # Rest of chars are arguments + # FIXME: Handle optional arguments (::) + if {$j < [string length $arg]} { + set optarg [string range $arg $j end] + } else { + incr optind + if {$optind < [llength $argv]} { + set optarg [lindex $argv $optind] + } else { + if $opterr { + puts stderr "${progname}option '-$optchar' requires argument" + } + set optopt $optchar + set optchar "?" + eval $script + return -1 + } + } + } + eval $script + if {$optarg != ""} { + break + } + } + } + } + return 0 + } +} + +# ####################################################################### # Database access functions # ####################################################################### # rexdbget [-key BASEKEY] [-list QLIST] [-host HOSTNAME] KEY [KEY...] @@ -772,212 +1005,6 @@ proc argcvshift {} { } # ####################################################################### -# A parser for GNU-style command line syntax. -# Almost compatible with getopt_long(3), excepting several quirks. -# ####################################################################### - -# getopt [-progname name] [-longopts list] argc argv shortopts script -proc getopt {args} { - while 1 { - if {[llength args] == 0} { - error "getopt: bad number of arguments" - } - switch -- [lindex $args 0] { - "-longopts" { - array set longopts [lindex $args 1] - set longnames [lsort [array names longopts]] - set args [lreplace $args 0 1] - } - "-progname" { - set progname "[lindex $args 1]: " - set args [lreplace $args 0 1] - } - default { - break - } - } - } - - if ![info exists progname] { - set progname "" - } - - if {[llength $args] != 4} { - error "getopt: bad number of arguments" - } - - set argc [lindex $args 0] - set argv [lindex $args 1] - set shortopts [lindex $args 2] - set script [lindex $args 3] - - upvar optarg oarg optind i opterr oerr optchar ch optopt oopt - - for { set i 0 } { $i < $argc } { incr i } { - set arg [lindex $argv $i] - set chl [split $arg ""] - set j 0 - set oarg "" - - if {[lindex $chl 0] != "-"} { - return 0 - } - set chl [lreplace $chl 0 0] - incr j - - if {[lindex $chl 0] == "-"} { - set chl [lreplace $chl 0 0] - incr j - - if {[llength $chl] == 0} { - incr i - return 0 - } - if [info exists longopts] { - set k [string first "=" $arg] - if {$k == -1} { - set name [string range $arg 2 end] - } else { - set name [string range $arg 2 [expr $k - 1]] - } - - set namelen [string length $name] - - unset -nocomplain found ambig - foreach s $longnames { - if {$s == $name} { - set found $s - break - } - - if [string equal -length $namelen $s $name] { - if {[info exists ambig]} { - puts stderr "${progname} --$s" - } elseif {[info exists found]} { - if $oerr { - puts stderr "${progname}ambiguous option $arg; possible candidates:" - puts stderr "${progname} --$found" - puts stderr "${progname} --$s" - set ambig 1 - } - set ch "?" - set oopt $arg - eval $script - if !$oerr { - return -1 - } - } else { - set found $s - } - } elseif [info exists ambig] { - return -1 - } - } - - if ![info exists found] { - if $oerr { - puts stderr "${progname}unknown option '$arg'" - } - set oopt $arg - set ch "?" - eval $script - return -1 - } - - set ch $longopts($found) - switch -- $ch { - - { set argument 0 - set ch $found - } - = { set argument 1 - set ch $found - } - default { - set pos [string first $ch $shortopts] - if {$pos == -1} { - error "longopt $found refers to undeclared short option $ch" - } - if {[string index $shortopts [expr $pos + 1]] == ":"} { - set argument 1 - } else { - set argument 0 - } - } - } - if $argument { - # FIXME: Handle optional arguments (::) - if {$k == -1} { - incr i - if {$i < [llength $argv]} { - set oarg [lindex $argv $i] - } else { - if $oerr { - puts stderr "${progname}option '--$found' requires argument" - } - set oopt $ch - set ch "?" - eval $script - return -1 - } - } else { - set oarg [string range $arg [expr $k + 1] end] - } - } - eval $script - } else { - if $oerr { - puts stderr "${progname}unknown option '$arg'" - } - set oopt $arg - set ch "?" - eval $script - return -1 - } - } else { - foreach ch $chl { - # puts "looking for $ch in $shortopts" - set pos [string first $ch $shortopts] - if {$pos == -1} { - if $oerr { - puts stderr "${progname}unknown option '-$ch'" - } - set oopt $ch - set ch "?" - eval $script - return -1 - } - incr j - if {[string index $shortopts [expr $pos + 1]] == ":"} { - # Rest of chars are arguments - # FIXME: Handle optional arguments (::) - if {$j < [string length $arg]} { - set oarg [string range $arg $j end] - } else { - incr i - if {$i < [llength $argv]} { - set oarg [lindex $argv $i] - } else { - if $oerr { - puts stderr "${progname}option '-$ch' requires argument" - } - set oopt $ch - set ch "?" - eval $script - return -1 - } - } - } - eval $script - if {$oarg != ""} { - break - } - } - } - } - return 0 -} - -# ####################################################################### # Copying to and from remote hosts and running remote commands # ####################################################################### proc runcp {args} { @@ -1453,13 +1480,8 @@ set longopts { zsh-quirk Z } -set optind 0 -set optchar "" -set optarg "" -set opterr 1 - -getopt -progname $argv0 -longopts $longopts $argc $argv $shortopts { - global optchar optarg config +::getopt::getopt -progname $argv0 -longopts $longopts $argc $argv $shortopts { + global config switch -- $optchar { b { set config(option,buffer-output) 1 } C { set config(file) $optarg } @@ -1503,8 +1525,8 @@ getopt -progname $argv0 -longopts $longopts $argc $argv $shortopts { } } -set argv [lrange $argv $optind end] -set argc [expr $argc - $optind] +set argv [lrange $argv $::getopt::optind end] +set argc [expr $argc - $::getopt::optind] if {$config(mode) == "command"} { if {$argc >= 2 \ |