ad_library { Database Query API for the ArsDigita Templating System @creation-date 29 September 2000 @author Karl Goldstein (karlg@arsdigita.com) @author Stanislav Freidin (sfreidin@arsdigita.com) @cvs-id $Id: query-procs.tcl,v 1.44 2018/05/08 18:02:44 hectorr Exp $ } namespace eval template {} namespace eval template::query {} # Database Query API for the ArsDigita Templating System # Copyright (C) 1999-2000 ArsDigita Corporation # Authors: Karl Goldstein (karlg@arsdigita.com) # Stanislav Freidin (sfreidin@arsdigita.com) # $Id: query-procs.tcl,v 1.44 2018/05/08 18:02:44 hectorr Exp $ # 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 # (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 # transaction control and handle allocation into the templating query interface # allowing the two db api's to be mixed together. ad_proc -public template::query { statement_name result_name type sql args } { Public interface to template query api. This routine parses the arguments and dispatches to the query command specified by the type argument. @option maxrows Limits the query results of a multirow query to a fixed number of rows. @option cache Cache the query results keyed on an identifier that is unique for both the query and the bind variables used in the query. The cached result reflects any initial specification of maxrows and startrows. @option refresh Force a query to be performed even if it is cached, and refresh the cache.
Only applicable if the cache option is specified as well. Does not affect a previously specified timeout period. @option timeout The maximum period of time for which the cached results are valid in seconds. Only applicable for persistently cached results. @option persistent Cache the query results persistently, so that all subsequent requests use the results. @param statement_name Standard db_api query name @param result_name Tcl variable name when doing an uplevel to set the returned result @param type The query type @param sql The sql to be used for the query @param args Optional args: uplevel, cache, maxrows @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 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)}] } # 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(cache)] && [get_cached_result $result_name $type] } { return $opts(result) } if { ! [info exists opts(maxrows)] } { set opts(maxrows) 10000 } db_with_handle db { set ret_code [template::query::$type $full_statement_name $db $result_name $sql] } 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 into query dispatcher @param db Database handle @param result_name Tcl variable name to use when setting the result @param sql Query to use when processing this command } { upvar opts opts upvar $opts(uplevel) $result_name result set result "" set row [db_exec 0or1row $db $statement_name $sql 3] if { $row ne "" } { # Set the result in the calling frame. set result [ns_set value $row 0] 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 into query dispatcher @param db Database handle @param result_name Tcl variable name to use when setting the result @param sql Query to use when processing this command } { upvar opts opts set row [db_exec 0or1row $db $statement_name $sql 3] if { $row ne "" } { # Set the results in the calling frame. upvar $opts(uplevel) $result_name result set size [ns_set size $row] for { set i 0 } { $i < $size } { incr 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] } 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 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 into query dispatcher @param db Database handle @param result_name Tcl variable name to use when setting the result @param sql Query to use when processing this command @see db_multirow @see template::multirow } { upvar opts opts set row [db_exec select $db $statement_name $sql 3] 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 rowcount 0 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] } { 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 } # set the results in the calling frame upvar $opts(uplevel) ${result_name}:$rowcount result set result(rownum) $rowcount set size [ns_set size $row] for { set i 0 } { $i < $size } { incr i } { set column [ns_set key $row $i] set result($column) [ns_set value $row $i] 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 } { 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 into query dispatcher @param db Database handle @param result_name Tcl variable name to use when setting the result @param sql Query to use when processing this command } { upvar opts opts set row [db_exec select $db $statement_name $sql 3] upvar $opts(uplevel) $result_name rows set rows {} while { [ns_db getrow $db $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 } if { [info exists opts(cache)] } { set opts(result) $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 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 into query dispatcher @param db Database handle @param result_name Tcl variable name to use when setting the result @param sql Query to use when processing this command } { upvar opts opts set row [db_exec select $db $statement_name $sql 3] upvar $opts(uplevel) $result_name rows set groups $opts(groupby) set rows {} while { [ns_db getrow $db $row] } { set values {} set size [ns_set size $row] for { set i 0 } { $i < $size } { incr i } { lappend values [ns_set value $row $i] } # build the values on which to group set group_values {} foreach group $groups { lappend group_values [ns_set get $row $group] } 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 into query dispatcher @param db Database handle @param result_name Tcl variable name to use when setting the result @param sql Query to use when processing this command } { upvar opts opts set row [db_exec select $db $statement_name $sql 3] upvar $opts(uplevel) $result_name rows set rows {} while { [ns_db getrow $db $row] } { lappend rows [ns_set value $row 0] } 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 into query dispatcher @param db Database handle @param result_name Tcl variable name to use when setting the result @param sql Query to use when processing this command } { upvar opts opts db_exec dml $db $statement_name $sql 3 } ad_proc -private get_cached_result { name type } { Looks in the appropriate cache for the named query result If a valid result is found, then sets the result in the returning stack frame. @param name Name of cached result-set @param type Type of query @return 1 if result was successfully retrieved, 0 if failed } { upvar opts opts set cache_key $opts(cache) set success 0 if { [info exists opts(persistent)] } { 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 { # 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 } } } } else { if { [info exists ::__template_query_request_cache($cache_key)] } { set cached_result $::__template_query_request_cache($cache_key) set success 1 } } if { $success } { switch -- $type { multirow { 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 { 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 } } } return $success } ad_proc -private set_cached_result {} { Places a query result in the appropriate cache. } { upvar opts opts if { ! [info exists opts(result)] } { return } 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 ::__template_query_request_cache($cache_key) $opts(result) } } ad_proc -private template::query::flush_cache { cache_match } { Flush the cached queries where the query name matches the specified string match @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 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) } } } ad_proc -public multirow { {-ulevel 1} {-local:boolean} -unclobber:boolean op name args } { 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:: namespace. @see template::multirow @see template::query::multirow } - ad_proc -public template::multirow { {-ulevel 1} {-local:boolean} -unclobber:boolean command name args } { Create/Manipulate a multirow datasource (for use with <multiple> tags)
[template::adp_level]
scope, which
is the default.
@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
@param name Name of the multirow datasource
@param args optional args
@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,
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
}
}
switch -exact $command {
create {
upvar $multirow_level_up $name:rowcount rowcount $name:columns columns
set rowcount 0
set columns $args
}
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
}
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 {}
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]
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
}
columns {
upvar $multirow_level_up $name:columns columns
if { [template::util::is_nil columns] } {
return {}
}
return $columns
}
get {
lassign $args index column
# Set an array reference if no column is specified
if {$column eq ""} {
# 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.
if { $local_p } {
uplevel "upvar [expr { $multirow_level_up - 1 }] $name:$index $name"
} else {
uplevel "upvar $multirow_level_up $name:$index $name"
}
} 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 {
lassign $args index column value
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 {![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
}
# 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
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)
set errno [catch { uplevel 1 $code_block } error]
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"
}
}
# 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]
} else {
set column_value $column_save
}
# And then remove the saved col
unset column_save
}
}
}
}
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"
}
# Construct list of (rownum,columns appended with a space)
# Allow for -ascii, -dictionary, -integer, -real, -command