Index: openacs-4/packages/acs-templating/tcl/query-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/query-procs.tcl,v diff -u -r1.40 -r1.41 --- openacs-4/packages/acs-templating/tcl/query-procs.tcl 24 Mar 2018 00:14:57 -0000 1.40 +++ openacs-4/packages/acs-templating/tcl/query-procs.tcl 24 Apr 2018 21:59:37 -0000 1.41 @@ -4,7 +4,7 @@ @creation-date 29 September 2000 @author Karl Goldstein (karlg@arsdigita.com) @author Stanislav Freidin (sfreidin@arsdigita.com) - + @cvs-id $Id$ } @@ -23,9 +23,9 @@ # http://www.fsf.org/copyleft/gpl.html # (DCW - Openacs) converted template db api to use standard api and hooked it -# into the query-dispatcher. This ties into the standard db api's +# into the query-dispatcher. This ties into the standard db api's # transaction control and handle allocation into the templating query interface -# allowing the two db api's to be mixed together. +# allowing the two db api's to be mixed together. ad_proc -public template::query { statement_name result_name type sql args } { @@ -44,7 +44,7 @@ and refresh the cache.
Only applicable if the cache option is specified as - well. Does not affect a previously specified timeout + well. Does not affect a previously specified timeout period. @option timeout The maximum period of time for which the cached results @@ -56,7 +56,7 @@ @param statement_name Standard db_api query name - @param result_name Tcl variable name when doing an uplevel to + @param result_name Tcl variable name when doing an uplevel to set the returned result @param type The query type @@ -68,50 +68,50 @@ @return 1 if query was a success, 0 if it failed } { - set sql [string trim $sql] - set full_statement_name [db_qd_get_fullname $statement_name] + set sql [string trim $sql] + set full_statement_name [db_qd_get_fullname $statement_name] - #set beginTime [clock clicks -milliseconds] + #set beginTime [clock clicks -milliseconds] - template::util::get_opts $args - - if { ! [info exists opts(uplevel)] } { - set opts(uplevel) 2 - } else { - set opts(uplevel) [expr {2 + $opts(uplevel)}] - } + template::util::get_opts $args - # check the cache for a valid cached query result and return if so - # otherwise continue to perform the query and cache the results afterwards + if { ! [info exists opts(uplevel)] } { + set opts(uplevel) 2 + } else { + set opts(uplevel) [expr {2 + $opts(uplevel)}] + } - if { [info exists opts(cache)] && [get_cached_result $result_name $type] } { - return $opts(result) - } + # check the cache for a valid cached query result and return if so + # otherwise continue to perform the query and cache the results afterwards - if { ! [info exists opts(maxrows)] } { - set opts(maxrows) 10000 - } + if { [info exists opts(cache)] && [get_cached_result $result_name $type] } { + return $opts(result) + } - db_with_handle db { - set ret_code [template::query::$type $full_statement_name $db $result_name $sql] - } + if { ! [info exists opts(maxrows)] } { + set opts(maxrows) 10000 + } - if { [info exists opts(cache)] } { - - # cache the query result - set_cached_result - } + db_with_handle db { + set ret_code [template::query::$type $full_statement_name $db $result_name $sql] + } - #set timeElapsed [expr ([clock clicks -milliseconds] - $beginTime)] - #ns_log Notice "Query performed in: $timeElapsed ms" - - return $ret_code + if { [info exists opts(cache)] } { + + # cache the query result + set_cached_result + } + + #set timeElapsed [expr ([clock clicks -milliseconds] - $beginTime)] + #ns_log Notice "Query performed in: $timeElapsed ms" + + return $ret_code } ad_proc -private template::query::onevalue { statement_name db result_name sql } { Process a onevalue query. Use a single array to store the results. - @param statement_name Standard db_api statement name used to hook + @param statement_name Standard db_api statement name used to hook into query dispatcher @param db Database handle @@ -122,28 +122,28 @@ } { - upvar opts opts + upvar opts opts - upvar $opts(uplevel) $result_name result - set result "" + upvar $opts(uplevel) $result_name result + set result "" - set row [db_exec 0or1row $db $statement_name $sql 3] + set row [db_exec 0or1row $db $statement_name $sql 3] - if { $row ne "" } { + if { $row ne "" } { - # Set the result in the calling frame. - set result [ns_set value $row 0] + # Set the result in the calling frame. + set result [ns_set value $row 0] - if { [info exists opts(cache)] } { - set opts(result) $result + if { [info exists opts(cache)] } { + set opts(result) $result + } } - } } ad_proc -private template::query::onerow { statement_name db result_name sql } { Process a onerow query. Use a single array to store the results. - @param statement_name Standard db_api statement name used to hook + @param statement_name Standard db_api statement name used to hook into query dispatcher @param db Database handle @@ -153,41 +153,38 @@ @param sql Query to use when processing this command } { - upvar opts opts + upvar opts opts - set row [db_exec 0or1row $db $statement_name $sql 3] + set row [db_exec 0or1row $db $statement_name $sql 3] - if { $row ne "" } { + if { $row ne "" } { - # Set the results in the calling frame. - upvar $opts(uplevel) $result_name result + # Set the results in the calling frame. + upvar $opts(uplevel) $result_name result - set size [ns_set size $row] + set size [ns_set size $row] - for { set i 0 } { $i < $size } { incr i } { + for { set i 0 } { $i < $size } { incr i } { - set column [ns_set key $row $i] - set result($column) [ns_set value $row $i] - } + set column [ns_set key $row $i] + set result($column) [ns_set value $row $i] + } - if { [info exists opts(cache)] } { - set opts(result) [array get result] + if { [info exists opts(cache)] } { + set opts(result) [array get result] + } + return 1 + } else { + return 0 } - - return 1 - - } else { - - return 0 - } } ad_proc -private template::query::multirow { statement_name db result_name sql } { Process a multirow query. Use an array for each row row in the result. Arrays are named name0, name1, name2 etc. The variable name.rowcount is also defined for checking and iteration. - @param statement_name Standard db_api statement name used to hook + @param statement_name Standard db_api statement name used to hook into query dispatcher @param db Database handle @@ -200,78 +197,78 @@ @see template::multirow } { - upvar opts opts + upvar opts opts - set row [db_exec select $db $statement_name $sql 3] + set row [db_exec select $db $statement_name $sql 3] - upvar $opts(uplevel) $result_name:rowcount rowcount $result_name:columns column_list + upvar $opts(uplevel) $result_name:rowcount rowcount $result_name:columns column_list - # set a local variable as to whether we are cacheing or not - if { [info exists opts(cache)] } { - set is_cached 1 - set cached_result {} - } else { - set is_cached 0 - } + # set a local variable as to whether we are cacheing or not + if { [info exists opts(cache)] } { + set is_cached 1 + set cached_result {} + } else { + set is_cached 0 + } - set rowcount 0 + set rowcount 0 - if { [info exists opts(eval)] } { - # figure out the level at which to reference the row - set ref_level [expr {$opts(uplevel) - 2}] - } + if { [info exists opts(eval)] } { + # figure out the level at which to reference the row + set ref_level [expr {$opts(uplevel) - 2}] + } - while { [ns_db getrow $db $row] } { + while { [ns_db getrow $db $row] } { - incr rowcount - - # break if maxrows has been reached - if { $rowcount > $opts(maxrows) } { - ns_db flush $db - upvar $opts(uplevel) ${result_name}:has_more_rows has_more_rows - set has_more_rows 1 - incr rowcount -1 - break - } + incr rowcount - # set the results in the calling frame - upvar $opts(uplevel) ${result_name}:$rowcount result + # break if maxrows has been reached + if { $rowcount > $opts(maxrows) } { + ns_db flush $db + upvar $opts(uplevel) ${result_name}:has_more_rows has_more_rows + set has_more_rows 1 + incr rowcount -1 + break + } - set result(rownum) $rowcount + # set the results in the calling frame + upvar $opts(uplevel) ${result_name}:$rowcount result - set size [ns_set size $row] + set result(rownum) $rowcount - for { set i 0 } { $i < $size } { incr i } { + set size [ns_set size $row] - set column [ns_set key $row $i] - set result($column) [ns_set value $row $i] + for { set i 0 } { $i < $size } { incr i } { - if {$rowcount == 1 } { - lappend column_list $column - } - } + set column [ns_set key $row $i] + set result($column) [ns_set value $row $i] - # Execute custom code for each row - if { [info exists opts(eval)] } { - uplevel $opts(uplevel) " - upvar 0 ${result_name}:$rowcount row; $opts(eval) - " + if {$rowcount == 1 } { + lappend column_list $column + } + } + + # Execute custom code for each row + if { [info exists opts(eval)] } { + uplevel $opts(uplevel) " + upvar 0 ${result_name}:$rowcount row; $opts(eval) + " + } + + if { $is_cached } { + lappend cached_result [array get result] + } } if { $is_cached } { - lappend cached_result [array get result] + set opts(result) $cached_result } - } - - if { $is_cached } { - set opts(result) $cached_result - } } ad_proc -private template::query::multilist { statement_name db result_name sql } { Process a multilist query. - @param statement_name Standard db_api statement name used to hook + @param statement_name Standard db_api statement name used to hook into query dispatcher @param db Database handle @@ -281,40 +278,40 @@ @param sql Query to use when processing this command } { - upvar opts opts + upvar opts opts - set row [db_exec select $db $statement_name $sql 3] + set row [db_exec select $db $statement_name $sql 3] - upvar $opts(uplevel) $result_name rows + upvar $opts(uplevel) $result_name rows - set rows {} + set rows {} - while { [ns_db getrow $db $row] } { + while { [ns_db getrow $db $row] } { - set values {} - set size [ns_set size $row] + set values {} + set size [ns_set size $row] - for { set i 0 } { $i < $size } { incr i } { - lappend values [ns_set value $row $i] - } - lappend rows $values - } + for { set i 0 } { $i < $size } { incr i } { + lappend values [ns_set value $row $i] + } + lappend rows $values + } - if { [info exists opts(cache)] } { - set opts(result) $rows - } + if { [info exists opts(cache)] } { + set opts(result) $rows + } - return $rows + return $rows } ad_proc -private template::query::nestedlist { statement_name db result_name sql } { - Creates a data source where the values for each row + Creates a data source where the values for each row are returned as a list. Rows are grouped according to the column values specified in the -groupby option See template::util::lnest for more details. - @param statement_name Standard db_api statement name used to hook + @param statement_name Standard db_api statement name used to hook into query dispatcher @param db Database handle @@ -324,45 +321,45 @@ @param sql Query to use when processing this command } { - upvar opts opts + upvar opts opts - set row [db_exec select $db $statement_name $sql 3] + set row [db_exec select $db $statement_name $sql 3] - upvar $opts(uplevel) $result_name rows - - set groups $opts(groupby) + upvar $opts(uplevel) $result_name rows - set rows {} + set groups $opts(groupby) - while { [ns_db getrow $db $row] } { + set rows {} - set values {} - set size [ns_set size $row] + while { [ns_db getrow $db $row] } { - for { set i 0 } { $i < $size } { incr i } { - lappend values [ns_set value $row $i] - } + set values {} + set size [ns_set size $row] - # build the values on which to group - set group_values [list] - foreach group $groups { - lappend group_values [ns_set get $row $group] - } - - template::util::lnest rows $values {*}$group_values - } + for { set i 0 } { $i < $size } { incr i } { + lappend values [ns_set value $row $i] + } - if { [info exists opts(cache)] } { - set opts(result) $rows - } + # build the values on which to group + set group_values [list] + foreach group $groups { + lappend group_values [ns_set get $row $group] + } - return $rows + template::util::lnest rows $values {*}$group_values + } + + if { [info exists opts(cache)] } { + set opts(result) $rows + } + + return $rows } ad_proc -private template::query::onelist { statement_name db result_name sql } { Process a onelist query. - @param statement_name Standard db_api statement name used to hook + @param statement_name Standard db_api statement name used to hook into query dispatcher @param db Database handle @@ -372,26 +369,26 @@ @param sql Query to use when processing this command } { - upvar opts opts + upvar opts opts - set row [db_exec select $db $statement_name $sql 3] + set row [db_exec select $db $statement_name $sql 3] - upvar $opts(uplevel) $result_name rows + upvar $opts(uplevel) $result_name rows - set rows {} - while { [ns_db getrow $db $row] } { - lappend rows [ns_set value $row 0] - } + set rows {} + while { [ns_db getrow $db $row] } { + lappend rows [ns_set value $row 0] + } - if { [info exists opts(cache)] } { - set opts(result) $rows - } + if { [info exists opts(cache)] } { + set opts(result) $rows + } } ad_proc -private template::query::dml { statement_name db name sql } { Process an SQL statement that is not a query; perhaps update or insert - @param statement_name Standard db_api statement name used to hook + @param statement_name Standard db_api statement name used to hook into query dispatcher @param db Database handle @@ -401,9 +398,9 @@ @param sql Query to use when processing this command } { - upvar opts opts + upvar opts opts - db_exec dml $db $statement_name $sql 3 + db_exec dml $db $statement_name $sql 3 } @@ -419,70 +416,70 @@ @return 1 if result was successfully retrieved, 0 if failed } { - upvar opts opts - set cache_key $opts(cache) - set success 0 + upvar opts opts + set cache_key $opts(cache) + set success 0 - if { [info exists opts(persistent)] } { + if { [info exists opts(persistent)] } { - if { [ns_cache names template_query_cache $cache_key] ne ""} { + if { [ns_cache names template_query_cache $cache_key] ne ""} { - if {[ns_info name] eq "NaviServer"} { - set cached_result [ns_cache_eval template_query_cache $cache_key {}] - } else { + if {[ns_info name] eq "NaviServer"} { + set cached_result [ns_cache_eval template_query_cache $cache_key {}] + } else { - # get the pair of the timeout and value - lassign [ns_cache get template_query_cache $cache_key] timeout cached_result + # get the pair of the timeout and value + lassign [ns_cache get template_query_cache $cache_key] timeout cached_result - # check the timeout - if { $timeout > [ns_time] } { - set success 1 - } else { - ns_cache flush template_query_cache $cache_key - } - } + # check the timeout + if { $timeout > [ns_time] } { + set success 1 + } else { + ns_cache flush template_query_cache $cache_key + } + } + } + + } else { + if { [info exists ::__template_query_request_cache($cache_key)] } { + set cached_result $::__template_query_request_cache($cache_key) + set success 1 + } } - } else { - if { [info exists ::__template_query_request_cache($cache_key)] } { - set cached_result $::__template_query_request_cache($cache_key) - set success 1 - } - } + if { $success } { - if { $success } { + switch -- $type { - switch -- $type { + multirow { - multirow { + upvar $opts(uplevel) $name:rowcount rowcount + set rowcount [llength $cached_result] + set rownum 1 - upvar $opts(uplevel) $name:rowcount rowcount - set rowcount [llength $cached_result] - set rownum 1 + foreach cached_row $cached_result { + upvar $opts(uplevel) $name:$rownum row + array set row $cached_row + incr rownum + } + set opts(result) "" + } + onerow { - foreach cached_row $cached_result { - upvar $opts(uplevel) $name:$rownum row - array set row $cached_row - incr rownum - } - set opts(result) "" - } - onerow { + upvar $opts(uplevel) $name result + array set result $cached_result + set opts(result) "" + } + default { - upvar $opts(uplevel) $name result - array set result $cached_result - set opts(result) "" - } - default { - - upvar $opts(uplevel) $name result - set result $cached_result - set opts(result) $cached_result - } + upvar $opts(uplevel) $name result + set result $cached_result + set opts(result) $cached_result + } + } } - } - return $success + return $success } ad_proc -private set_cached_result {} { @@ -491,40 +488,40 @@ } { - upvar opts opts - - if { ! [info exists opts(result)] } { - return - } + upvar opts opts - set cache_key $opts(cache) - - if { [info exists opts(persistent)] } { - # - # calculate the timeout - # - if { [info exists opts(timeout)] } { - set timeout [expr {[ns_time] + $opts(timeout)}] - } else { - set timeout [expr {[ns_time] + 60 * 60 * 24 * 7}] + if { ! [info exists opts(result)] } { + return } - if {[ns_info name] eq "NaviServer"} { - # - # NaviServer allows per entry expire time - # - ns_cache_eval -expires $timeout -force template_query_cache $cache_key \ - set _ $opts(result) + set cache_key $opts(cache) + + if { [info exists opts(persistent)] } { + # + # calculate the timeout + # + if { [info exists opts(timeout)] } { + set timeout [expr {[ns_time] + $opts(timeout)}] + } else { + set timeout [expr {[ns_time] + 60 * 60 * 24 * 7}] + } + + if {[ns_info name] eq "NaviServer"} { + # + # NaviServer allows per entry expire time + # + ns_cache_eval -expires $timeout -force template_query_cache $cache_key \ + set _ $opts(result) + } else { + # + # set the cached value as a pair of timeout and value + # + ns_cache set template_query_cache $cache_key [list $timeout $opts(result)] + } + } else { - # - # set the cached value as a pair of timeout and value - # - ns_cache set template_query_cache $cache_key [list $timeout $opts(result)] + set ::__template_query_request_cache($cache_key) $opts(result) } - - } else { - set ::__template_query_request_cache($cache_key) $opts(result) - } } ad_proc -private template::query::flush_cache { cache_match } { @@ -534,26 +531,26 @@ @param cache_match Name of query to match for cache flushing } { - # Flush persistent cache - set names [ns_cache names template_query_cache] - foreach name $names { - if { [string match $cache_match $name] } { - ns_log debug "template::query::flush_cache: FLUSHING QUERY (persistent): $name" - ns_cache flush template_query_cache $name - if {[ns_info name] ne "NaviServer"} { - ns_cache flush template_timeout_cache $name - } + # Flush persistent cache + set names [ns_cache names template_query_cache] + foreach name $names { + if { [string match $cache_match $name] } { + ns_log debug "template::query::flush_cache: FLUSHING QUERY (persistent): $name" + ns_cache flush template_query_cache $name + if {[ns_info name] ne "NaviServer"} { + ns_cache flush template_timeout_cache $name + } + } } - } - # Flush temporary cache - set names [array names ::__template_query_persistent_cache] - foreach name $names { - if { [string match $cache_match $name] } { - ns_log debug "template::query::flush_cache: FLUSHING QUERY (request): $name" - unset ::__template_query_persistent_cache($name) + # Flush temporary cache + set names [array names ::__template_query_persistent_cache] + foreach name $names { + if { [string match $cache_match $name] } { + ns_log debug "template::query::flush_cache: FLUSHING QUERY (request): $name" + unset ::__template_query_persistent_cache($name) + } } - } } @@ -565,25 +562,25 @@ op name args -} { - multirow is really template::multirow or possibly +} { + multirow is really template::multirow or possibly template::query::multirow depending on context. the "template::" or "template::query::" - may be omitted depending on what the namespace - is. .tcl pages are evaluated in the template:: + may be omitted depending on what the namespace + is. .tcl pages are evaluated in the template:: namespace. @see template::multirow @see template::query::multirow -} - +} - -ad_proc -public template::multirow { - {-ulevel 1} - {-local:boolean} - -unclobber:boolean - command - name - args +ad_proc -public template::multirow { + {-ulevel 1} + {-local:boolean} + -unclobber:boolean + command + name + args } { Create/Manipulate a multirow datasource (for use with <multiple> tags) @@ -615,13 +612,13 @@
[template::adp_level]
scope, which
+
+ @param local If set, the multirow will be looked for in the scope the number
+ of levels up given by ulevel (normally the caller's scope),
+ instead of the [template::adp_level]
scope, which
is the default.
- @param ulevel Used in conjunction with the "local" parameter to specify how
+ @param ulevel Used in conjunction with the "local" parameter to specify how
many levels up the multirow variable resides.
@param command Multirow datasource operation: create, extend, append, pop, size, get, set, foreach, upvar
@@ -632,400 +629,395 @@
@param unclobber This only applies to the 'foreach' command.
If set, will cause the proc to not overwrite local variables. Actually, what happens
- is that the local variables will be overwritten, so you can access them within the code block. However,
+ is that the local variables will be overwritten, so you can access them within the code block. However,
if you specify -unclobber, we will revert them to their original state after execution of this proc.
@see db_multirow
@see template::query::multirow
-} {
- if { $local_p } {
- set multirow_level_up $ulevel
- } else {
- set multirow_level_up \#[adp_level]
- if { $multirow_level_up eq "\#" } {
- # in event adp_level not defined we are calling either at install so up 1.
- set multirow_level_up 1
+} {
+ if { $local_p } {
+ set multirow_level_up $ulevel
+ } else {
+ set multirow_level_up \#[adp_level]
+ if { $multirow_level_up eq "\#" } {
+ # in event adp_level not defined we are calling either at install so up 1.
+ set multirow_level_up 1
+ }
}
- }
-
- switch -exact $command {
- create {
- upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
- set rowcount 0
- set columns $args
- }
+ switch -exact $command {
- unset {
- upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
- for { set i 1 } { $i <= $rowcount } { incr i } {
- upvar $multirow_level_up $name:$i row
- unset row
- }
- unset rowcount columns
- }
+ create {
+ upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
+ set rowcount 0
+ set columns $args
+ }
- extend {
- upvar $multirow_level_up $name:columns columns
- foreach column_name $args {
- lappend columns $column_name
- }
- }
+ unset {
+ upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
+ for { set i 1 } { $i <= $rowcount } { incr i } {
+ upvar $multirow_level_up $name:$i row
+ unset row
+ }
+ unset rowcount columns
+ }
- pop {
- upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
- set r_list [list]
- if {$rowcount > 0} {
+ extend {
+ upvar $multirow_level_up $name:columns columns
+ foreach column_name $args {
+ lappend columns $column_name
+ }
+ }
+
+ pop {
+ upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
+ set r_list [list]
+ if {$rowcount > 0} {
+ upvar $multirow_level_up $name:$rowcount row
+ for { set i 0 } { $i < [llength $columns] } { incr i } {
+ set key [lindex $columns $i]
+ if {[info exists row($key)]} {
+ set value $row($key)
+ lappend r_list $key $value
+ }
+ }
+ array unset row
+ }
+ incr rowcount -1
+ return $r_list
+ }
+
+ append {
+ upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
+ incr rowcount
upvar $multirow_level_up $name:$rowcount row
+
for { set i 0 } { $i < [llength $columns] } { incr i } {
+
set key [lindex $columns $i]
- if {[info exists row($key)]} {
- set value $row($key)
- lappend r_list $key $value
- }
+ set value [lindex $args $i]; #(!) missing columns are silently empty
+ set row($key) $value
}
- array unset row
+ set row(rownum) $rowcount
}
- incr rowcount -1
- return $r_list
- }
- append {
- upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
- incr rowcount
- upvar $multirow_level_up $name:$rowcount row
-
- for { set i 0 } { $i < [llength $columns] } { incr i } {
-
- set key [lindex $columns $i]
- set value [lindex $args $i]; #(!) missing columns are silently empty
- set row($key) $value
- }
- set row(rownum) $rowcount
- }
+ size {
+ upvar $multirow_level_up $name:rowcount rowcount
+ if { [template::util::is_nil rowcount] } {
+ return 0
+ }
+ return $rowcount
+ }
- size {
- upvar $multirow_level_up $name:rowcount rowcount
- if { [template::util::is_nil rowcount] } {
- return 0
- }
- return $rowcount
- }
+ columns {
+ upvar $multirow_level_up $name:columns columns
+ if { [template::util::is_nil columns] } {
+ return {}
+ }
+ return $columns
+ }
- columns {
- upvar $multirow_level_up $name:columns columns
- if { [template::util::is_nil columns] } {
- return {}
- }
- return $columns
- }
-
- get {
-
- set index [lindex $args 0]
- set column [lindex $args 1]
- # Set an array reference if no column is specified
- if {$column eq ""} {
+ get {
- # If -local was specified, the upvar is done with a relative stack frame
- # index, and we must take into account the fact that the uplevel moves up
- # the frame one level. If -local was not specified, the an absolute stack
- # frame is passed to upvar, which of course needs no adjustment.
+ lassign $args index column
+ # Set an array reference if no column is specified
+ if {$column eq ""} {
- if { $local_p } {
- uplevel "upvar [expr { $multirow_level_up - 1 }] $name:$index $name"
- } else {
- uplevel "upvar $multirow_level_up $name:$index $name"
- }
+ # If -local was specified, the upvar is done with a relative stack frame
+ # index, and we must take into account the fact that the uplevel moves up
+ # the frame one level. If -local was not specified, the an absolute stack
+ # frame is passed to upvar, which of course needs no adjustment.
- } else {
- # If a column is specified, just return the value for it
- upvar $multirow_level_up $name:$index arr
- if {[info exists arr($column)]} {
- return $arr($column)
- } else {
- ns_log warning "can't obtain template variable form ${name}:${index}: $column"
- return ""
- }
- }
- }
-
- set {
-
- set index [lindex $args 0]
- set column [lindex $args 1]
- set value [lindex $args 2]
-
- if {$column eq {}} {
- error "No column specified to template::multirow set"
- }
-
- # Mutate the value
- upvar $multirow_level_up $name:$index arr
- set arr($column) $value
- return $arr($column)
-
- }
-
- upvar {
- # upvar from wherever the multirow is to the current stack frame
- if { [llength $args] > 0 } {
- set new_name [lindex $args 0]
- } else {
- set new_name $name
- }
- uplevel "
- upvar $multirow_level_up $name:rowcount $new_name:rowcount $name:columns $new_name:columns
- for { set i 1 } { \$i <= \${$new_name:rowcount} } { incr i } {
- upvar $multirow_level_up $name:\$i $new_name:\$i
- }
- "
- }
-
- foreach {
- set code_block [lindex $args 0]
- upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
+ if { $local_p } {
+ uplevel "upvar [expr { $multirow_level_up - 1 }] $name:$index $name"
+ } else {
+ uplevel "upvar $multirow_level_up $name:$index $name"
+ }
- if {![info exists rowcount] || ![info exists columns]} {
- return
- }
-
- # Save values of columns which we might clobber
- if { $unclobber_p } {
- foreach col $columns {
- upvar 1 $col column_value __saved_$col column_save
-
- if { [info exists column_value] } {
- if { [array exists column_value] } {
- array set column_save [array get column_value]
} else {
- set column_save $column_value
+ # If a column is specified, just return the value for it
+ upvar $multirow_level_up $name:$index arr
+ if {[info exists arr($column)]} {
+ return $arr($column)
+ } else {
+ ns_log warning "can't obtain template variable form ${name}:${index}: $column"
+ return ""
+ }
}
-
- # Clear the variable
- unset column_value
- }
}
- }
- for { set i 1 } { $i <= $rowcount } { incr i } {
- # Pull values into variables (and into the array - aks),
- # evaluate the code block, and pull values back out to
- # the array.
-
- upvar $multirow_level_up $name:$i row
+ set {
- foreach column_name $columns {
- upvar 1 $column_name column_value
- if { [info exists row($column_name)] } {
- set column_value $row($column_name)
- } else {
- set column_value ""
- }
- }
-
- # Also set the special var __rownum
- upvar 1 __rownum __rownum
- set __rownum $row(rownum)
+ lassign $args index column value
- set errno [catch { uplevel 1 $code_block } error]
+ if {$column eq {}} {
+ error "No column specified to template::multirow set"
+ }
- switch -- $errno {
- 0 {
- # TCL_OK
- }
- 1 {
- # TCL_ERROR
- error $error $::errorInfo $::errorCode
- }
- 2 {
- # TCL_RETURN
- error "Cannot return from inside template::multirow foreach loop"
- }
- 3 {
- # TCL_BREAK
- break
- }
- 4 {
- # TCL_CONTINUE - just ignore and continue looping.
- }
- default {
- error "template::multirow foreach: Unknown return code: $errno"
- }
- }
+ # Mutate the value
+ upvar $multirow_level_up $name:$index arr
+ set arr($column) $value
+ return $arr($column)
- # Pull the variables into the array.
- foreach column_name $columns {
- upvar 1 $column_name column_value
- if { [info exists column_value] } {
- set row($column_name) $column_value
- }
}
- }
-
- if { $unclobber_p } {
- foreach col $columns {
- upvar 1 $col column_value __saved_$col column_save
-
- # Unset it first, so the road's paved to restoring
- if { [info exists column_value] } {
- unset column_value
- }
-
- # Restore it
- if { [info exists column_save] } {
- if { [array exists column_save] } {
- array set column_value [array get column_save]
+
+ upvar {
+ # upvar from wherever the multirow is to the current stack frame
+ if { [llength $args] > 0 } {
+ set new_name [lindex $args 0]
} else {
- set column_value $column_save
+ set new_name $name
}
-
- # And then remove the saved col
- unset column_save
- }
+ uplevel "
+ upvar $multirow_level_up $name:rowcount $new_name:rowcount $name:columns $new_name:columns
+ for { set i 1 } { \$i <= \${$new_name:rowcount} } { incr i } {
+ upvar $multirow_level_up $name:\$i $new_name:\$i
+ }
+ "
}
- }
- }
- sort {
- # args is a list of names of columns to sort by
- # construct a list which we can lsort
-
- upvar $multirow_level_up $name:rowcount rowcount
-
- if { ![info exists rowcount] } {
- error "Multirow $name does not exist"
- }
+ foreach {
+ set code_block [lindex $args 0]
+ upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
- # Construct list of (rownum,columns appended with a space)
+ if {![info exists rowcount] || ![info exists columns]} {
+ return
+ }
- # Allow for -ascii, -dictionary, -integer, -real, -command