Version 5 of Matthias Hoffmann - Tcl-Code-Snippets - Misc - Readprof

Updated 2006-04-12 09:38:26

Everything is not yet translated to english, which leads to ugly characters after a page-rebuild, which happened obviously. So I just copied the routine back into here from my sources.... But this should be fixed (metakit dump/load does not handle special characters as äöü correct!).


 ###################################################################################
 # Modul    : readprof1.2.tcl                                                      #
 # Stand    : 12.11.2005                                                           #
 # 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.                #
 # 12.11.05 v1.2: Bugfix: _errorMsg war ungleich "", obwohl alles ok               #
 ###################################################################################

 package provide readprof 1.2
 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
         set rc ""; # v1.2
      } 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
 }

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

Testroutine

 lappend auto_path .
 package require readprof



 array set settings [readprof::readprof1 $argv {
     test1 default1
     test2 default2
     test3 default3
 }]

 # [Kommandos] werden schon VOR dem Aufruf ausgewertet!
 set env(%fies%) "varname mit Prozenten"
 puts [readprof::repenv Dies ist Appdata: '%appdata%']
 puts [readprof::repenv Dies ist Appdata: '%appdata%' und das fiese: '%%fies%%']
 # Test: Einschmuggeln eines Kommandos (das einzig erlaubte):
 puts [readprof::repenv {Dies ist Appdata: '%appdata%' oder so: '[__env appdata]'}]
 # Test: Einschmuggeln eines Kommandos (ein andres):
 puts [readprof::repenv {Dies ist Appdata: '%appdata%' oder so: '[subst abcde]'}]
 # puts [readprof::repenv {Dies ist Appdata: '%appdata%' oder so: '[info commands]'}]
 puts ***********
 parray settings

Test .RC-File

 test1 Dies ist der Pfad: '%path%'
 test3 Dies '%appdata%' ist falsch: '%falsch%'
 test2 Ist dies möglich?: '*[info globals]*' Nein!

Example:

 package require readprof
 # preparing the available profile commands and defaults of a hypothetical profile
 array set info {
           tempDir      d:/temp
           runIntervall 5000
           notify       [email protected]
 }
 # reading the profile
 array set info [readprof::readprof1 profile.rc [array get info]]
 parray info; # will now return:

 tempDir -> c:/temp
 runIntervall -> 2000
 notify [email protected]

simple profile-file profile.rc

 tempDir c:/temp
 runIntervall 2000