The code:
#################################################################################################### ## ## PARSEARGS: ALLGEMEINE EINFACHE ARGUMENTVERARBEITUNG ## Stand: 24.06.2018 MHo ## # Eingabe: # template - Dictionary/Liste mit Vorgaben -switch1: val1 flag1 0 ?...? # userargs - Benutzer-Argumente -switch1 val1 flag1 ?...? # Ausgabe: # Dictionary mit aktuellen Werten -switch1 val1 -flag1 -- posargs ?...? # ggF. Abbruch durch Fehler möglich (catch erforderlich) # Hinweise: # -Schaltern mit einem Doppelpunkt am Namensende (-name:) (im Template!) folgen # Werte. Letzter -Schalter gewinnt. Schreibweise für Schalter (case) unwichtig. # -- beendet die Schalterverarbeitung. "Falsche" Schalter werden als positionale # Argumente gewertet, nicht als Fehler. Flags (wertlose Schalter) bekommen bei # Vorkommnis immer den Wert 1. # proc parseArgs {template userargs} { while {[llength $userargs]} { set userargs [lassign $userargs token]; # nächstes Wort der Argumentliste -> pop if {$token eq "--"} { dict lappend template -- {*}$userargs; break; # while -> fertig } else { lassign [dict keys $template [string tolower $token]*] match; # zulässiger Schalter? if {$match ne ""} { if {[string index $match end] eq ":"} { set userargs [lassign $userargs token]; # folgendes ist Value -> pop } else { set token 1; # es folgt kein Wert, nur Flag } dict set template $match $token } else { dict lappend template -- $token; # pos.Arg -> alle in Liste -- sammeln } } } return [dict get $template]; # immer als Dictionary handhaben } package provide parseArgs 1.0
MHo 2018-06-25. I've done another argument parser. I wonder if tcl 9 will come with keyword args in the core. Until now I'm mixing english and german language ... pleae excuse me...
"Test-Suite" (well, sort of)
## # Ein paar Selbsttests # set auto_path . package require parseArgs 1.0 proc doTests {cmds} { set failCount 0 foreach {command expectedResult comment} $cmds { catch {uplevel $command} currentResult if {$expectedResult != $currentResult} { set marker "\t***ERR***" incr failCount } else { set marker "\tOK" } puts "Command : $command" puts "Result : $currentResult" puts "Expected: $expectedResult" puts "Comment : $comment" puts $marker\n } puts \t[expr {$failCount > 0 ? "***TESTS FAILED!!!***" : "TESTS PASSED"}] return $failCount } puts "Fehlgeschlagene Selbsttests: [doTests { {parseArgs {} {}} {} {Leeres Template, leere userargs} {parseArgs {-switch1: "default1"} {}} {-switch1: default1} {leere userargs, Vorgabe unverändert zurück} {parseArgs {-switch1: "default1"} {-switch1 "actual1"}} {-switch1: actual1} {Überschreibung, Switchname exakt} {parseArgs {-switch1: "default1" -switch2x: "default2"} {-swi "actual1a" -switch "actual1b" -switch2 "actual2"}} {-switch1: actual1b -switch2x: actual2} {Überschreibung, Switchnamen abgekürzt, erster Match zählt, letzter gewinnt} {parseArgs {-switch1: "default1"} {"eins" -s "actual1" "zwei"}} {-switch1: actual1 -- {eins zwei}} {Positionale Argumente} {parseArgs {-switch1: "default1"} {"eins" "--" -switch1 "drei"}} {-switch1: default1 -- {eins -switch1 drei}} {Keine Schalter / flags nach --} {parseArgs {-flag1 0 -switch1: "default1" -flag2 1} {eins -f -s actual1 zwei -- "drei" -flag2}} {-flag1 1 -switch1: actual1 -flag2 1 -- {eins zwei drei -flag2}} {Flags u.a.} }]" puts \n[parseArgs [lindex $argv 0] [lindex $argv 1]]