JMN 2007-10-24, Please also consider adding a note about the type of license your code falls under. (If not on each code page, then a statement under your Tcl'ers page) While I think the generally presumed default for wiki code is BSD/MIT style, explicitness is important for some. Thanks for sharing! MHo: Hm. I haven't really thought about licensing aspects yet... I think, the short snippet posted here can be used by you in any way you like. If you use it in a million seller product, though, it would be fair to hand over about $ 100.000 to me... smile ;-)
###################################################################################
# Modul : readprof1.6.tcl #
# Stand : 18.09.2008 #
# 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 #
# 03.07.07 v1.3: Angabe MEHRERER PROFILE möglich; Abarbeitung in Reihenfolge #
# 21.09.07 v1.4: readprof::repenv verwendet nicht mehr args (Quoting-Probleme) #
# ACHTUNG: Mögliche Inkompatibilität! #
# 18.09.08 v1.5: Neue Variable _rcFiles enthält Namen und Returncodes #
# 19.09.08 v1.6: Interpreter eleganter leeren, siehe http://wiki.tcl.tk/21319 #
###################################################################################
package provide readprof 1.6
namespace eval readprof {}
#----------------------------------------------------------------------------------
# prof - Dateiname(n) für 'auszuführende' Konfigdatei(en)
# 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!
$id eval {namespace delete ::}; # http://wiki.tcl.tk/21319
# Löschen cmds war bis v1.5 analog zu readprof::repenv realisiert
# 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(en)
# Einzeln CATCHen, damit nicht eine kaputte Datei das Parsen aller verhindert
foreach prf $prof {
catch {$id invokehidden source $prf} prc
lappend temp(_rcFiles) $prf $prc
}
set rc ""
} 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!
return [expr { [info exists ::env($var)] ? $::env($var) : "" }]
}
#----------------------------------------------------------------------------------
# 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 {str} {
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 {}
}
# Trick von oben klappt hier nicht, da 'subst' erhalten bleiben muss!
interp hide $id subst; # subst selbst von aussen allerdings 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}[^%]*%} $str {[__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
}
#==================================================================================Simple Tests in "readprof_test.tcl":
set auto_path [linsert $auto_path 0 .]
package require readprof 1.4
array set settings [readprof::readprof1 ./test.rc {
test1 default1
test2 default2
test3 default3
test4 default4
test5 default5
}]
parray settingsTest .RC-File "test.rc":
test1 Dies ist eine Angabe über mehrere \
Zeilen
test2 {Und dies ebenfalls,
nur anders dargestellt.}
test3 "Und dies ebenfalls,
nur anders dargestellt."
test4 "Und dies ebenfalls,\n
nur anders dargestellt."
test5 "Und dies ebenfalls,\
nur anders dargestellt."Executing the example:
tclsh readprof_test.tclResult should look like:
settings(_errorMsg) =
settings(test1) = Dies ist eine Angabe über mehrere Zeilen
settings(test2) = Und dies ebenfalls,
nur anders dargestellt.
settings(test3) = Und dies ebenfalls,
nur anders dargestellt.
settings(test4) = Und dies ebenfalls,
nur anders dargestellt.
settings(test5) = Und dies ebenfalls, nur anders dargestellt.Another 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 for the above example:tempDir c:/temp runIntervall 2000
