Posted to tcl by evilotto at Tue Nov 04 21:58:08 GMT 2014view raw
- 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]
- }