####################################################################################################
##
## 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

##
# 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]]