I use this module to read in program options which change not so often. The general mechanism is: The configuration file, called profile, consists of one or more lines in the format keyword value. Which profile to use and which keywords are valid and how the defaults are, is specified at runtime when calling readprof::readprof1. keywords are implemented as commands/procs in a safe-slave-interpreter. All other commands are not available for security reasons. By default, values can contain strings like %this%. %this% references an environment var named this and is replaced with the value of this var. To suppress these feature, readprof1 must be called with 0 as the last arg.
The following needs translation and documentation ;-)
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 https://wiki.tcl-lang.org/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 ::}; # https://wiki.tcl-lang.org/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.tcl
Result 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