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 -N -r1.33 -r1.34
--- openacs-4/packages/acs-templating/tcl/util-procs.tcl 29 Dec 2017 10:04:13 -0000 1.33
+++ openacs-4/packages/acs-templating/tcl/util-procs.tcl 22 Jan 2018 00:20:08 -0000 1.34
@@ -407,542 +407,362 @@
{-var_name:required}
{-level "1"}
} {
- Transform a list of ns_sets (most likely produced by db_list_of_ns_sets
- into a multirow datasource.
+ Transform a list of ns_sets (e.g. produced by db_list_of_ns_sets)
+ 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
- }
- }
-
- # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
- # * Utility procedures for interacting with the file system *
- # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-
- ad_proc -public template::util::read_file { path } {
- Reads a text file.
-
- @param path The absolute path to the file
-
- @return A string with the contents of the file.
- } {
- #
- # Use ad_try to make sure, that the file descriptor is finally
- # closed.
- #
- ad_try {
- set fd [open $path]
- template::util::set_file_encoding $fd
- set text [read $fd]
- } on error {errMsg opts} {
- dict incr opts -level
- ns_log error "template::util::read_file on fd $fd: $errMsg,\n$::errorInfo"
- return -options [dict replace $opts -inside $opts] $errMsg
- } finally {
- close $fd
+ 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]
}
-
- return $text
+ incr i
}
+}
- 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.
+# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+# * Utility procedures for interacting with the file system *
+# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
- @param file_channel_id The id of the file to set encoding for.
+ad_proc -public template::util::read_file { path } {
+ Reads a text file.
- @author Peter Marklund
- } {
- set output_charset [ns_config "ns/parameters" OutputCharset]
- set tcl_charset [ns_encodingforcharset $output_charset]
+ @param path The absolute path to the file
- if { $tcl_charset ne "" } {
- fconfigure $file_channel_id -encoding $tcl_charset
- }
- }
-
- ad_proc -public template::util::write_file { path text } {
- Writes a text file
-
- @param path The absolute path to the file
- @param text A string containing the text to write to the file.
- } {
-
- file mkdir [file dirname $path]
-
- set fd [open $path w]
-
+ @return A string with the contents of the file.
+} {
+ #
+ # Use ad_try to make sure, that the file descriptor is finally
+ # closed.
+ #
+ ad_try {
+ set fd [open $path]
template::util::set_file_encoding $fd
-
- puts $fd $text
+ set text [read $fd]
+ } on error {errMsg opts} {
+ dict incr opts -level
+ ns_log error "template::util::read_file on fd $fd: $errMsg,\n$::errorInfo"
+ return -options [dict replace $opts -inside $opts] $errMsg
+ } finally {
close $fd
}
- ad_proc -public template::util::master_to_file { url {reference_url ""} } {
+ return $text
+}
- 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)
+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.
- } {
- if { [string index $url 0] ne "/" } {
- set master_stub [template::resource_path -type masters -style $url]
+ @param file_channel_id The id of the file to set encoding for.
- if {[file exists $master_stub.adp]} {
- set path $master_stub
- } else {
- set path [file dirname $reference_url]/$url
- }
+ @author Peter Marklund
+} {
+ set output_charset [ns_config "ns/parameters" OutputCharset]
+ set tcl_charset [ns_encodingforcharset $output_charset]
- } else {
- set path $::acs::rootdir/$url
- }
- return [ns_normalizepath $path]
+ if { $tcl_charset ne "" } {
+ fconfigure $file_channel_id -encoding $tcl_charset
}
+}
- ad_proc -public template::util::url_to_file { url {reference_url ""} } {
- Resolve a URL into an absolute file path.
- } {
+ad_proc -public template::util::write_file { path text } {
+ Writes a text file
- if { [string index $url 0] ne "/" } {
- set path [file dirname $reference_url]/$url
- } else {
- set path $::acs::rootdir/$url
- }
+ @param path The absolute path to the file
+ @param text A string containing the text to write to the file.
+} {
- return [ns_normalizepath $path]
- }
+ file mkdir [file dirname $path]
- ad_proc -public template::util::resolve_directory_url { url } {
- Resolve the file name for a directory URL
- } {
- set path $::acs::pageroot$url
+ set fd [open $path w]
- if { [file isdirectory $path] && [file exists ${path}index.adp] } {
- set url ${url}index.acs
- }
+ template::util::set_file_encoding $fd
- return $url
- }
+ puts $fd $text
+ close $fd
+}
- 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::master_to_file { url {reference_url ""} } {
- set lastchar [string range $url [string length $url]-1 end]
+ 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 {$lastchar ne "/" } {
+} {
+ if { [string index $url 0] ne "/" } {
+ set master_stub [template::resource_path -type masters -style $url]
- set directory [file dirname $url]/
-
- if {$directory eq "//"} {
- # root directory is a special case
- set directory /
- }
+ if {[file exists $master_stub.adp]} {
+ set path $master_stub
+ } else {
+ set path [file dirname $reference_url]/$url
}
- return $directory
+ } else {
+ set path $::acs::rootdir/$url
}
+ return [ns_normalizepath $path]
+}
- 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 template::util::url_to_file { url {reference_url ""} } {
+ Resolve a URL into an absolute file path.
+} {
- @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 { [string index $url 0] ne "/" } {
+ set path [file dirname $reference_url]/$url
+ } else {
+ set path $::acs::rootdir/$url
}
- 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 [ns_normalizepath $path]
+}
- @see ad_set_cookie
- } {
+ad_proc -public template::util::resolve_directory_url { url } {
+ Resolve the file name for a directory URL
+} {
+ set path $::acs::pageroot$url
- if { [string match $domain {}] } {
- set path "ns/server/[ns_info server]/module/nssock"
- set domain [ns_config $path Hostname]
- }
+ if { [file isdirectory $path] && [file exists ${path}index.adp] } {
+ set url ${url}index.acs
+ }
- set cookie "$name=[ns_urlencode $value]; path=/; domain=$domain"
+ return $url
+}
- switch -- $expire_state {
+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
- persistent {
- append cookie ";expires=Wed, 01-Jan-2020 01:00:00 GMT"
- }
+ set lastchar [string range $url [string length $url]-1 end]
- "" -
- session {
- }
+ if {$lastchar ne "/" } {
- default {
+ set directory [file dirname $url]/
- set time [expr {[ns_time] + ($expire_state * 60)}]
- append cookie ";expires=[ns_httptime $time]"
- }
+ if {$directory eq "//"} {
+ # root directory is a special case
+ set directory /
}
-
- ns_set put [ns_conn outputheaders] "Set-Cookie" $cookie
}
- ad_proc -public -deprecated template::util::clear_cookie { name { domain "" } } {
- Expires an existing cookie.
+ return $directory
+}
- @see ad_get_cookie
- } {
- if { [string match $domain {}] } {
- set path "ns/server/[ns_info server]/module/nssock"
- set domain [ns_config $path Hostname]
- }
+ad_proc -public template::util::multirow_quote_html {multirow_ref column_ref} {
+ implements template::util::quote_html on the designated column of a multirow
- set cookie "$name=expired; path=/; domain=$domain;"
- append cookie "expires=Tue, 01-Jan-1980 01:00:00 GMT"
+ @param multirow_ref name of the multirow
+ @param column_ref name of the column to be
- ns_set put [ns_conn outputheaders] "Set-Cookie" $cookie
- }
+ @author simon
+} {
- ad_proc -deprecated -public template::util::quote_html {
- html
- } {
- Quote possible HTML tags in the contents of the html parameter.
- } {
+ upvar $multirow_ref:rowcount rowcount
- return [ns_quotehtml $html]
+ 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 -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
- @author simon
- } {
-
- 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)]]
- }
-
+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 -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.
-
- @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
-
- @author simon
-
- @see template::multirow
- } {
-
- upvar $name:rowcount rowcount $name:columns columns i i
- upvar running_code running_code
-
- for { set i 1} {$i <= $rowcount} {incr i} {
-
- 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 $\n"
+ foreach {key value} [uplevel \#$level array get $i] {
+ append varlist "
\n"
} else {
- if {[uplevel \#$level array exists $i]} {
- append varlist "ARRAY\n"
- foreach {key value} [uplevel \#$level array get $i] {
- append varlist "
\n"
- } else {
- if {[catch {append varlist "'[uplevel #$level set $i]'\n"}]} {
- append varlist "bad string value\n"
- }
+ 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 "
\nTcl Call Trace
\n"
- for {set x [info level]} {$x > 0} {incr x -1} {
- append page "
-
-[stack_frame_values $x]
\n"
- }
+ for {set x [info level]} {$x > 0} {incr x -1} {
+ append page "[stack_frame_values $x]
\n"
+ }
- append page "Globals
- [stack_frame_values 0]
\n"
+ append page "Globals
\n [stack_frame_values 0]
\n"
}
# Local variables: