Welcome, guest | Sign In | My Account | Store | Cart

This routine performs simple text templating using ASP style code embedding. Useful as Wizards for source code generation or generate html.

Tcl, 227 lines
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
#---------------------------------------------------------------------------
# 
# adp_compile --
#
# Parameters:
#     sourcetype -source|-filename
#     source 
# Returns:
#     Code to generate templated output
#
#---------------------------------------------------------------------------
proc adp_compile {sourcetype source} {

  # process parameters
  switch -exact -- $sourcetype {
    -source   { 
              set contents $source
              }

    -filename {
              
              set fileid [open $source r]
              set contents [read $fileid]
              close $fileid
              }
 
    default  { 
              return 
              }
  } 

  # really simple logic. 
  # 1. look for <%  %>
  # 2.   dump out contents preceeding <%
  # 3.   script contents preceeding %>
  # 4. repeat until run out of <% %> pairs
  # 5. dump contents after the last %> found.

  set outbuf {}

  set position 0
  set pstart [string first <% $contents $position]
  set pend   [string first %> $contents $pstart]

  while {[expr $pstart != -1 && $pend != -1 && $pstart < $pend]} {
     
      # Prevent script from adding unexpected blank lines to output:
      # if script is on a stand-alone line then 
      # don't add a newline to output
      set last_newline [string last \n $contents $pstart]
      zdebug "position=$position last_newline=$last_newline pstart=$pstart pend=$pend"
      if {[expr $last_newline != -1]} {
          set first_chars [string range $contents $last_newline [expr $pstart-1]]
          set last_char [string index $contents [expr $pend + 2]]      
          if {[string equal $last_char \n] && [string is space $first_chars]} {
              #
              # Replace <% %> tags with spaces
              #
              set contents [string replace $contents $pstart [expr $pstart + 1] {  }]
              set contents [string replace $contents $pend   [expr $pend   + 1] {  }]
              set pstart $last_newline+1
              incr pend
          }
      }

      # dump out contents preceeding <%
      adp_dump [string range $contents $position [expr $pstart-1]]

      # script out contents within the <% %>
      adp_script [string range $contents [expr $pstart+2] [expr $pend-1]]

      # if the next character is \n chomp it
      #if {[string equal [string index $contents [expr $pend + 2]] \n]} {
      #   incr pend 1 
      #}

      # search again
      set position [expr $pend + 2]
      set pstart [string first <% $contents $position]
      set pend   [string first %> $contents $pstart]
     
  }

  # dump out contents after %>
  adp_dump [string range $contents [expr $position] end]

  # insert pre and post conditions
  set precond "set __adp_output {}\n"
  set postcond ""
  set final ""
  append final $precond
  append final $outbuf
  append final $postcond
  return $final
}

#---------------------------------------------------------------------------
#
# adp_dump --
#
# Remarks:
#    generate code to output text to the output buffer
#
#---------------------------------------------------------------------------
proc adp_dump { text } {
  upvar outbuf outbuf

  # Protect double quotes, dollar signs, escapes
  regsub -all {[\]\[""\\$]} $text {\\&} quoted
  append outbuf "append __adp_output \"$quoted\""
}

#---------------------------------------------------------------------------
# 
# adp_eval --
#
# Parameters:
#     sourcetype -source|-filename
#     source 
#
# Returns:
#     Templated output
#
#---------------------------------------------------------------------------

proc adp_eval { sourcetype source } {

  set code [adp_compile $sourcetype $source]
  return [eval $code] 
}

#---------------------------------------------------------------------------
#
# adp_script --
#
# Remarks:
#   if <%= > tag, print the contents
#   else, dumps as tcl source
#
#---------------------------------------------------------------------------

proc adp_script { script } {

  # Protect double quotes, dollar signs, escapes
  # regsub -all {[\]\[""\\$]} $text {\\&} quoted

  upvar outbuf outbuf
  if {[string equal [string index $script 0] =]} {
     #
     # first character is equal sign:
     # handle the remainder as an expression
     #
     append outbuf "\n"
     set script [string range $script 1 end]
     append outbuf "append __adp_output $script"
     append outbuf "\n"
  } else {
     append outbuf "\n"
     append outbuf "  $script"
     append outbuf "\n"
  }
}

proc zdebug text { 
 #puts $text
}

#---------------------------------------------------------------------------
# 
#  test --
#
#  Remarks:
#     demonstration
#
#---------------------------------------------------------------------------

proc test {} {

  # If you have testhello.adp in current directory
  # set code [adp_compile -filename testhello.adp]
 
  set source [testprepare]
  set code [adp_compile -source $source]

  puts "--------------------------------------------"
  puts "The source"
  puts "--------------------------------------------"
  puts $source
  puts "--------------------------------------------"
  puts "The code generated"
  puts "--------------------------------------------"
  puts $code
  puts "--------------------------------------------"
  puts  "The result"
  puts "--------------------------------------------"
  eval $code
  puts $__adp_output
}

proc testprepare {} {

  return "
<html>
  <body>
    <h2>Hello World</h2>
       <% set name \"Peter\" %>
       Hello <%=\$name%> <br>
       Goodbye <%=\$name%>

       <% set mylist \[list Tom Dick Harry\]
          foreach name \$mylist {%>
          <p>Welcome <%=\$name%></p>
       <% }%>

       <a href=\"logoff\">log off</a>

  </body>
</html> "
}

# 1. Straight test --
#  test

# 2. Test for incorporation into subroutine
#  set source [testprepare]
#  set code [adp_compile -source $source]
#  return [eval $code]

I was trying to pull out the templating routine from acs and it turns out to be quite dependent on the aol server code.

Run the test routine to see how it works.

2 comments

andreas kupries 20 years, 5 months ago  # | flag

Performance gain by wrapping the generated scripts into a proc. Note that it is possible to get more performance out of this if the result of adp_compile is wrapped into a proc and later on only the proc is used. The performance gain comes from the fact the procedure is byte-compiled and thus faster than just doing an eval.

David Bigelow 20 years, 4 months ago  # | flag

Flexibility Gain? Would it be faster, and more flexible, to process the Tcl code external to the page and then merge the results into an HTML template ultimately streaming results to the HTTP request? It seems that a simple Tag in the HTML page could be easily replaced using "regsub" to swap of the Tag with the computed Tcl results (e.g., values, new HTML code, etc..). This would require a File-I/O to get the HTML template, but may be easier to edit and manage for larger ASP-Type applications. Does anyone have concerns with execution or performance using this method?

Created by Chui Tey on Mon, 30 Jul 2001 (MIT)
Tcl recipes (162)
Chui Tey's recipes (4)

Required Modules

  • (none specified)

Other Information and Tasks