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

  1. proc adp_parse {f} {
  2. set rf [file join [Doc_Root] $f]
  3. if {![info exists ::adp::${f}::lastmod]
  4. || [file mtime $rf] > [set ::adp::${f}::lastmod]} {
  5. catch {namespace delete ::adp::$f}
  6. namespace eval ::adp::$f {}
  7. set cns ::adp::${f}::code
  8. set rns ::adp::${f}::run
  9. namespace eval $cns {}
  10. namespace eval $rns {}
  11. set ::adp::${f}::lastmod [file mtime $rf]
  12. set sf [open $rf]
  13. set src [read $sf]
  14. close $sf
  15. set chunks {}
  16. set pos 0
  17. set ci 0
  18. while {$pos >= 0 && $pos < [string length $src]} {
  19. incr ci
  20. set cs [string first "<%" $src $pos]
  21. set ce [string first "%>" $src $pos]
  22. if {$cs >= 0} {
  23. lappend chunks [string range $src $pos [expr {$cs-1}]]
  24. } else {
  25. lappend chunks [string range $src $pos end]
  26. break;
  27. }
  28. if {$ce > 0} {
  29. set chunk [string trim [string range $src $cs $ce] {<>%}]
  30. if {[string match =* $chunk]} {
  31. set chunk "return [string range $chunk 1 end]"
  32. } else {
  33. set chunk "$chunk\nreturn"
  34. }
  35. set cn ${cns}::chunk_$ci
  36. proc $cn {} [namespace eval $rns [list namespace code $chunk]]
  37. lappend chunks $cn
  38. }
  39. set pos [expr {$ce+2}]
  40. }
  41. set ::adp::${f}::chunks $chunks
  42. }
  43. return [set ::adp::${f}::chunks]
  44. }
  45.  
  46. proc adp_eval {f} {
  47. set _d ""
  48. set ci 0
  49. set chunks [adp_parse $f]
  50. foreach {h t} $chunks {
  51. incr ci
  52. append _d $h
  53. if {$t == ""} break
  54. if {[catch $t err]} {
  55. puts stderr "error in chunk $ci: $err"
  56. } else {
  57. append _d $err
  58. }
  59. }
  60. return $_d
  61. }
  62.  
  63. proc Doc_application/x-tcl-adp {path suffix sock {interp {}}} {
  64. upvar #0 Httpd$sock data
  65.  
  66. # source .tml files as for templates
  67. foreach libfile [DocGetTemplates $sock $path] {
  68. if {[file exists $libfile]} {
  69. source $libfile
  70. }
  71. }
  72.  
  73. Httpd_ReturnData $sock text/html [adp_eval $suffix]
  74. }
  75.