74 lines
2.4 KiB
Tcl
Executable File
74 lines
2.4 KiB
Tcl
Executable File
#!/usr/bin/tclsh
|
|
#----------------------------------------------------------------------
|
|
# This is a Tcl template processor in the style of JSP tags. Unmarked
|
|
# text is left alone. But there is special markup:
|
|
# <% script %> execute Tcl script and output result
|
|
# <%=var%> print The Tcl variable var
|
|
# <%! script%> execute the script and print nothing
|
|
#
|
|
# copyright: GPL
|
|
#
|
|
# Mark Koennecke, November 2006
|
|
#----------------------------------------------------------------------
|
|
proc loadTemplate {input} {
|
|
return [read $input]
|
|
}
|
|
#---------------------------------------------------------------------
|
|
proc processScript {script} {
|
|
set startChar [string index $script 0]
|
|
if {[string equal $startChar =] == 1 } {
|
|
set varName [string trim [string range $script 1 end]]
|
|
set cmd [format "return \$%s" $varName]
|
|
return [uplevel #0 $cmd]
|
|
} elseif {[string equal $startChar !] == 1} {
|
|
set script [string range $script 1 end]
|
|
uplevel #0 $script
|
|
} else {
|
|
return [uplevel #0 $script]
|
|
}
|
|
return ""
|
|
}
|
|
#----------------------------------------------------------------------
|
|
# process The template: read template from input,
|
|
# write to output channel
|
|
#----------------------------------------------------------------------
|
|
proc processTemplate {input output} {
|
|
set template [loadTemplate $input]
|
|
set current 0
|
|
set start [string first "<%" $template]
|
|
set end [string first "%>" $template $start]
|
|
while {$start >= 0} {
|
|
if {$end < 0} {
|
|
error "Found start tag but no end in $template"
|
|
}
|
|
puts -nonewline $output [string range $template $current \
|
|
[expr $start -1]]
|
|
set script [string range $template [expr $start +2] \
|
|
[expr $end -1]]
|
|
set txt [processScript $script]
|
|
if {[string length $txt] >= 1} {
|
|
puts -nonewline $output $txt
|
|
}
|
|
set template [string range $template [expr $end +2] end]
|
|
set start [string first "<%" $template]
|
|
set end [string first "%>" $template $start]
|
|
|
|
}
|
|
puts -nonewline $output $template
|
|
}
|
|
#================ MAIN ================================================
|
|
if {$argc < 2} {
|
|
puts stdout "Usage:\n\ttjxp infile outfile"
|
|
puts stdout "\t Outfile can be - for stdout"
|
|
exit 1
|
|
}
|
|
set in [open [lindex $argv 0] r]
|
|
set outfile [lindex $argv 1]
|
|
if {[string equal [string trim $outfile] -] == 1} {
|
|
set out stdout
|
|
} else {
|
|
set out [open $outfile w]
|
|
}
|
|
processTemplate $in $out
|
|
exit 0
|