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.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 (wenn 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 } #================================================================================== ---- '''Testroutine''' lappend auto_path . package require readprof 1.1 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! ----