ad_library { ADP to Tcl Compiler for the ArsDigita Templating System, @author Karl Goldstein @author Stanislav Freidin @author Jon Salz @cvs-id $Id: parse-procs.tcl,v 1.65.2.6 2020/07/03 07:27:29 gustafn Exp $ } # Based on the original ADP to Tcl compiler by Jon Salz (jsalz@mit.edu) # Copyright (C) 1999-2000 ArsDigita Corporation # This is free software distributed under the terms of the GNU Public # License. Full text of the license is available from the GNU Project: # http://www.fsf.org/copyleft/gpl.html namespace eval template {} ad_proc -public template::adp_include { {-uplevel 1} src varlist } { return the output of a Tcl/ADP pair as a string. adp_level is set to the calling procedure so that pass by reference works. and example of using this is in the search indexer for various content types:
bookshelf::book::get -book_id $book_id -array bookdata set body [template::adp_include /packages/bookshelf/lib/one-book \ [list &book "bookdata" base $base style feed]]The [list &book "bookdata" ...] tells adp_include to pass the book array by reference to the adp include, where it is referred to via @book.field@. @param uplevel how far up the stack should the adp_level be set to (default is the calling procedures level) @param src should be the path to the Tcl/ADP pair relative to the server root, as with the src attribute to the include tag. @param varlist a list of {key value key value ... } varlist can also be &var foo for things passed by reference (arrays and multirows) @return the string generated by the Tcl/ADP pair. @author Jeff Davis davis@xarg.net @creation-date 2004-06-02 @see template::adp_parse } { # set the stack frame at which the template is being parsed so that # other procedures can reference variables cleanly lappend ::template::parse_level [expr {[info level] - $uplevel}] set __adp_out [template::adp_parse [template::util::url_to_file $src] $varlist] # pop off parse level template::util::lpop ::template::parse_level return $__adp_out } ad_proc -private template::adp_parse { __adp_stub __args } { Execute procedures to prepare data sources and then to output template. Assumes adp_level is set on entry. in general the public version template::adp_include should be used for generating strings from adp files. @param __adp_stub The root (without the file extension) of the absolute path to the template and associated code. @param __args One list containing any number of key-value pairs passed to an included template from its container. All data sources may be passed by reference. @see template::adp_include } { # declare any variables passed in to an include or master # TODO: call adp_set_vars instead. foreach {__key __value} $__args { if {[string match "&*" $__key]} { # "&" triggers call by reference if {"&" ne $__key } { set __name [string range $__key 1 end] } else { set __name $__value } upvar \#[adp_level] $__value $__name \ $__value:rowcount $__name:rowcount \ $__value:columns $__name:columns # upvar :rowcount and :columns just in case it is a multirow if { [info exists $__name:rowcount] } { for { set __i 0 } { $__i <= [set $__name:rowcount] } { incr __i } { upvar \#[adp_level] $__value:$__i $__name:$__i } } } else { # not "&" => normal arg (no reference) set $__key $__value } } # set the stack frame at which the template is being parsed so that # other procedures can reference variables cleanly lappend ::template::parse_level [info level] # execute the code to prepare the data sources for a template set return_code [catch { set found_script_p [adp_prepare] # if we get here, adp_prepare ran without throwing an error. # initialize the ADP output set __adp_output "" set mime_type [get_mime_type] set template_extension [get_mime_template_extension $mime_type] # generate ADP output if a template exists (otherwise assume plain Tcl page) set templated_p 0 if { [ad_conn locale] ne "" && [file exists "$__adp_stub.[ad_conn locale].$template_extension"]} { # it's a localized version of a templated page set templated_p 1 append __adp_stub ".[ad_conn locale]" } elseif {[file exists "$__adp_stub.$template_extension"]} { # it's a regular templated page set templated_p 1 } if { [info commands ::ds_page_fragment_cache_enabled_p] ne "" && [::ds_enabled_p] && [::ds_page_fragment_cache_enabled_p] && [::ds_collection_enabled_p] } { ns_cache get ds_page_bits [ad_conn request] template_list lappend template_list $__adp_stub.$template_extension ns_cache set ds_page_bits [ad_conn request] $template_list } if { $templated_p } { # ensure that template output procedure exists and is up-to-date template::adp_init $template_extension $__adp_stub # get result of template output procedure into __adp_output, and properties into __adp_properties template::code::${template_extension}::$__adp_stub # JCD: Lets keep a copy of all the page fragments! WooHoo. if { [info commands ::ds_page_fragment_cache_enabled_p] ne "" && [::ds_enabled_p] && [::ds_page_fragment_cache_enabled_p] && [::ds_collection_enabled_p] } { ns_cache set ds_page_bits "[ad_conn request]:$__adp_stub.$template_extension" $__adp_output } # call the master template if one has been defined if { [info exists __adp_master] } { # pass properties on to master template set __adp_output [template::adp_parse $__adp_master \ [concat [list __adp_slave $__adp_output] [array get __adp_properties]]] } } else { # no template; found_script_p tells us if adp_prepare at least found a script. if { !$found_script_p } { # No template. Perhaps there is an HTML file. if { [file exists $__adp_stub.html] } { ns_log debug "getting output from ${__adp_stub}.html" set __adp_output [template::util::read_file "${__adp_stub}.html"] } elseif { [file exists $__adp_stub.htm] } { ns_log debug "getting output from ${__adp_stub}.htm" set __adp_output [template::util::read_file "${__adp_stub}.htm"] } else { error "No script or template found for page '$__adp_stub'" } } } return $__adp_output ; # empty in non-templated page } return_value] set s_errorInfo $::errorInfo set s_errorCode $::errorCode # Always pop off the parse_level no matter how we exit template::util::lpop ::template::parse_level switch -- $return_code { 0 - 2 { # CODE executed without a non-local exit -- return what it # evaluated to. return $return_value } 1 { # Error return -code error -errorinfo $s_errorInfo -errorcode $s_errorCode $return_value } default { if {$return_value eq "ADP_ABORT"} { # return without rendering any HTML if the code aborts return "" } else { return -code $return_code $return_value } } } } ad_proc -private template::adp_set_vars {} { Set variables passes from a container template, including onerow and multirow data sources. This code must be executed in the same stack frame as adp_parse, but is in a separate proc to improve code readability. } { uplevel { set __adp_level [adp_level 2] foreach {__adp_key __adp_value} $args { set __adp_expr {^@([[:alnum:]_]+)\.\*@$} if { [regexp $__adp_expr $__adp_value __adp_x __adp_name] } { upvar #$__adp_level $__adp_name $__adp_key if { ! [array exists $__adp_key] } { upvar #$__adp_level $__adp_name:rowcount $__adp_key:rowcount if { [info exists $__adp_key:rowcount] } { set size [set $__adp_key:rowcount] for { set i 1 } { $i <= [set $__adp_key:rowcount] } { incr i } { upvar #$__adp_level $__adp_name:$i $__adp_key:$i } } } } else { set $__adp_key $__adp_value } } } } # Terminates processing of a template and throws away all output. ad_proc -public template::adp_abort {} { Terminates processing of a template and throws away all output. } { error ADP_ABORT } ad_proc -public template::adp_eval { coderef } { Evaluates a chunk of compiled template code in the calling stack frame. The resulting output is placed in __adp_output in the calling frame, and also returned for convenience. @return The output produced by the compiled template code. } { upvar $coderef code __adp_output output lappend ::template::parse_level [expr {[info level]-1}] uplevel $code template::util::lpop ::template::parse_level return $output } ad_proc -public template::adp_level { { up "" } } { Get the stack frame level at which the template is being evaluated. This is used extensively for obtaining references to data sources, as well template objects such as forms and wizards @param up A relative reference to the "parse level" of interest. Useful in the context of an included template to reach into the stack frame in which the container template is being parsed, for accessing data sources or other objects. The default is the highest parse level. @return A number, as returned by [info level], representing the stack frame in which a template is being parsed. } { set result "" # when serving a page, this variable is always defined. # but we need to check it for the case of isolated compilation if { [info exists ::template::parse_level] } { if {$up eq ""} { set result [lindex $::template::parse_level end] } else { set result [lindex $::template::parse_level [llength $::template::parse_level]-$up] } } return $result } ad_proc -public template::adp_levels {} { @return all stack frame levels } { if { [info exists ::template::parse_level] } {return $::template::parse_level} return "" } ad_proc -private template::adp_prepare {} { Executes the code to prepare the data sources for a template. The code is executed in the stack frame of the calling procedure (adp_parse) so that variables are accessible when the compiled template code is executed. If the preparation code executes the set_file command, the procedure will recurse and execute the code for the next template as well. @return boolean (0 or 1): whether the (ultimate) script was found. } { uplevel { if { [file exists $__adp_stub.tcl] } { # ensure that data source preparation procedure exists and is up-to-date adp_init tcl $__adp_stub # remember the file_stub in case the procedure changes it set __adp_remember_stub $__adp_stub # execute data source preparation procedure code::tcl::$__adp_stub # propagate aborting if {[info exists ::request_aborted]} { ns_log warning "propagating abortion from $__adp_remember_stub.tcl\ (status [lindex $::request_aborted 0]): '[lindex $::request_aborted 1]')" unset ::request_aborted ad_script_abort #adp_abort return 0 } # if the file has changed then prepare again if { $__adp_stub ne $__adp_remember_stub } { adp_prepare; # propagate result up } { return 1 } } return 0 } } ad_proc -public template::set_file { path } { Set the path of the template to render. This is typically used to implement multiple "skins" on a common set of data sources. The initial code (which may be in a .tcl file not associated with a .adp file) sets up any number of data sources, and then calls set_file to specify the template to actually render. Any code associated with the specified template is executed in the same stack frame as the initial code, so that each "skin" may reference additional specific data or logic as necessary. @param path The root (sans file extension) of the absolute path to the next template to parse. } { set level [adp_level] upvar #$level __adp_stub file_stub set file_stub $path } ad_proc -private template::adp_init { type file_stub } { Ensures that both data source Tcl files and compiled ADP templates are wrapped in procedures in the current interpreter. Procedures are cached in byte code form in the interpreter, so this is more efficient than sourcing a Tcl file or parsing the template every time. Also checks the modification time on the source file to ensure that the procedure is up-to-date. @param type Either ADP (template) or Tcl (code) @param file_stub The root (sans file extension) of the absolute path to the .adp or .tcl file to source. } { # this will return the name of the proc if it exists set proc_name [info commands ::template::mtimes::${type}::$file_stub] set pkg_id [apm_package_id_from_key acs-templating] set refresh_cache [parameter::get -package_id $pkg_id -parameter RefreshCache -default "as needed"] if {$proc_name eq "" || $refresh_cache ne "never" } { set mtime [file mtime $file_stub.$type] if {$proc_name eq "" || $mtime != [$proc_name] || $refresh_cache eq "always"} { # either the procedure does not already exist or is not up-to-date switch -exact $type { tcl { set code [template::util::read_file $file_stub.tcl] } default { set code [adp_compile -file $file_stub.$type] } } # wrap the code for both types of files within an uplevel in # the declared procedure, so that data sources are set in the # same frame as the code that outputs the template. # Here we add profiling calls if developer support exists on the # system. if {[info commands ::ds_enabled_p] ne ""} { proc ::template::code::${type}::$file_stub {} "if {\[::ds_enabled_p\] && \[::ds_collection_enabled_p\] && \[::ds_profiling_enabled_p\]} { ds_profile start $file_stub.$type } uplevel { $code } if {\[::ds_enabled_p\] && \[::ds_collection_enabled_p\] &&\[::ds_profiling_enabled_p\]} { ds_profile stop $file_stub.$type }\n" } else { proc ::template::code::${type}::$file_stub {} " uplevel { $code }\n" } proc ::template::mtimes::${type}::$file_stub {} "return $mtime" } } } ad_proc -public template::expand_percentage_signs { message } { Expand variables marked with percentage signs in caller's scope. Some examples - if example and array(variable) has the values Erik and Oluf in the caller's scope - the following expansion will occur: Here is an %example% variable. -> Here is an Erik variable. Here is an %array.variable% for you -> Here is an Oluf for you @author Christian Hvid } { set remaining_message $message set formatted_message "" while { [regexp [lang::message::embedded_vars_regexp] $remaining_message match before_percent percent_match remaining_message] } { append formatted_message $before_percent if {$percent_match eq "%%"} { # A quoted percentage sign set substitution "%" } else { # An embedded variable # Remove any noquote instruction set quote_p 1 if { [regsub {;noquote} $percent_match {} substitution] } { # We removed a noquote instruction so don't quote set quote_p 0 } # Convert syntax to Tcl syntax: # It's either an array variable or a Tcl variable # array variables # TODO: ns_quotehtml # TODO: lang::util::localize regsub -all {[\]\[\{\}\"]\\$} $substitution {\\&} substitution if { [regexp {^%([[:alnum:]_]+)\.([[:alnum:]_]+)%$} $substitution match arr key] } { # the array key name is substitured by the Tcl parser s regsub -all {[\]\[\{\}\"]\\$} $key {\\&} key set command "set ${arr}(${key})" set substitution [uplevel $command] } if { [regexp {^%([[:alnum:]_:]+)%$} $substitution match var] } { set command "set $var" set substitution [uplevel $command] } if {$quote_p} { set substitution [ns_quotehtml $substitution] } } append formatted_message $substitution } append formatted_message $remaining_message return $formatted_message } ad_proc -public template::adp_compile { {-file ""} {-string ""} } { Converts an ADP template into a chunk of Tcl code. Caching this code avoids the need to reparse the ADP template with each request. @param file The filename of the source @param string string to be compiled @return The compiled code. Valid options are either -string or -file } { variable parse_list # initialize the compiled code set parse_list [list "set __adp_output {}; set __ad_conn_locale \[ad_conn locale\]"] if {$file ne "" && $string ne ""} { error "you must specify either -file or -string" } elseif {$file ne ""} { set chunk [template::util::read_file $file] } else { set chunk $string } # substitute <% ... %> blocks with registered tags so they can be handled # by our proc rather than evaluated. regsub -all {<%} $chunk {