This code implements a .stml file type, permitting per-session template expansion.
----
Within a session template, you get a few built-in commands:
''save'' - saves all variables and arrays within session
''exit'' - utterly destroys the session and any persistent data
''dynamic'' - makes this page's generation dynamic (default)
''cache'' - causes this page to be cached.
''value'' - get session variable value (values pertaining to session management)
''group'' - get value pertaining to this session 'group'
''session'' - get session id
''sequence'' - get session sequence (for strictly sequenced sessions)
You also get some arrays (these don't persist):
''data'' - per-socket data for this transaction
''page'' - some page related data
''query'' - query data encoded in URL
Additionally, any arrays or variables you create in the .stml code will persist if you have [[save]]d the session.
----
custom/stml.tcl:
# Alternative to templating
# Files with a .stml suffix or .sstml are templated and cached as with .tml files
# Template evaluation occurs within a cookie-session (a safe cookie session, for .ssmtl)
# Cookie session state can persist in file by calling Session_Save
array set Stml {
type stml
extension .stml
sextension .sstml
}
Mtype_Add $Stml(extension) application/x-tcl-session
Mtype_Add $Stml(sextension) application/x-tcl-safe-session
proc Doc_application/x-tcl-safe-session {path suffix sock {safe 1}} {
return [Doc_application/x-tcl-session $path $suffix $sock 1]
}
proc Doc_application/x-tcl-session {path suffix sock {safe 0}} {
upvar #0 Httpd$sock data
global Stml
# handle cached generated files
if {[file exists ${path}_cache] && ([file mtime $path] <= [file mtime ${path}_cache])} {
# file exists ... return it
set fd [open ${path}_cache r]
set ctype [gets $fd] ;# get the stored mime type
set html [read $fd] ;# get the generated content
close $fd
return [Httpd_ReturnData $sock $ctype $html]
}
# fetch query
array set query [list session new] ;# session id to create a new session
array set query [Url_DecodeQueryOnly $data(query)]
# decode session type from file names
# files like x.type.stml will create a session of type, default 'stml'
if {[set rname [file rootname $suffix]] eq [set type [file extension $rname]]} {
set type $Stml(type) ;# there's no user-supplied type - use the default
}
# create or restore a cookie session
set session_error ""
set session [Session_Cookie [array get query session*] $type session_error $safe]
if {[string match Session:* $session_error]} {
# somehow our cookie and our session are out of whack
Session_Destroy $session ;# forget the session
Session_CookieDestroy $type ;# destroy the session cookies
Redirect_To $data(uri) ;# reload to get the new cookies
return ;# redundant - Redirect_To throws an error
}
set query(session) $session
# now we have a viable session with an interpreter
upvar #0 Session:$session state
set interp $state(interp)
if {[interp alias $interp exit] == ""} {
# create an 'exit' command
interp alias $interp exit {} Session_Destroy $session
}
if {[interp alias $interp save] == ""} {
# create a 'save' command
interp alias $interp save {} Session_Save $session
}
interp alias $interp cache $interp set page(dynamic) 0
interp alias $interp dynamic $interp set page(dynamic) 1
# generate interpreter script to source .tml files from the root downward.
global Template
set libs [Doc_GetPath $sock $path]
foreach libdir $libs {
set libfile [file join $libdir $Template(tmlExt)]
if {[file exists $libfile]} {
append "script source $libfile" \n
}
}
# generate interpreter initialization script
append script [subst {
catch {unset page}
catch {unset query}
catch {unset data}
array set page {
url $data(url)
dynamic 1
directory [file join {expand}$libs]
}
array set query [list [array get query]]
array set data [list [array get data]]
}]
set cleanup {
catch {unset page}
catch {unset query}
catch {unset data}
}
# initialize the interpreter
set code [catch {interp eval $interp $script} html eo]
# Process the template itself
if {!$code} {
set code [catch {Subst_File $path $interp} html eo]
}
# Save return cookies, if any
Cookie_Save $sock $interp
# process errors
if {$code} {
# delete the per-page session data
interp eval $interp $cleanup
# pass errors up - specifically Redirect return code
return -options $eo $html
}
# calculate mime type of return
if {[interp eval $interp {info exists data(contentType)}]} {
set ctype [interp eval $interp {set data(contentType)}] ;# set by a template
} else {
set ctype text/html
}
# process any filters
if {[info exists data(filter)]} {
while {[llength $data(filter)]} {
set cmd [lindex $data(filter) end]
set data(filter) [lrange $data(filter) 0 end-1]
catch {
set html [eval $cmd $sock [list $html]]
}
}
}
# Cache the result
if {![interp eval $interp {set page(dynamic)}]} {
catch {file delete -force ${path}_cache}
if {[catch {open ${path}_cache w} out eo]} {
Log $sock "stml" "no write permission"
Stderr "stml - $out - $eo"
} else {
puts $out $ctype ;# record the mime type
puts -nonewline $out $html
close $out
}
}
# delete the per-page session data
interp eval $interp $cleanup
# return the result
return [Httpd_ReturnData $sock $ctype $html]
}
----
Here's a test file: test.stml
Test session templates
Test session templates
Session: [session]
type: [value type]
interp:[value interp]
start: [value start]
current: [value current]
count: [value count]
[::html::tableFromArray data]
[::html::tableFromArray query]
[::html::tableFromArray page]
Colin McCormack
Last modified: Thu Sep 16 09:14:32 EST 2004
----
[[[Category TclHttpd]]]