Matthias Hoffmann - Tcl-Code-Snippets - misc routines - command line parsing

Why another parsing-routine? Because the other ones like cmdline or OptProc are a little overweight or just too complex. Here in the wiki, I found links to various useful parsing routines, but still I decided to write one of my own; here is the result. The input is checked/processed against a template, and the result is given back as a list suitable for array set. Switch names may be shortened. At the bottom of the page later I will add some examples of how a command line and the corresponding templates can look like.


 # Simple ParameterParsing (SPar)
 # 08.03.2005

 proc spar {tpl cmd} {
      if {[catch {array set a $tpl}]} {
         return -code error {invalid template}; # we couldn't handle this error
      }; # don't stop with other errors - give pgmr the chance to decide later
      set needmore {}
      set count    0
      set seeopts  1
      foreach item $cmd {
              if {[string equal $item "--"]} {
                 set seeopts 0; # end of -flag-processing
              } elseif {[string length $needmore]} {
                 set a($needmore) $item
                 set needmore {}
              } elseif {$seeopts == 1 && [string range $item 0 0] == "-"} {
                 set matches [array names a -glob $item*]; # allows shortening
                 if {[llength $matches]} {
                    set match [lindex [lsort $matches] 0]
                    if {[string index $match end] == ":"} {
                       set needmore $match; # -f: means: 'value follows'
                    } else {
                       set a($match) 1; # otherwise simply return 'true'
                    }
                 } else {
                    lappend a(swiunknown) $item
                 }
              } else {
                 incr count; # each arg counts, even if there are too much
                 if {[info exists a($count)]} {
                    set a($count) $item
                    set a(argcount) $count
                 } else {
                    lappend a(argsuper) $item
                 }
              }
      }
      if {[string length $needmore]} {
         set a(swinovalue) $needmore; # missing value after -switch: at the very end
      }
      return [array get a]; # double conversion is the price for using arrays
 }

 # Tests
 set tpl [list -f1 0 -f2 0 -f3: "*" -f4 0 -test 0 1 "" 2 "" 3 "Default3" -? 0]
 puts "Template: $tpl\n"
 puts Commandline:
 gets stdin cmd
 if {![catch {array set a [spar $tpl $cmd]} rc]} {
    puts "Resultarray:\n"
    parray a
 } else {
    puts $rc
 }

(Examples will be added later)


Command Line Parsing, enhanced (but yet simple) version with integrated help support

 # Simple ParameterParsing (SPar) SPAR.TCL
 # (C) M.Hoffmann 2004-2006
 #
 # 26.03.2005: Erweiterung: Hilfetexte mit übergeben, formatierte Hilfeausgabe
 # 05.07.2005: ReView, Ergänzungen
 # 09.07.2005: endgültige Hilfeformatierung festgelegt
 # 11.07.2005: Leere pos. Args überschreiben nicht Default; Hilfe integriert;
 #             package
 # 01.09.2005: BUG-Fix (alle %v's erhielten den selben Inhalt.....) -> WIKI!!!
 # 15.11.2005: Fehlerrückgabe geändert: Fehler immer in (_error) & Abbruch!
 #             Vereinfacht übergeordnete Benutzung! Testroutine noch anpassen!
 #             Hilferückgabe in _help. Hilferückgabe aufgetrennt in (_sytx) und
 #             (_help) zwecks besserer Aufbereitbarkeit im Mainprog. Rückgabe
 #             überzähliger Elemente als (_argsuper), Element ist sonst leer.
 # 08.02.2006: Bugfix. _argcount instead of argcount contains the number of positional Args.
 #             Changed format of Syntax Help
 #
 # ToDo:
 #  - namespace
 #  - Testcase
 #  - Wiki Update
 #
 # Support for special characters in Help:
 #  %s - ergibt den Switchnamen selbst (bei Pos.args nicht sinnvoll!)
 #  %v - ergibt [Vorgabewert]
 #  %n - Spaltengerechter manueller Zeilenumbruch

 package provide Spar 1.1

 proc spar {tpl cmd} {
      if {[catch {array set a $tpl}]} {
         return -code error {invalid template}; # we couldn't handle this error
      }; # don't stop with other errors - give pgmr the chance to decide later
      # Help extension, formerly in separate proc
      set col 0
      set sntx {}
      set help {}
      set a(_argsuper) ""
      foreach name [lsort [array names a]] {
              set lCol     [lindex $a($name) 1]; # left side of help
              set rCol [lrange $a($name) 2 end]; # right side of help
              set a($name) [lindex $a($name) 0]; # the value ifself
              set rCol [string map [list %v \\\[$a($name)\\\]] $rCol]; # Bugfix 01.09.
              set lCol [string map "%s $name" $lCol]; # 'switch' replaces %s
              if {[string length $lCol]} {
                 append sntx "$lCol "
                 append help " \[format %-\${col}s \"$lCol\"\]$rCol\n"
                 set l   [string length $lCol]         ; # determine begin of
                 set col [expr {$l > $col ? $l : $col}]; # right side of help
              }
      }
      incr col
      set nl "\n[string repeat " " $col]"
      set a(_sytx) $sntx
      set a(_help) [string map [list %n $nl] [subst $help]]
      # Help extension End
      set needmore {}
      set count    0
      set seeopts  1
      foreach item $cmd {
              if {[string equal $item "--"]} {
                 set seeopts 0; # end of -flag-processing
              } elseif {[string length $needmore]} {
                 set a($needmore) $item
                 set needmore {}
              } elseif {$seeopts == 1 && [string range $item 0 0] == "-"} {
                 set matches [array names a -glob $item*]; # allows shortening
                 if {[llength $matches]} {
                    set match [lindex [lsort $matches] 0]
                    if {[string index $match end] == ":"} {
                       set needmore $match; # -f: means: 'value follows'
                    } else {
                       set a($match) 1; # otherwise simply return 'true'
                    }
                 } else {
                    return -code error "Unbekannter Schalter: $item"
                 }
              } else {
                 incr count; # each arg counts, even if there are too much
                 if {[info exists a($count)]} {
                    if {[string length $item]} {
                       # Defaults can only be overridden by 'real' values
                       set a($count) $item; # empty string causes skip
                    }
                    set a(_argcount) $count
                 } else {
                    lappend a(_argsuper) $item; # das ist KEIN Fehler!
                 }
              }
      }
      if {[string length $needmore]} {
         # missing value after -switch: at the very end
         return -code error "Wert fehlend: $needmore"
      }
      return [array get a]; # double conversion is the price for using arrays...
 }

