Index: openacs-4/packages/acs-templating/tcl/util-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/util-procs.tcl,v diff -u -r1.30 -r1.31 --- openacs-4/packages/acs-templating/tcl/util-procs.tcl 1 Oct 2017 12:16:05 -0000 1.30 +++ openacs-4/packages/acs-templating/tcl/util-procs.tcl 19 Dec 2017 16:22:11 -0000 1.31 @@ -27,35 +27,35 @@ begins with a dash. This particularly problematic for negative numbers. } { - upvar opts opts + upvar opts opts - set size [llength $argv] + set size [llength $argv] - # append a switch break - lappend argv "-*" + # append a switch break + lappend argv "-*" - for { set i 0 } { $i < $size } {} { - - # Get a switch - set opt [string trimleft [lindex $argv $i] -] + for { set i 0 } { $i < $size } {} { - # Get the next arg - set next [lindex $argv [incr i]] + # Get a switch + set opt [string trimleft [lindex $argv $i] -] - if { [string index $next 0] ne "-" - || ![regexp {[a-zA-Z*]} [string index $next 1] match] } { - - # the next arg was not a switch so assume it is a parameter - set opts($opt) $next - # advance the counter past the switch parameter - incr i + # Get the next arg + set next [lindex $argv [incr i]] - } else { - - # the next arg was a switch so just use 1 as the parameter - set opts($opt) 1 + if { [string index $next 0] ne "-" + || ![regexp {[a-zA-Z*]} [string index $next 1] match] } { + + # the next arg was not a switch so assume it is a parameter + set opts($opt) $next + # advance the counter past the switch parameter + incr i + + } else { + + # the next arg was a switch so just use 1 as the parameter + set opts($opt) 1 + } } - } } # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * @@ -66,19 +66,19 @@ Converts an array to an option list @param array_ref The name of the array in the calling frame containing - option-value pairs. Defaults to "opts". + option-value pairs. Defaults to "opts". @return A list of option-value pairs suitable for appending to a command. } { - upvar $array_ref arr + upvar $array_ref arr - set ret [list] - foreach {key value} [array get arr] { - lappend ret "-$key" $value - } - - return $ret + set ret [list] + foreach {key value} [array get arr] { + lappend ret "-$key" $value + } + + return $ret } ad_proc -public template::util::is_nil { ref } { @@ -87,25 +87,25 @@ @param ref The name of a variable to test in the calling frame. @return 1 if the variable either not exist or is an empty string. 0 if - the variable is either an array reference or a non-empty scalar. + the variable is either an array reference or a non-empty scalar. } { - upvar $ref var + upvar $ref var - # check for an array as well - if { [array exists var] } { return 0 } + # check for an array as well + if { [array exists var] } { return 0 } - if { [info exists var] && $var ne {} } { - set result 0 - } else { - set result 1 - } - return $result + if { [info exists var] && $var ne {} } { + set result 0 + } else { + set result 1 + } + return $result } ad_proc -public template::util::is_unique { table columns values } { Queries a database table for the existence of a particular row. - Useful for validating form input to reduce the possibility of + Useful for validating form input to reduce the possibility of unique constraint violations. @param table The name of a database table. @@ -115,28 +115,28 @@ @return 1 if the row exists, 0 if not } { - set query "select count(*) from $table where " + set query "select count(*) from $table where " - for { set i 0 } { $i < [llength $columns] } { incr i } { - - set value [ns_dbquotevalue [lindex $values $i]] - lappend conditions "[lindex $columns $i] = $value" - } + for { set i 0 } { $i < [llength $columns] } { incr i } { - append query [join $conditions " and "] + set value [ns_dbquotevalue [lindex $values $i]] + lappend conditions "[lindex $columns $i] = $value" + } - set count [db_string get_count $query] + append query [join $conditions " and "] - return [expr {$count == 0}] + set count [db_string get_count $query] + + return [expr {$count == 0}] } ad_proc -public template::util::is_true { x } { interprets its argument as a boolean. @param x the value to test - @return 0 if the variable can be interpreted as false; - 1 for true if it can't. + @return 0 if the variable can be interpreted as false; + 1 for true if it can't. } { #expr {[string tolower $x] ni {0 f false n no off ""}} #ns_log notice "TRUE [expr {[string tolower $x] ni {0 f false n no off ""}}] [string is true -strict $x]" @@ -149,8 +149,8 @@ @param ref The name of a list in the calling frame on which to operate. } { - upvar $ref the_list - set the_list [lrange $the_list 0 end-1] + upvar $ref the_list + set the_list [lrange $the_list 0 end-1] } ad_proc -public template::util::lnest { listref value next args } { @@ -159,62 +159,62 @@ @param value Either a list or scalar value to store in the list. @param next A key value that determines the next node to - traverse outward in the data structure. + traverse outward in the data structure. @param args Subsequent nodes to traverse. } { - upvar $listref inlist - if { ! [info exists inlist] } { - set inlist [list] - } + upvar $listref inlist + if { ! [info exists inlist] } { + set inlist [list] + } - # inlist represents the top level of the data structure into which - # we are inserting. We need to turn the list into an array to determine - # which branch to follow next. + # inlist represents the top level of the data structure into which + # we are inserting. We need to turn the list into an array to determine + # which branch to follow next. - array set values $inlist - - # next determines the next branch to follow as we look for the proper - # location of the value. if the key is not found, create a new branch by - # adding an empty list to inlist + array set values $inlist - if { [info exists values($next)] } { - set next_list $values($next) - } else { - set next_list [list] - } + # next determines the next branch to follow as we look for the proper + # location of the value. if the key is not found, create a new branch by + # adding an empty list to inlist - # the number of additional arguments after next determines how many - # more branches or levels we need to traverse before reaching the actual - # insertion point into the data structure. + if { [info exists values($next)] } { + set next_list $values($next) + } else { + set next_list [list] + } - set remaining [llength $args] - if { $remaining == 0 } { + # the number of additional arguments after next determines how many + # more branches or levels we need to traverse before reaching the actual + # insertion point into the data structure. - # we have reached a leaf - lappend next_list $value + set remaining [llength $args] + if { $remaining == 0 } { - } elseif { $remaining == 1 } { + # we have reached a leaf + lappend next_list $value - # continue for one more step to the leaf - lnest next_list $value [lindex $args 0] + } elseif { $remaining == 1 } { - } else { + # continue for one more step to the leaf + lnest next_list $value [lindex $args 0] - # more branches to go. Call the procedure recursively starting with - # the current branch. + } else { - lnest next_list $value [lindex $args 0] [lrange $args 1 end] - } + # more branches to go. Call the procedure recursively starting with + # the current branch. - # At this point the branch has been updated. Update the branch in the - # array. + lnest next_list $value [lindex $args 0] [lrange $args 1 end] + } - set values($next) $next_list + # At this point the branch has been updated. Update the branch in the + # array. - # Update inlist. - - set inlist [array get values] + set values($next) $next_list + + # Update inlist. + + set inlist [array get values] } ad_proc -public template::util::set_to_list { set args } { @@ -228,17 +228,17 @@ @return A list in the form { key value key value key value ... } } { - set result [list] + set result [list] - for { set i 0 } { $i < [ns_set size $set] } { incr i } { + for { set i 0 } { $i < [ns_set size $set] } { incr i } { - set key [ns_set key $set $i] - if { $key in $args } { continue } + set key [ns_set key $set $i] + if { $key in $args } { continue } - lappend result $key [ns_set value $set $i] - } + lappend result $key [ns_set value $set $i] + } - return $result + return $result } ad_proc -public template::util::set_to_vars { set args } { @@ -248,21 +248,21 @@ @param args Any number of keys to declare as local variables. } { - if { [llength $args] == 0 } { + if { [llength $args] == 0 } { - for { set i 0 } { $i < [ns_set size $set] } { incr i } { - set key [ns_set key $set $i] - upvar $key value - set value [ns_set get $set $key] - } + for { set i 0 } { $i < [ns_set size $set] } { incr i } { + set key [ns_set key $set $i] + upvar $key value + set value [ns_set get $set $key] + } - } else { + } else { - foreach key $args { - upvar $key value - set value [ns_set get $set $key] + foreach key $args { + upvar $key value + set value [ns_set get $set $key] + } } - } } ad_proc -public template::util::array_to_vars { arrayname } { @@ -283,12 +283,12 @@ @param arrayname The name of an array in the calling frame. @param args Any number of local variables to include in the array } { - upvar $arrayname arr + upvar $arrayname arr - foreach var $args { - upvar $var value - set arr($var) $value - } + foreach var $args { + upvar $var value + set arr($var) $value + } } ad_proc -public template::util::list_to_array { values array_ref columns } { @@ -298,35 +298,35 @@ @param values A list of values @param array_ref The name of the array to create in the calling frame. @param columns A list of column names to use for the array keys. - The length of this list should be the same as the values - list. + The length of this list should be the same as the values + list. } { - upvar $array_ref array + upvar $array_ref array - for { set i 0 } { $i < [llength $values] } { incr i } { + for { set i 0 } { $i < [llength $values] } { incr i } { - set key [lindex $columns $i] - set value [lindex $values $i] + set key [lindex $columns $i] + set value [lindex $values $i] - set array($key) $value - } + set array($key) $value + } } ad_proc -public template::util::list_of_lists_to_array { lists array_ref } { - Converts a list of lists in the form { { key value } { key value } ... } + Converts a list of lists in the form { { key value } { key value } ... } to an array. } { - upvar $array_ref array + upvar $array_ref array - foreach pair $lists { + foreach pair $lists { - set key [lindex $pair 0] - set value [lindex $pair 1] + set key [lindex $pair 0] + set value [lindex $pair 1] - set array($key) $value - } + set array($key) $value + } } ad_proc -public template::util::list_to_lookup { values array_ref } { @@ -337,26 +337,26 @@ @param values A list of values @param array_ref The name of the array to create in the calling frame. } { - upvar $array_ref array + upvar $array_ref array - set i 1 + set i 1 - foreach element $values { - set array($element) $i - incr i - } + foreach element $values { + set array($element) $i + incr i + } } -ad_proc -public template::util::multirow_to_list { +ad_proc -public template::util::multirow_to_list { {-level 1} - name + name } { generate a list structure representitive of a multirow data source NB: if the multirow is generated by db_multirow, db_multirow must be called with the -local option - + @param name the name of an existing multirow data source @return a representation of a multirow data source as a list, @@ -365,18 +365,18 @@ @see proc template::util::list_to_multirow } { - upvar $level $name:rowcount rowcount + upvar $level $name:rowcount rowcount - set rows [list] + set rows [list] - for { set i 1 } { $i <= $rowcount } { incr i } { + for { set i 1 } { $i <= $rowcount } { incr i } { - upvar $level $name:$i row + upvar $level $name:$i row - lappend rows [array get row] - } + lappend rows [array get row] + } - return $rows + return $rows } ad_proc -public template::util::list_to_multirow { name rows { level 1 } } { @@ -390,16 +390,16 @@ @see proc template::util::multirow_to_list } { - upvar $level $name:rowcount rowcount - set rowcount [llength $rows] - set rownum 1 + upvar $level $name:rowcount rowcount + set rowcount [llength $rows] + set rownum 1 - foreach rowlist $rows { - lappend rowlist rownum $rownum - upvar $level $name:$rownum row - array set row $rowlist - incr rownum - } + foreach rowlist $rows { + lappend rowlist rownum $rownum + upvar $level $name:$rownum row + array set row $rowlist + incr rownum + } } ad_proc -public template::util::list_of_ns_sets_to_multirow { @@ -408,533 +408,533 @@ {-level "1"} } { Transform a list of ns_sets (most likely produced by db_list_of_ns_sets - into a multirow datasource. + into a multirow datasource. - @param rows The data to be transformed - @param var_name The name of the multirow to create - @param level How many levels up the stack to place the new datasource, - defaults to 1 level up. -} { - upvar $level $var_name:rowcount rowcount $var_name:columns columns - set rowcount [llength $rows] + @param rows The data to be transformed + @param var_name The name of the multirow to create + @param level How many levels up the stack to place the new datasource, + defaults to 1 level up. + } { + upvar $level $var_name:rowcount rowcount $var_name:columns columns + set rowcount [llength $rows] - set i 1 - foreach row_set $rows { + set i 1 + foreach row_set $rows { - ns_set put $row_set rownum $i + ns_set put $row_set rownum $i - upvar $level $var_name:$i row - array set row [util_ns_set_to_list -set $row_set] - if {$i == 1} { - set columns [array names row] - } - incr i - } -} + upvar $level $var_name:$i row + array set row [util_ns_set_to_list -set $row_set] + if {$i == 1} { + set columns [array names row] + } + incr i + } + } -# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -# * Utility procedures for interacting with the file system * -# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + # * Utility procedures for interacting with the file system * + # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -ad_proc -public template::util::read_file { path } { - Reads a text file. + ad_proc -public template::util::read_file { path } { + Reads a text file. - @param path The absolute path to the file + @param path The absolute path to the file - @return A string with the contents of the file. -} { + @return A string with the contents of the file. + } { - set fd [open $path] + set fd [open $path] - template::util::set_file_encoding $fd + template::util::set_file_encoding $fd - set text [read $fd] - close $fd + set text [read $fd] + close $fd - return $text -} + return $text + } -ad_proc -public template::util::set_file_encoding { file_channel_id } { - Set encoding of the given file channel based on the OutputCharset - parameter of AOLserver. All ADP, Tcl, and txt files are assumed - to be in the same charset. + ad_proc -public template::util::set_file_encoding { file_channel_id } { + Set encoding of the given file channel based on the OutputCharset + parameter of AOLserver. All ADP, Tcl, and txt files are assumed + to be in the same charset. - @param file_channel_id The id of the file to set encoding for. - - @author Peter Marklund -} { - set output_charset [ns_config "ns/parameters" OutputCharset] - set tcl_charset [ns_encodingforcharset $output_charset] + @param file_channel_id The id of the file to set encoding for. - if { $tcl_charset ne "" } { - fconfigure $file_channel_id -encoding $tcl_charset - } -} + @author Peter Marklund + } { + set output_charset [ns_config "ns/parameters" OutputCharset] + set tcl_charset [ns_encodingforcharset $output_charset] -ad_proc -public template::util::write_file { path text } { - Writes a text file + if { $tcl_charset ne "" } { + fconfigure $file_channel_id -encoding $tcl_charset + } + } - @param path The absolute path to the file - @param text A string containing the text to write to the file. -} { + ad_proc -public template::util::write_file { path text } { + Writes a text file - file mkdir [file dirname $path] + @param path The absolute path to the file + @param text A string containing the text to write to the file. + } { - set fd [open $path w] + file mkdir [file dirname $path] - template::util::set_file_encoding $fd + set fd [open $path w] - puts $fd $text - close $fd -} + template::util::set_file_encoding $fd -ad_proc -public template::util::master_to_file { url {reference_url ""} } { - - Resolve a URL into an absolute file path, but respect styled - master configuration for named masters - (e.g. acs-templating/resources/masters/... containing 2cols.adp) - -} { - if { [string index $url 0] ne "/" } { - set master_stub [template::resource_path -type masters -style $url] + puts $fd $text + close $fd + } - if {[file exists $master_stub.adp]} { - set path $master_stub - } else { - set path [file dirname $reference_url]/$url - } - - } else { - set path $::acs::rootdir/$url + ad_proc -public template::util::master_to_file { url {reference_url ""} } { + + Resolve a URL into an absolute file path, but respect styled + master configuration for named masters + (e.g. acs-templating/resources/masters/... containing 2cols.adp) + + } { + if { [string index $url 0] ne "/" } { + set master_stub [template::resource_path -type masters -style $url] + + if {[file exists $master_stub.adp]} { + set path $master_stub + } else { + set path [file dirname $reference_url]/$url + } + + } else { + set path $::acs::rootdir/$url + } + return [ns_normalizepath $path] } - return [ns_normalizepath $path] -} -ad_proc -public template::util::url_to_file { url {reference_url ""} } { - Resolve a URL into an absolute file path. -} { + ad_proc -public template::util::url_to_file { url {reference_url ""} } { + Resolve a URL into an absolute file path. + } { - if { [string index $url 0] ne "/" } { - set path [file dirname $reference_url]/$url - } else { - set path $::acs::rootdir/$url + if { [string index $url 0] ne "/" } { + set path [file dirname $reference_url]/$url + } else { + set path $::acs::rootdir/$url + } + + return [ns_normalizepath $path] } - return [ns_normalizepath $path] -} + ad_proc -public template::util::resolve_directory_url { url } { + Resolve the file name for a directory URL + } { + set path $::acs::pageroot$url -ad_proc -public template::util::resolve_directory_url { url } { - Resolve the file name for a directory URL -} { - set path $::acs::pageroot$url + if { [file isdirectory $path] && [file exists ${path}index.adp] } { + set url ${url}index.acs + } - if { [file isdirectory $path] && [file exists ${path}index.adp] } { - set url ${url}index.acs - } + return $url + } - return $url -} + ad_proc -public template::util::get_url_directory { url } { + Get the directory portion of a URL. If the URL has a trailing + slash, then return the entire URL. + } { + set directory $url -ad_proc -public template::util::get_url_directory { url } { - Get the directory portion of a URL. If the URL has a trailing - slash, then return the entire URL. -} { - set directory $url + set lastchar [string range $url [string length $url]-1 end] - set lastchar [string range $url [string length $url]-1 end] + if {$lastchar ne "/" } { - if {$lastchar ne "/" } { + set directory [file dirname $url]/ - set directory [file dirname $url]/ + if {$directory eq "//"} { + # root directory is a special case + set directory / + } + } - if {$directory eq "//"} { - # root directory is a special case - set directory / + return $directory } - } - return $directory -} + ad_proc -public -deprecated template::util::get_cookie { name {default_value ""} } { + Retrieve the value of a cookie and return it + Return the default if no such cookie exists -ad_proc -public -deprecated template::util::get_cookie { name {default_value ""} } { - Retrieve the value of a cookie and return it - Return the default if no such cookie exists - - @see ad_get_cookie -} { - set headers [ns_conn headers] - set cookie [ns_set iget $headers Cookie] + @see ad_get_cookie + } { + set headers [ns_conn headers] + set cookie [ns_set iget $headers Cookie] - if { [regexp "$name=(\[^;\]+)" $cookie match value] } { - return [ns_urldecode $value] - } - - return $default_value -} + if { [regexp "$name=(\[^;\]+)" $cookie match value] } { + return [ns_urldecode $value] + } -ad_proc -public -deprecated template::util::set_cookie { expire_state name value { domain "" } } { - Create a cookie with specified parameters. The expiration state - may be persistent, session, or a number of minutes from the current - time. + return $default_value + } - @see ad_set_cookie -} { + ad_proc -public -deprecated template::util::set_cookie { expire_state name value { domain "" } } { + Create a cookie with specified parameters. The expiration state + may be persistent, session, or a number of minutes from the current + time. - if { [string match $domain {}] } { - set path "ns/server/[ns_info server]/module/nssock" - set domain [ns_config $path Hostname] - } + @see ad_set_cookie + } { - set cookie "$name=[ns_urlencode $value]; path=/; domain=$domain" - - switch -- $expire_state { + if { [string match $domain {}] } { + set path "ns/server/[ns_info server]/module/nssock" + set domain [ns_config $path Hostname] + } - persistent { - append cookie ";expires=Wed, 01-Jan-2020 01:00:00 GMT" - } + set cookie "$name=[ns_urlencode $value]; path=/; domain=$domain" - "" - - session { - } + switch -- $expire_state { - default { - - set time [expr {[ns_time] + ($expire_state * 60)}] - append cookie ";expires=[ns_httptime $time]" + persistent { + append cookie ";expires=Wed, 01-Jan-2020 01:00:00 GMT" + } + + "" - + session { + } + + default { + + set time [expr {[ns_time] + ($expire_state * 60)}] + append cookie ";expires=[ns_httptime $time]" + } + } + + ns_set put [ns_conn outputheaders] "Set-Cookie" $cookie } - } - ns_set put [ns_conn outputheaders] "Set-Cookie" $cookie -} + ad_proc -public -deprecated template::util::clear_cookie { name { domain "" } } { + Expires an existing cookie. -ad_proc -public -deprecated template::util::clear_cookie { name { domain "" } } { - Expires an existing cookie. + @see ad_get_cookie - @see ad_get_cookie + } { + if { [string match $domain {}] } { + set path "ns/server/[ns_info server]/module/nssock" + set domain [ns_config $path Hostname] + } -} { - if { [string match $domain {}] } { - set path "ns/server/[ns_info server]/module/nssock" - set domain [ns_config $path Hostname] - } + set cookie "$name=expired; path=/; domain=$domain;" + append cookie "expires=Tue, 01-Jan-1980 01:00:00 GMT" - set cookie "$name=expired; path=/; domain=$domain;" - append cookie "expires=Tue, 01-Jan-1980 01:00:00 GMT" + ns_set put [ns_conn outputheaders] "Set-Cookie" $cookie + } - ns_set put [ns_conn outputheaders] "Set-Cookie" $cookie -} + ad_proc -deprecated -public template::util::quote_html { + html + } { + Quote possible HTML tags in the contents of the html parameter. + } { -ad_proc -deprecated -public template::util::quote_html { - html -} { - Quote possible HTML tags in the contents of the html parameter. -} { + return [ns_quotehtml $html] + } - return [ns_quotehtml $html] -} + ad_proc -public template::util::multirow_quote_html {multirow_ref column_ref} { + implements template::util::quote_html on the designated column of a multirow -ad_proc -public template::util::multirow_quote_html {multirow_ref column_ref} { - implements template::util::quote_html on the designated column of a multirow + @param multirow_ref name of the multirow + @param column_ref name of the column to be - @param multirow_ref name of the multirow - @param column_ref name of the column to be + @author simon + } { - @author simon -} { + upvar $multirow_ref:rowcount rowcount - upvar $multirow_ref:rowcount rowcount + for { set i 1 } { $i <= $rowcount } { incr i} { + upvar $multirow_ref:$i arr + set arr($column_ref) [ns_quotehtml [set arr($column_ref)]] + } - for { set i 1 } { $i <= $rowcount } { incr i} { - upvar $multirow_ref:$i arr - set arr($column_ref) [ns_quotehtml [set arr($column_ref)]] } -} + ad_proc -deprecated -public template::util::multirow_foreach { name code_text } { + runs a block of code foreach row in a multirow. -ad_proc -deprecated -public template::util::multirow_foreach { name code_text } { - runs a block of code foreach row in a multirow. + Using "template::multirow foreach" is recommended over this routine. - Using "template::multirow foreach" is recommended over this routine. + @param name the name of the multirow over which the block of + code is iterated - @param name the name of the multirow over which the block of - code is iterated + @param code_text the block of code in the for loop; this block can + reference any of the columns belonging to the + multirow specified; with the multirow named + "fake_multirow" containing columns named "spanky" + and "foobar",to set the column spanky to the value + of column foobar use:
+ set fake_multirow.spanky @fake_multirow.foobar@ +

+ note: this block of code is evaluated in the same + scope as the .tcl page that uses this procedure - @param code_text the block of code in the for loop; this block can - reference any of the columns belonging to the - multirow specified; with the multirow named - "fake_multirow" containing columns named "spanky" - and "foobar",to set the column spanky to the value - of column foobar use:
- set fake_multirow.spanky @fake_multirow.foobar@ -

- note: this block of code is evaluated in the same - scope as the .tcl page that uses this procedure + @author simon - @author simon + @see template::multirow + } { - @see template::multirow -} { + upvar $name:rowcount rowcount $name:columns columns i i + upvar running_code running_code - upvar $name:rowcount rowcount $name:columns columns i i - upvar running_code running_code + for { set i 1} {$i <= $rowcount} {incr i} { - for { set i 1} {$i <= $rowcount} {incr i} { + set running_code $code_text + foreach column_name $columns { - set running_code $code_text - foreach column_name $columns { + # first change all references to a column to the proper + # rownum-dependent identifier, ie the array value identified + # by $:() + regsub -all "($name).($column_name)" $running_code "$name:${i}($column_name)" running_code + } - # first change all references to a column to the proper - # rownum-dependent identifier, ie the array value identified - # by $:() - regsub -all "($name).($column_name)" $running_code "$name:${i}($column_name)" running_code - } + regsub -all {@([a-zA-Z0-9_:\(\)]+)@} $running_code {${\1}} running_code - regsub -all {@([a-zA-Z0-9_:\(\)]+)@} $running_code {${\1}} running_code + uplevel { + eval $running_code + } - uplevel { - eval $running_code - } + } - } - -} + } -ad_proc -deprecated -public template::util::get_param { - name - {section ""} - {key ""} -} { - Retrieve a stored parameter, or "" if no such parameter - If section/key are present, read the parameter from the specified - section.key in the INI file, and cache them under the given name -} { + ad_proc -deprecated -public template::util::get_param { + name + {section ""} + {key ""} + } { + Retrieve a stored parameter, or "" if no such parameter + If section/key are present, read the parameter from the specified + section.key in the INI file, and cache them under the given name + } { - if { ![nsv_exists __template_config $name] } { + if { ![nsv_exists __template_config $name] } { - # Extract the parameter from the ini file if possible - if { $section ne "" } { + # Extract the parameter from the ini file if possible + if { $section ne "" } { - # Use the name if no key is specified - if { $key ne "" } { - set key $name - } + # Use the name if no key is specified + if { $key ne "" } { + set key $name + } - set value [ns_config $section $key ""] - if {$value eq ""} { - return "" - } else { - # Cache the value and return it - template::util::set_param $name $value - return $value - } + set value [ns_config $section $key ""] + if {$value eq ""} { + return "" + } else { + # Cache the value and return it + template::util::set_param $name $value + return $value + } - } else { - # No such parameter found and no key/section specified - return "" + } else { + # No such parameter found and no key/section specified + return "" + } + } else { + return [nsv_get __template_config $name] + } } - } else { - return [nsv_get __template_config $name] - } -} -ad_proc -public -deprecated template::util::set_param { name value } { - Set a stored parameter -} { - nsv_set __template_config $name $value -} + ad_proc -public -deprecated template::util::set_param { name value } { + Set a stored parameter + } { + nsv_set __template_config $name $value + } -ad_proc -public template::util::nvl { value value_if_null } { - Analogous to SQL NVL -} { - if {$value eq ""} { - return $value_if_null - } - return $value -} + ad_proc -public template::util::nvl { value value_if_null } { + Analogous to SQL NVL + } { + if {$value eq ""} { + return $value_if_null + } + return $value + } -ad_proc -public template::util::number_list { last_number {start_at 0} } { - Return a list of numbers, {1 2 3 ... n} -} { + ad_proc -public template::util::number_list { last_number {start_at 0} } { + Return a list of numbers, {1 2 3 ... n} + } { - set ret [list] - for {set i $start_at} { $i <= $last_number } {incr i} { - lappend ret $i - } - return $ret -} + set ret [list] + for {set i $start_at} { $i <= $last_number } {incr i} { + lappend ret $i + } + return $ret + } -ad_proc -public template::util::tcl_to_sql_list { lst } { - Convert a Tcl list to a SQL list, for use with the "in" statement. - Uses DoubleApos (similar to ns_dbquotevalue) functionality to escape single quotes -} { + ad_proc -public template::util::tcl_to_sql_list { lst } { + Convert a Tcl list to a SQL list, for use with the "in" statement. + Uses DoubleApos (similar to ns_dbquotevalue) functionality to escape single quotes + } { - if { [llength $lst] > 0 } { - # adding DoubleApos functionality for security reasons. - regsub -all -- ' "$lst" '' lst2 - set sql "'" - append sql [join $lst2 "', '"] - append sql "'" - return $sql - } else { - return "" + if { [llength $lst] > 0 } { + # adding DoubleApos functionality for security reasons. + regsub -all -- ' "$lst" '' lst2 + set sql "'" + append sql [join $lst2 "', '"] + append sql "'" + return $sql + } else { + return "" + } } -} -ad_proc -deprecated template::get_resource_path {} { - Get the template directory - The body is doublequoted, so it is interpreted when this file is read - @see template::resource_path -} " + ad_proc -deprecated template::get_resource_path {} { + Get the template directory + The body is doublequoted, so it is interpreted when this file is read + @see template::resource_path + } " return \"[file dirname [file dirname [info script]]]/resources\" " -ad_proc -public template::themed_template { - path -} { - - Given a path like /packages/acs-admin/www/index pointing to an - .adp file, this function tries to locate this path in the - ResourceDir of the subsite (determined by the theme). If found the - themed template is returned, otherwse the passed template path. + ad_proc -public template::themed_template { + path + } { - @param path absolute path within the open acs tree (without extension) - @return path to themed template or input value (without extension) - -} { - if {[string index $path 0] eq "/"} { - set style [string range $path 1 end] - } else { - set style $path + Given a path like /packages/acs-admin/www/index pointing to an + .adp file, this function tries to locate this path in the + ResourceDir of the subsite (determined by the theme). If found the + themed template is returned, otherwse the passed template path. + + @param path absolute path within the open acs tree (without extension) + @return path to themed template or input value (without extension) + + } { + if {[string index $path 0] eq "/"} { + set style [string range $path 1 end] + } else { + set style $path + } + set stub [template::resource_path -type templates -style $style -relative] + if {[file readable $::acs::rootdir/$stub.adp]} { + return $stub + } + return $path } - set stub [template::resource_path -type templates -style $style -relative] - if {[file readable $::acs::rootdir/$stub.adp]} { - return $stub - } - return $path -} -ad_proc -public template::streaming_template { - -subsite_id -} { - Return the path of the streaming template - @param subsite_id id of the subsite. Defaults to [ad_conn subsite_id] - @return path to themed template -} { - if { ![info exists subsite_id] } { - set subsite_id [ad_conn subsite_id] + ad_proc -public template::streaming_template { + -subsite_id + } { + Return the path of the streaming template + @param subsite_id id of the subsite. Defaults to [ad_conn subsite_id] + @return path to themed template + } { + if { ![info exists subsite_id] } { + set subsite_id [ad_conn subsite_id] + } + set template [parameter::get -package_id $subsite_id \ + -parameter StreamingHead \ + -default "/packages/openacs-default-theme/lib/plain-streaming-head"] + return [template::resource_path -type masters -style $template -relative] } - set template [parameter::get -package_id $subsite_id \ - -parameter StreamingHead \ - -default "/packages/openacs-default-theme/lib/plain-streaming-head"] - return [template::resource_path -type masters -style $template -relative] -} -ad_proc -public template::resource_path { - -type:required - -style:required - -relative:boolean - -subsite_id - -theme_dir -} { - - Process the templating "style" and return the stub (path without - extensions). When the style is not an abolute path, check if the - resource can be obtained from the theme, if not fallback to the - resources directory of acs-templating. + ad_proc -public template::resource_path { + -type:required + -style:required + -relative:boolean + -subsite_id + -theme_dir + } { - @param type type of resource (e.g. "forms" or "lists") - @param style name of the resource within the type (e.g. "standard") - @param relative return optionally the path relative to the OpenACS root directory - @param theme_dir theming directory (alternative to determination via subsite), higher priority - @param subsite_id subsite_id to determine theming information + Process the templating "style" and return the stub (path without + extensions). When the style is not an abolute path, check if the + resource can be obtained from the theme, if not fallback to the + resources directory of acs-templating. - @return path of the resource (without extension) - @author Gustaf Neumann -} { - - if {![regexp {^/(.*)} $style path]} { + @param type type of resource (e.g. "forms" or "lists") + @param style name of the resource within the type (e.g. "standard") + @param relative return optionally the path relative to the OpenACS root directory + @param theme_dir theming directory (alternative to determination via subsite), higher priority + @param subsite_id subsite_id to determine theming information - if { ![info exists theme_dir] } { - if { ![info exists subsite_id] } { - set subsite_id [ad_conn subsite_id] - } - set theme_dir [parameter::get -parameter ResourceDir -package_id $subsite_id] - } + @return path of the resource (without extension) + @author Gustaf Neumann + } { - if {$theme_dir ne ""} { - if {![file isdir $::acs::rootdir/$theme_dir]} { - ns_log warning "ResourceDir '$theme_dir' does not exist under '$::acs::rootdir';\ + if {![regexp {^/(.*)} $style path]} { + + if { ![info exists theme_dir] } { + if { ![info exists subsite_id] } { + set subsite_id [ad_conn subsite_id] + } + set theme_dir [parameter::get -parameter ResourceDir -package_id $subsite_id] + } + + if {$theme_dir ne ""} { + if {![file isdir $::acs::rootdir/$theme_dir]} { + ns_log warning "ResourceDir '$theme_dir' does not exist under '$::acs::rootdir';\ ignore parameter setting of subsite $subsite_id" - set theme_dir "" + set theme_dir "" + } } + + if {$theme_dir ne ""} { + set path $theme_dir/$type/$style + if {![file exists $::acs::rootdir/$path.adp]} { + unset path + } + } + if {![info exists path]} { + set path /packages/acs-templating/resources/$type/$style + } } - - if {$theme_dir ne ""} { - set path $theme_dir/$type/$style - if {![file exists $::acs::rootdir/$path.adp]} { - unset path - } - } - if {![info exists path]} { - set path /packages/acs-templating/resources/$type/$style - } + + if {$relative_p} { + return $path + } else { + return $::acs::rootdir/$path + } } - - if {$relative_p} { - return $path - } else { - return $::acs::rootdir/$path - } -} -ad_proc -public stack_frame_values {level} { - return the variables and arrays of one frame as HTML -} { + ad_proc -public stack_frame_values {level} { + return the variables and arrays of one frame as HTML + } { - set varlist "" - foreach i [if {$level} { - uplevel \#$level {info locals} - } else {info globals} ] { - append varlist "

  • $i = " - if {$i eq "page" && $level == [info level]-1 || - $i eq "__adp_output" || $i eq "errorInfo"} { - append varlist "value withheld to avoid messy page\n" - } elseif {[string match -nocase "*secret*" $i]} { - append varlist "value withheld as the name contains \"secret\"\n" - } else { - if {[uplevel \#$level array exists $i]} { - append varlist "ARRAY\n" - } else { - if {[catch {append varlist "'[uplevel #$level set $i]'\n"}]} { - append varlist "bad string value\n" - } - } + set varlist "" + foreach i [if {$level} { + uplevel \#$level {info locals} + } else {info globals} ] { + append varlist "
  • $i = " + if {$i eq "page" && $level == [info level]-1 || + $i eq "__adp_output" || $i eq "errorInfo"} { + append varlist "value withheld to avoid messy page\n" + } elseif {[string match -nocase "*secret*" $i]} { + append varlist "value withheld as the name contains \"secret\"\n" + } else { + if {[uplevel \#$level array exists $i]} { + append varlist "ARRAY\n" + } else { + if {[catch {append varlist "'[uplevel #$level set $i]'\n"}]} { + append varlist "bad string value\n" + } + } + } + } + return $varlist } - } - return $varlist -} -ad_proc -public stack_dump {} { - return the whole call stack as HTML -} { - append page "

    Tcl Call Trace

    + ad_proc -public stack_dump {} { + return the whole call stack as HTML + } { + append page "

    Tcl Call Trace