###################################################################################
 # Modul    : readprof1.1.tcl                                                      #
 # Stand    : 12.10.2004                                                           #
 # Zweck    : Einlesen einer Konfigurationsdatei über einen sicheren Slave-Inter-  #
 #            preter (SandBox); Rückgabe der Schlüssel/Werte als Liste             #
 # Autor    : M.Hoffmann                                                           #
 # Weiteres : Für diverse Pakete erforderlich (FehlerDB, SW-Lib, ToDo, MsgPop32).  #
 # Historie :                                                                      #
 # 18.10.03 v1.0: erste Version                                                    #
 # 12.10.04 v1.1: wahlweise Variablenersetzung (Vorsicht: standardmässig AN);      #
 # 13.10.04        neue Prozeduren ::repenv und ::envvar; Bugfixes.                #
 ###################################################################################

 package provide readprof 1.1
 namespace eval readprof {}

 #----------------------------------------------------------------------------------
 # prof - Dateiname für 'auszuführende' Konfigdatei
 # cmds - In der Konfigdatei erlaubte 'Kommandos' als Liste aus je {cmdName defVal}
 # Rück - cmdName Value cmdName Value [...] _errorMsg <rc> (wenn <rc> leer, ok)
 #
 proc readprof::readprof1 {prof cmds {substEnv 1}} {
      catch {
         set id [interp create -safe]; # Safe-Interpreter anlegen und absichern!
         interp eval $id {
                foreach cmd [info commands] {
                        if {$cmd != {rename} && $cmd != {if}} {
                           rename $cmd {}
                        }
                }
                rename if {}; rename rename {}
         }
         # Defaults im Array ablegen (Fehler bei 'falschen' cmds=ArrayKeys denkbar!)
         array set temp $cmds
         # indirektes Setzen über Proc, da SET nicht mehrere args verträgt
         proc set$id {key args} {
              upvar 1 temp     myArr
              upvar 1 substEnv sEnv
              set myArr($key) [join $args]
              if {$sEnv} {
                 # v1.1: auf Wunsch %EnvVar%s auflösen
                 set myArr($key) [readprof::repenv $myArr($key)]
              }
         }
         # Aliasnamen im Slave einrichten und auf setproc mappen
         foreach {cmd default} $cmds {
                 interp alias $id $cmd {} readprof::set$id $cmd; # arg [...]
         }
         # `Ausführen` der Konfigdatei
         $id invokehidden source $prof
      } rc
      catch {
         # Bugfix v1.1: IMMER aufräumen, auch nach Abbruch! D.h. extra CATCHen:
         interp delete $id
         rename set$id {}
      }
      # durch folgende Anweisung ist `temp` in jedem Falle definiert!
      set temp(_errorMsg) $rc; # Profname,-Datum,-Grösse;_errorRc usw. denkbar!
      return [array get temp]
 }

 #----------------------------------------------------------------------------------
 # Holt eine EINZELNE VARIABLE aus der Umgebung (wird INTERN benutzt). Gibt es die
 # Variable nicht, wird gemaess DOS/Windows-Verhalten ein LEERSTRING zurückgegeben.
 # envvar - Umgebungsvariablen-Name.
 # Rück   - Wert.
 #
 proc readprof::envvar {var} {
      set var [string trim $var %]; # eigentlich nur ein % vorn und hinten!
      if {[info exists ::env($var)]} {
         return $::env($var)
      } else {
         return ""
      }
 }

 #----------------------------------------------------------------------------------
 # Ersetzt in einer Zeichenkette %Vars% durch Werte (wird ggf. von readprof benutzt,
 # kann aber auch unabhängig von jedem externen Programm genutzt werden)
 # args - Zeichenkette, die %Variablen%-Referenzen enthalten kann
 # Rück - Zeichenkette mit aufgelösten Variablen-Referenzen; existiert eine %Var%
 #         nicht, wird sie durch Leerstring ersetzt (entspricht OS-.BATch-Logik)
 # ACHTUNG: Wegen subst-Erfordernis (regsub ersetzt nur eine Ebene) prinzipiell
 #  unsicher, daher über safe-Slave!
 #
 proc readprof::repenv {args} {
      set id [interp create -safe]; # Safe-Interpreter anlegen und absichern!
      interp eval $id {
             foreach cmd [info commands] {
                     if {$cmd != {rename} && $cmd != {if} && $cmd != {subst}} {
                        rename $cmd {}
                     }
             }
             rename if {}; rename rename {}
      }
      interp hide  $id subst; # auch subst selbst von aussen verstecken!
      interp alias $id __env {} readprof::envvar; # Umweg zum Lesen von env, denn
      # subSpec {$::env([string trim "&" %])} geht nicht, da im Slave kein env()!
      # Achtung: exp berücksichtigt nicht den denkbaren Sonderfall env(%name%)!
      regsub -nocase -all {%[^ %]{1}[^%]*%} $args {[__env &]} tmp
      # catch {$id invokehidden [list subst $tmp]} tmp; # neu: CATCH!
      catch {$id invokehidden subst -nobackslashes -novariables $tmp} tmp; # neu: CATCH!
      interp delete $id
      return $tmp
 }

 #==================================================================================