Test routine (like documentation and translation, is still a work in progress...)

 # Tests for Simple Parameter parsing (Spar) module
 # 11.07.2005, 01.08.2005, 01.09.2005, 08.02.2005
 # (C) M.Hoffmann

 lappend auto_path ./
 package require Spar 1.1

 # Template Format
 #
 # The template must be a proper list suitable for `array set`!
 #
 # basic format (without help) {
 #   -flagname|-optionname:|{1|2|...} default_value
 #   -flagname|-optionname:|{1|2|...} default_value
 #           :                            :
 # }
 #
 # where:
 #  '-flagname' is - well - a flag: the presence of it always returns
 #  1 (true), so the default value should almost always be 0 (false);
 #  '-optionname:' denotes a named arg, again initializied with a
 #  default value;
 #  1,2,...n is a placeholder for a positional argument. it's also
 #  possible to specify a default value for missing positional args.
 #
 # extended format (with help) {
 #   -flagname|-optionname:|{1|2|...} {default_value helptext ...}
 #   -flagname|-optionname:|{1|2|...} {default_value helptext ...}
 #           :                            :
 # }
 #
 # Helptext itself is formatted in two columns: the first elements in each row
 # represent the left column, the rest represents the right column.
 # helptext may contain %s (replaced by flag/optionname), %v
 # (replaced by defaultvalue, surrounded with brackets) or %n
 # (newline)

 # Setup Array With Example Template

 ##
 ## 1) für DYNAMISCHE DEFAULTS muss das Ganze in Quotes eingeschlossen werden können, nicht {} !
 ##     problematisch wegen für ARRAY SET notwendiger Struktur!!!
 ##
 ## 2) was ist mit '-?' - funktioniert das?
 ##

 set tst $env(ComputerName)

 # Warning: usage of $tst here leads to errors later (because of substitution in proc, where no $tst exists)
 set tpl {-flag1 {0         %s        A boolean flag. if present, 1 is returned. Default is irrelevant.}
          -f2    {-         %s        A boolean flag. if present, 1 is returned. This helptext is very%n
                                      long, so a linebreak is manually inserted with % followed by n.}
-n
{n_default {%s <value>} A named argument (key-value-pair). After this help text, the%n
                                      initial value appears in brackets. %v}
          -test  0
          1      {""        <pos1>    The first positional arg.}
          2      {""        <pos2>    The second positional arg. no default (empty string).}
          3      {tst       <pos3>    The third positional arg. if missing, a default is returned,%n
                                      which here is of dynamic nature: %v}
          -?     0
 }

 # Auflösung erfolgt trotz {} wegen Subst!
 set tpl "
          -flag1 {0         %s        A boolean flag. if present, 1 is returned. Default is irrelevant.}
          -f2    {-         %s        A boolean flag. if present, 1 is returned. This helptext is very%n
                                      long, so a line break is manually inserted with % followed by n.}
-n
{n_default {%s <value>} A named argument (key-value-pair). After this help text, the%n
                                      initial value appears in brackets. %v}
          -test  0
          1      {{}        <pos1>    The first positional arg.}
          2      {{}        <pos2>    The second positional arg. no default (empty string).}
          4      {$tst      <pos3>    The third positional arg. if missing, a default is returned,%n
                                      which here is of dynamic nature: %v}
          -?     0
 "

 puts {Commandline (type 'template' or 'help' or leave blank, than hit <return>):}
 gets stdin cmd
 if {[string match -nocase template* $cmd]} {
    puts $tpl\n
    exit
 }
 if {![catch {array set a [spar $tpl $cmd]} rc]} {
    if {[string match -nocase help* $cmd]} {
       puts "Syntax: $a(_sytx)\n\nSwitches:\n"
       puts $a(_help)
       exit;
    }
    puts "Resultarray:\n"
    parray a; # hier eigentlich Hilfe ausblenden
 } else {
    puts "Error:\n"
    puts $rc
 }

MHo April 12, 2006: It turned out that it's not always wanted to show the switches sorted. Will fix this later.


See: