Posted to tcl by evilotto at Tue Nov 04 21:58:08 GMT 2014view pretty

proc adp_parse {f} {
    set rf [file join [Doc_Root] $f]
    if {![info exists ::adp::${f}::lastmod] 
            || [file mtime $rf] > [set ::adp::${f}::lastmod]} {
        catch {namespace delete ::adp::$f}
        namespace eval ::adp::$f {}
        set cns ::adp::${f}::code
        set rns ::adp::${f}::run
        namespace eval $cns {}
        namespace eval $rns {}
        set ::adp::${f}::lastmod [file mtime $rf]
        set sf [open $rf]
        set src [read $sf]
        close $sf
        set chunks {}
        set pos 0
        set ci 0
        while {$pos >= 0 && $pos < [string length $src]} {
            incr ci
            set cs [string first "<%" $src $pos]
            set ce [string first "%>" $src $pos]
            if {$cs >= 0} {
                lappend chunks [string range $src $pos [expr {$cs-1}]]
            } else {
                lappend chunks [string range $src $pos end]
                break;
            }
            if {$ce > 0} {
                set chunk [string trim [string range $src $cs $ce] {<>%}]
                if {[string match =* $chunk]} {
                    set chunk "return [string range $chunk 1 end]"
                } else {
                    set chunk "$chunk\nreturn"
                }
                set cn ${cns}::chunk_$ci 
                proc $cn {} [namespace eval $rns [list namespace code $chunk]]
                lappend chunks $cn
            }
            set pos [expr {$ce+2}]
        }
        set ::adp::${f}::chunks $chunks
    }
    return [set ::adp::${f}::chunks] 
}

proc adp_eval {f} {
    set _d ""
    set ci 0
    set chunks [adp_parse $f]
    foreach {h t} $chunks {
        incr ci
        append _d $h
        if {$t == ""} break
        if {[catch $t err]} {
            puts stderr "error in chunk $ci: $err"
        } else {
            append _d $err
        }
    }
    return $_d
}

proc Doc_application/x-tcl-adp {path suffix sock {interp {}}} {
    upvar #0 Httpd$sock data

    # source .tml files as for templates
    foreach libfile [DocGetTemplates $sock $path] {
        if {[file exists $libfile]} {
            source $libfile
        }
    }

    Httpd_ReturnData $sock text/html [adp_eval $suffix]
}