# stml.tcl
#
#        Per-session interpreter template substitution for tclhttpd
#
# CMcC 20040929 - Changed to make use of generic Cache module

DirList_IndexFile index.{stml,tml,html,shtml,thtml,htm,subst}

# 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

Mtype_Add .stml application/x-tcl-session
Mtype_Add .sstml application/x-tcl-safe-session

proc Doc_application/x-tcl-safe-session {path suffix sock} {
    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

    # return a cached version, if possible
    if {[Cache_Fetch $path]} {
        return
    }

    # 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'
    set type [string trimleft [file extension [file rootname $suffix]] .]
    if {$type == ""} {
        set type stml
    }

    # 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 {*}$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} content eo]

    # Process the template itself
    if {!$code} {
        set code [catch {Subst_File $path $interp} content eo]
    }

    # Save return cookies, if any
    Cookie_Save $sock

    # process errors now
    if {$code} {
        # delete the per-page session data
        interp eval $interp $cleanup

        # pass errors up - specifically Redirect return code
        return -options $eo $content
    }

    # 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
    }

    # delete the per-page session data
    interp eval $interp $cleanup

    # Cache the result
    if {![interp eval $interp {set page(dynamic)}]} {
        # this page is cacheable
        Cache_Store $sock $path $content $ctype
    } else {
        # return the result - filters will be applied en route
        return [Httpd_ReturnData $sock $ctype $content]
    }
}

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<!-- [package require html] -->
<html>
  <head>
    <title>Test session templates</title>
  </head>

  <body>
    <h1>Test session templates</h1>
    <h2>Session: [session]</h2>
    <p>type: [value type]</p>
    <p>interp:[value interp]</p>
    <p>start: [value start]</p>
    <p>current: [value current]</p>
    <p>count: [value count]</p>
    <p>[::html::tableFromArray data]</p>
    <p>[::html::tableFromArray query]</p>
    <p>[::html::tableFromArray page]</p>

    <hr>
    <address><a href="mailto:colin at sharedtech dot dyndns dot org">Colin McCormack</a></address>
<!-- Created: Thu Sep 16 08:53:25 EST 2004 -->
<!-- hhmts start -->
Last modified: Thu Sep 16 09:14:32 EST 2004
<!-- hhmts end -->
  </body>
</html>

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References