aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2016-09-07 15:27:33 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2016-09-07 15:27:33 +0300
commit9186ad1ff7a1a01315a2a9ad358081b0c9f83324 (patch)
treefed03abac109367d989159052ce178f3911ccbbf
parentc7acb6b242b5df3b6d2fdc15b8fd57b1ef4e9378 (diff)
downloadrex-9186ad1ff7a1a01315a2a9ad358081b0c9f83324.tar.gz
rex-9186ad1ff7a1a01315a2a9ad358081b0c9f83324.tar.bz2
Move getopt to a separate namespace
-rwxr-xr-xrex.exp452
1 files changed, 237 insertions, 215 deletions
diff --git a/rex.exp b/rex.exp
index fdfb000..7d9331c 100755
--- a/rex.exp
+++ b/rex.exp
@@ -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 \

Return to:

Send suggestions and report system problems to the System administrator.