Index: openacs-4/packages/acs-tcl/tcl/00-icanuse-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/00-icanuse-procs.tcl,v diff -u -r1.1.2.7 -r1.1.2.8 --- openacs-4/packages/acs-tcl/tcl/00-icanuse-procs.tcl 18 May 2020 08:35:04 -0000 1.1.2.7 +++ openacs-4/packages/acs-tcl/tcl/00-icanuse-procs.tcl 25 May 2020 10:21:08 -0000 1.1.2.8 @@ -68,6 +68,7 @@ ::acs::register_icanuse "ns_db currenthandles" [acs::cmd_has_subcommand ns_db currenthandles] ::acs::register_icanuse "ns_server unmap" [acs::cmd_has_subcommand ns_server unmap] +::acs::register_icanuse "ns_set keys" [acs::cmd_has_subcommand ns_set keys] ::acs::register_icanuse "ns_conn partialtimes" [acs::cmd_has_subcommand ns_conn partialtimes] ::acs::register_icanuse "ns_conn contentsentlength" [acs::cmd_has_subcommand ns_conn contentsentlength] Index: openacs-4/packages/acs-tcl/tcl/01-database-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/01-database-procs.tcl,v diff -u -r1.1.2.12 -r1.1.2.13 --- openacs-4/packages/acs-tcl/tcl/01-database-procs.tcl 22 May 2020 10:45:41 -0000 1.1.2.12 +++ openacs-4/packages/acs-tcl/tcl/01-database-procs.tcl 25 May 2020 10:21:08 -0000 1.1.2.13 @@ -200,7 +200,7 @@ set pool [ns_db poolname $handle] set dbn $::acs::db_pool_to_dbn($pool) } - + if { ![nsv_exists db_driverkey $dbn] } { # # This ASSUMES that any overriding of this default value via @@ -1504,6 +1504,7 @@ ad_proc -public db_list_of_ns_sets { {-dbn ""} + {-columns_var ""} statement_name sql args @@ -1529,9 +1530,17 @@ set result [list] set selection [db_exec select $db $full_statement_name $sql] - while {[db_getrow $db $selection]} { + while { [db_getrow $db $selection] } { lappend result [ns_set copy $selection] } + if {$columns_var ne ""} { + upvar 1 $columns_var __columns + if {[acs::icanuse "ns_set keys"]} { + set __columns [ns_set keys $selection] + } else { + set __columns [dict keys [ns_set array $selection]] + } + } } return $result @@ -1673,7 +1682,25 @@ # # Execute the query in one sweep, similar to 'db_foreach'. # - set __selections [uplevel 1 [list db_list_of_ns_sets -dbn $dbn $full_statement_name $sql]] + upvar 1 __db_multirow__local_columns local_columns + set __selections [uplevel 1 [list db_list_of_ns_sets -dbn $dbn \ + -columns_var __db_multirow__local_columns \ + $full_statement_name $sql]] + + lappend local_columns {*}$extend + + if { !$append_p || ![info exists columns] } { + # store the list of columns in the var_name:columns variable + set columns $local_columns + } else { + # Check that the columns match, if not throw an error + if { [join [lsort -ascii $local_columns]] ne [join [lsort -ascii $columns]] } { + error "Appending to a multirow with differing columns. + Original columns : [join [lsort -ascii $columns] ", "]. + Columns in this query: [join [lsort -ascii $local_columns] ", "]" "" "ACS_MULTIROW_APPEND_COLUMNS_MISMATCH" + } + } + if {[llength $__selections] == 0} { return } @@ -1695,21 +1722,6 @@ # $local_counter == 0). # if { $local_counter == 0 } { - for { set i 0 } { $i < [ns_set size $selection] } { incr i } { - lappend local_columns [ns_set key $selection $i] - } - lappend local_columns {*}$extend - if { !$append_p || ![info exists columns] } { - # store the list of columns in the var_name:columns variable - set columns $local_columns - } else { - # Check that the columns match, if not throw an error - if { [join [lsort -ascii $local_columns]] ne [join [lsort -ascii $columns]] } { - error "Appending to a multirow with differing columns. - Original columns : [join [lsort -ascii $columns] ", "]. - Columns in this query: [join [lsort -ascii $local_columns] ", "]" "" "ACS_MULTIROW_APPEND_COLUMNS_MISMATCH" - } - } # In case the '-unclobber' switch is specified, save # variables which we might clobber. @@ -2032,7 +2044,6 @@ incr count } } else { - set columns {} db_multirow_helper } Index: openacs-4/packages/acs-tcl/tcl/test/db-proc-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/db-proc-test-procs.tcl,v diff -u -r1.1.2.2 -r1.1.2.3 --- openacs-4/packages/acs-tcl/tcl/test/db-proc-test-procs.tcl 22 May 2020 10:45:41 -0000 1.1.2.2 +++ openacs-4/packages/acs-tcl/tcl/test/db-proc-test-procs.tcl 25 May 2020 10:21:08 -0000 1.1.2.3 @@ -96,14 +96,26 @@ # Create a multirow woth 0 entries and append a row "manually" # For details, see # https://openacs.org/bugtracker/openacs/bug?bug_number=3441 # - db_multirow person_mr noxql { SELECT person_id, first_names, - last_name FROM persons WHERE false + db_multirow person_mr1 noxql { + SELECT person_id, first_names, last_name + FROM persons WHERE false } - - aa_equals "have empty multirow" [template::multirow size person_mr] 0 - template::multirow append person_mr 1234 “Ed” “Grooberman” - aa_equals "have one tuple in multirow" [template::multirow size person_mr] 1 - + + aa_equals "have empty multirow" [template::multirow size person_mr1] 0 + template::multirow append person_mr1 1234 “Ed” “Grooberman” + aa_equals "have one tuple in multirow" [template::multirow size person_mr1] 1 + + aa_equals "columns empty" [template::multirow columns person_mr1] \ + "person_id first_names last_name" + + set user_id [ad_conn user_id] + db_multirow person_mr2 noxql { + SELECT person_id, first_names, last_name + FROM persons where person_id = :user_id + } + aa_equals "columns non-empty" [template::multirow columns person_mr2] \ + "person_id first_names last_name" + aa_log "Test End" } -teardown_code {