Index: openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl,v diff -u -r1.19.2.6 -r1.19.2.7 --- openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 7 Jun 2003 01:47:32 -0000 1.19.2.6 +++ openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 2 Jul 2003 19:43:41 -0000 1.19.2.7 @@ -95,9 +95,9 @@ } { set available_pools [nsv_get db_available_pools .] if { $n < [llength $available_pools] } { - set pool [lindex $available_pools $n] + set pool [lindex $available_pools $n] } else { - return -code error "Ran out of database pools ($available_pools)" + return -code error "Ran out of database pools ($available_pools)" } return $pool } @@ -113,23 +113,23 @@ # Initialize bookkeeping variables. if { ![info exists db_state(handles)] } { - set db_state(handles) [list] + set db_state(handles) [list] } if { ![info exists db_state(n_handles_used)] } { - set db_state(n_handles_used) 0 + set db_state(n_handles_used) 0 } if { $db_state(n_handles_used) >= [llength $db_state(handles)] } { - set pool [db_nth_pool_name $db_state(n_handles_used)] - set start_time [clock clicks] - set errno [catch { - set db [ns_db gethandle $pool] - } error] - ad_call_proc_if_exists ds_collect_db_call $db gethandle "" $pool $start_time $errno $error - lappend db_state(handles) $db - if { $errno } { - global errorInfo errorCode - return -code $errno -errorcode $errorCode -errorinfo $errorInfo $error - } + set pool [db_nth_pool_name $db_state(n_handles_used)] + set start_time [clock clicks] + set errno [catch { + set db [ns_db gethandle $pool] + } error] + ad_call_proc_if_exists ds_collect_db_call $db gethandle "" $pool $start_time $errno $error + lappend db_state(handles) $db + if { $errno } { + global errorInfo errorCode + return -code $errno -errorcode $errorCode -errorinfo $errorInfo $error + } } set my_dbh [lindex $db_state(handles) $db_state(n_handles_used)] set dbh $my_dbh @@ -144,7 +144,7 @@ # Unset dbh, so any subsequence use of this variable will bomb. if { [info exists dbh] } { - unset dbh + unset dbh } @@ -153,18 +153,18 @@ # errno = 3 or 4 give undefined results if { $errno == 1 } { - - # A real error occurred - global errorInfo errorCode - return -code $errno -errorcode $errorCode -errorinfo $errorInfo $error + + # A real error occurred + global errorInfo errorCode + return -code $errno -errorcode $errorCode -errorinfo $errorInfo $error } if { $errno == 2 } { - - # The code block called a "return", so pass the message through but don't try - # to return errorCode or errorInfo since they may not exist - - return -code $errno $error + + # The code block called a "return", so pass the message through but don't try + # to return errorCode or errorInfo since they may not exist + + return -code $errno $error } } @@ -176,25 +176,25 @@ global db_state if { [info exists db_state(n_handles_used)] } { - # Examine the elements at the end of db_state(handles), killing off - # handles that are unused and not engaged in a transaction. + # Examine the elements at the end of db_state(handles), killing off + # handles that are unused and not engaged in a transaction. - set index_to_examine [expr { [llength $db_state(handles)] - 1 }] - while { $index_to_examine >= $db_state(n_handles_used) } { - set db [lindex $db_state(handles) $index_to_examine] + set index_to_examine [expr { [llength $db_state(handles)] - 1 }] + while { $index_to_examine >= $db_state(n_handles_used) } { + set db [lindex $db_state(handles) $index_to_examine] - # Stop now if the handle is part of a transaction. - if { [info exists db_state(transaction_level,$db)] && \ - $db_state(transaction_level,$db) > 0 } { - break - } + # Stop now if the handle is part of a transaction. + if { [info exists db_state(transaction_level,$db)] && \ + $db_state(transaction_level,$db) > 0 } { + break + } - set start_time [clock clicks] - ns_db releasehandle $db - ad_call_proc_if_exists ds_collect_db_call $db releasehandle "" "" $start_time 0 "" - incr index_to_examine -1 - } - set db_state(handles) [lrange $db_state(handles) 0 $index_to_examine] + set start_time [clock clicks] + ns_db releasehandle $db + ad_call_proc_if_exists ds_collect_db_call $db releasehandle "" "" $start_time 0 "" + incr index_to_examine -1 + } + set db_state(handles) [lrange $db_state(handles) 0 $index_to_examine] } } @@ -208,7 +208,7 @@ set errno [catch { return [ns_db getrow $db $selection] } error] ad_call_proc_if_exists ds_collect_db_call $db getrow "" "" $start_time $errno $error if { $errno == 2 } { - return $error + return $error } global errorInfo errorCode return -code $errno -errorinfo $errorInfo -errorcode $errorCode $error @@ -227,14 +227,14 @@ ad_arg_parser { default bind } $args db_with_handle db { - set selection [db_exec 0or1row $db $full_name $sql] + set selection [db_exec 0or1row $db $full_name $sql] } if { [empty_string_p $selection] } { - if { [info exists default] } { - return $default - } - return -code error "Selection did not return a value, and no default was provided" + if { [info exists default] } { + return $default + } + return -code error "Selection did not return a value, and no default was provided" } return [ns_set value $selection 0] } @@ -244,7 +244,7 @@

Returns a Tcl list of the values in the first column of the result of SQL query sql. If sql doesn't return any rows, returns an empty list. Analogous to database_to_tcl_list. - + } { ad_arg_parser { bind } $args @@ -253,11 +253,11 @@ # Can't use db_foreach here, since we need to use the ns_set directly. db_with_handle db { - set selection [db_exec select $db $full_statement_name $sql] - set result [list] - while { [db_getrow $db $selection] } { - lappend result [ns_set value $selection 0] - } + set selection [db_exec select $db $full_statement_name $sql] + set result [list] + while { [db_getrow $db $selection] } { + lappend result [ns_set value $selection 0] + } } return $result } @@ -278,17 +278,17 @@ # Can't use db_foreach here, since we need to use the ns_set directly. db_with_handle db { - set selection [db_exec select $db $full_statement_name $sql] + set selection [db_exec select $db $full_statement_name $sql] - set result [list] + set result [list] - while { [db_getrow $db $selection] } { - set this_result [list] - for { set i 0 } { $i < [ns_set size $selection] } { incr i } { - lappend this_result [ns_set value $selection $i] - } - lappend result $this_result - } + while { [db_getrow $db $selection] } { + set this_result [list] + for { set i 0 } { $i < [ns_set size $selection] } { incr i } { + lappend this_result [ns_set value $selection $i] + } + lappend result $this_result + } } return $result } @@ -330,7 +330,7 @@

db_foreach statement-name sql [ -bind bind_set_id | -bind bind_value_list ] \ [ -column_array array_name | -column_set set_name ] \ - code_block [ if_no_rows if_no_rows_block ] + code_block [ if_no_rows if_no_rows_block ]
@@ -343,10 +343,10 @@

Example:

db_foreach greeble_query "select foo, bar from greeble" {
-	ns_write "<li>foo=$foo; bar=$bar\n"
+        ns_write "<li>foo=$foo; bar=$bar\n"
     } if_no_rows {
-	# This block is optional.
-	ns_write "<li>No greebles!\n"
+        # This block is optional.
+        ns_write "<li>No greebles!\n"
     }
} { @@ -358,90 +358,91 @@ # Do some syntax checking. set arglength [llength $args] if { $arglength == 1 } { - # Have only a code block. - set code_block [lindex $args 0] + # Have only a code block. + set code_block [lindex $args 0] } elseif { $arglength == 3 } { - # Should have code block + if_no_rows + code block. - if { ![string equal [lindex $args 1] "if_no_rows"] && ![string equal [lindex $args 1] "else"] } { - return -code error "Expected if_no_rows as second-to-last argument" - } - set code_block [lindex $args 0] - set if_no_rows_code_block [lindex $args 2] + # Should have code block + if_no_rows + code block. + if { ![string equal [lindex $args 1] "if_no_rows"] && ![string equal [lindex $args 1] "else"] } { + return -code error "Expected if_no_rows as second-to-last argument" + } + set code_block [lindex $args 0] + set if_no_rows_code_block [lindex $args 2] } else { - return -code error "Expected 1 or 3 arguments after switches" + return -code error "Expected 1 or 3 arguments after switches" } if { [info exists column_array] && [info exists column_set] } { - return -code error "Can't specify both column_array and column_set" + return -code error "Can't specify both column_array and column_set" } if { [info exists column_array] } { - upvar 1 $column_array array_val + upvar 1 $column_array array_val } if { [info exists column_set] } { - upvar 1 $column_set selection + upvar 1 $column_set selection } db_with_handle db { - set selection [db_exec select $db $full_statement_name $sql] + set selection [db_exec select $db $full_statement_name $sql] - set counter 0 - while { [db_getrow $db $selection] } { - incr counter - if { [info exists array_val] } { - unset array_val - } - if { ![info exists column_set] } { - for { set i 0 } { $i < [ns_set size $selection] } { incr i } { - if { [info exists column_array] } { - set array_val([ns_set key $selection $i]) [ns_set value $selection $i] - } else { - upvar 1 [ns_set key $selection $i] column_value - set column_value [ns_set value $selection $i] - } - } - } - set errno [catch { uplevel 1 $code_block } error] + set counter 0 + while { [db_getrow $db $selection] } { + incr counter + if { [info exists array_val] } { + unset array_val + } + if { ![info exists column_set] } { + for { set i 0 } { $i < [ns_set size $selection] } { incr i } { + if { [info exists column_array] } { + set array_val([ns_set key $selection $i]) [ns_set value $selection $i] + } else { + upvar 1 [ns_set key $selection $i] column_value + set column_value [ns_set value $selection $i] + } + } + } + set errno [catch { uplevel 1 $code_block } error] - # Handle or propagate the error. Can't use the usual "return -code $errno..." trick - # due to the db_with_handle wrapped around this loop, so propagate it explicitly. - switch $errno { - 0 { - # TCL_OK - } - 1 { - # TCL_ERROR - global errorInfo errorCode - error $error $errorInfo $errorCode - } - 2 { - # TCL_RETURN - error "Cannot return from inside a db_foreach loop" - } - 3 { - # TCL_BREAK - ns_db flush $db - break - } - 4 { - # TCL_CONTINUE - just ignore and continue looping. - } - default { - error "Unknown return code: $errno" - } - } - } - # If the if_no_rows_code is defined, go ahead and run it. - if { $counter == 0 && [info exists if_no_rows_code_block] } { - uplevel 1 $if_no_rows_code_block - } + # Handle or propagate the error. Can't use the usual "return -code $errno..." trick + # due to the db_with_handle wrapped around this loop, so propagate it explicitly. + switch $errno { + 0 { + # TCL_OK + } + 1 { + # TCL_ERROR + global errorInfo errorCode + error $error $errorInfo $errorCode + } + 2 { + # TCL_RETURN + error "Cannot return from inside a db_foreach loop" + } + 3 { + # TCL_BREAK + ns_db flush $db + break + } + 4 { + # TCL_CONTINUE - just ignore and continue looping. + } + default { + error "Unknown return code: $errno" + } + } + } + # If the if_no_rows_code is defined, go ahead and run it. + if { $counter == 0 && [info exists if_no_rows_code_block] } { + uplevel 1 $if_no_rows_code_block + } } } ad_proc -public db_multirow { -local:boolean -append:boolean + -unclobber:boolean {-extend {}} var_name statement_name @@ -452,7 +453,7 @@
db_multirow [ -local ] [ -append ] [ -extend column_list ] \ var-name statement-name sql [ -bind bind_set_id | -bind bind_value_list ] \ - code_block [ if_no_rows if_no_rows_block ] + code_block [ if_no_rows if_no_rows_block ]
@@ -538,36 +539,55 @@ # Do some syntax checking. set arglength [llength $args] if { $arglength == 0 } { - # No code block. - set code_block "" + # No code block. + set code_block "" } elseif { $arglength == 1 } { - # Have only a code block. - set code_block [lindex $args 0] + # Have only a code block. + set code_block [lindex $args 0] } elseif { $arglength == 3 } { - # Should have code block + if_no_rows + code block. - if { ![string equal [lindex $args 1] "if_no_rows"] \ - && ![string equal [lindex $args 1] "else"] } { - return -code error "Expected if_no_rows as second-to-last argument" - } - set code_block [lindex $args 0] - set if_no_rows_code_block [lindex $args 2] + # Should have code block + if_no_rows + code block. + if { ![string equal [lindex $args 1] "if_no_rows"] \ + && ![string equal [lindex $args 1] "else"] } { + return -code error "Expected if_no_rows as second-to-last argument" + } + set code_block [lindex $args 0] + set if_no_rows_code_block [lindex $args 2] } else { - return -code error "Expected 1 or 3 arguments after switches" + return -code error "Expected 1 or 3 arguments after switches" } upvar $level_up "$var_name:rowcount" counter upvar $level_up "$var_name:columns" columns if { !$append_p || ![info exists counter]} { - set counter 0 + set counter 0 } db_with_handle db { - set selection [db_exec select $db $full_statement_name $sql] + set selection [db_exec select $db $full_statement_name $sql] set local_counter 0 - while { [db_getrow $db $selection] } { + # Make sure 'next_row' array doesn't exist + # The this_row and next_row variables are used to always execute the code block one result set row behind, + # so that we have the opportunity to peek ahead, which allows us to do group by's inside + # the multirow generation + # Also make the 'next_row' array available as a magic __db_multirow__next_row variable + upvar 1 __db_multirow__next_row next_row + if { [info exists next_row] } { + unset next_row + } + + set more_rows_p 1 + while { 1 } { + + if { $more_rows_p } { + set more_rows_p [db_getrow $db $selection] + } else { + break + } + # Setup the 'columns' part, now that we know the columns in the result set + # And save variables which we might clobber, if '-unclobber' switch is specified. if { $local_counter == 0 } { for { set i 0 } { $i < [ns_set size $selection] } { incr i } { lappend local_columns [ns_set key $selection $i] @@ -584,87 +604,231 @@ Columns in this query: [join [lsort -ascii $local_columns] ", "]" "" "ACS_MULTIROW_APPEND_COLUMNS_MISMATCH" } } + + # Save values of columns which we might clobber + if { $unclobber_p && ![empty_string_p $code_block] } { + 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 + } + } + } } - if { [empty_string_p $code_block] } { - # No code block - pull values directly into the var_name array. - upvar $level_up "$var_name:[expr {$counter+1}]" array_val - for { set i 0 } { $i < [ns_set size $selection] } { incr i } { - set array_val([ns_set key $selection $i]) \ - [ns_set value $selection $i] - } - } else { - # Pull values from the query into local variables - for { set i 0 } { $i < [ns_set size $selection] } { incr i } { - upvar 1 [ns_set key $selection $i] column_value - set column_value [ns_set value $selection $i] - } + if { [empty_string_p $code_block] } { + # No code block - pull values directly into the var_name array. - # Initialize the "extend" columns to the empty string - foreach column_name $extend { - upvar 1 $column_name column_value - set column_value "" + # The extra loop after the last row is only for when there's a code block + if { !$more_rows_p } { + break } + incr counter + upvar $level_up "$var_name:$counter" array_val + set array_val(rownum) $counter + for { set i 0 } { $i < [ns_set size $selection] } { incr i } { + set array_val([ns_set key $selection $i]) \ + [ns_set value $selection $i] + } + } else { + # There is a code block to execute - # Execute the code block - set errno [catch { uplevel 1 $code_block } error] + # Copy next_row to this_row, if it exists + if { [info exists this_row] } { + unset this_row + } + set array_get_next_row [array get next_row] + if { ![empty_string_p $array_get_next_row] } { + array set this_row [array get next_row] + } - # Handle or propagate the error. Can't use the usual - # "return -code $errno..." trick due to the db_with_handle - # wrapped around this loop, so propagate it explicitly. - switch $errno { - 0 { - # TCL_OK - } - 1 { - # TCL_ERROR - global errorInfo errorCode - error $error $errorInfo $errorCode - } - 2 { - # TCL_RETURN - error "Cannot return from inside a db_multirow loop" - } - 3 { - # TCL_BREAK - ns_db flush $db - break - } - 4 { - # TCL_CONTINUE - continue - } - default { - error "Unknown return code: $errno" - } - } + # Pull values from the query into next_row + if { [info exists next_row] } { + unset next_row + } + if { $more_rows_p } { + for { set i 0 } { $i < [ns_set size $selection] } { incr i } { + set next_row([ns_set key $selection $i]) [ns_set value $selection $i] + } + } - # Pull the local variables back out and into the array. - upvar $level_up "$var_name:[expr {$counter + 1}]" array_val - foreach column_name $columns { - upvar 1 $column_name column_value - set array_val($column_name) $column_value - } - } - incr counter + ns_log Notice "LARS: counter = $counter ; this_row? [info exists this_row] ; next_row? [info exists next_row]" + + # Process the row + if { [info exists this_row] } { + # Pull values from this_row into local variables + foreach name [array names this_row] { + upvar 1 $name column_value + set column_value $this_row($name) + } + + # Initialize the "extend" columns to the empty string + foreach column_name $extend { + upvar 1 $column_name column_value + set column_value "" + } + + # Execute the code block + set errno [catch { uplevel 1 $code_block } error] + + # Handle or propagate the error. Can't use the usual + # "return -code $errno..." trick due to the db_with_handle + # wrapped around this loop, so propagate it explicitly. + switch $errno { + 0 { + # TCL_OK + } + 1 { + # TCL_ERROR + global errorInfo errorCode + error $error $errorInfo $errorCode + } + 2 { + # TCL_RETURN + error "Cannot return from inside a db_multirow loop" + } + 3 { + # TCL_BREAK + ns_db flush $db + break + } + 4 { + # TCL_CONTINUE + continue + } + default { + error "Unknown return code: $errno" + } + } + + # Pull the local variables back out and into the array. + incr counter + upvar $level_up "$var_name:$counter" array_val + set array_val(rownum) $counter + foreach column_name $columns { + upvar 1 $column_name column_value + set array_val($column_name) $column_value + } + } + + } incr local_counter - set array_val(rownum) $counter - } + } } + # Restore values of columns which we've saved + if { $unclobber_p && ![empty_string_p $code_block] && $local_counter > 0 } { + 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 + } + } + } + # Unset the next_row variable, just in case + if { [info exists next_row] } { + unset next_row + } + # If the if_no_rows_code is defined, go ahead and run it. if { $counter == 0 && [info exists if_no_rows_code_block] } { - uplevel 1 $if_no_rows_code_block + uplevel 1 $if_no_rows_code_block } } +ad_proc -public db_multirow_group_last_row_p { + {-column:required} +} { + Used inside the code_block to db_multirow to ask whether this row is the last row + before the value of 'column' changes, or the last row of the result set. + +

+ This is useful when you want to build up a multirow for a master/slave table pair, + where you only want one row per row in the master table, but you want to include + data from the slave table in a column of the multirow. + +

+ + Here's an example: + +

+    # Initialize the lines variable to hold a list of order line summaries
+    set lines [list]
+
+    # Start building the multirow. We add the dynamic column 'lines_pretty', which will
+    # contain the pretty summary of the order lines.
+    db_multirow -extend { lines_pretty } orders select_orders_and_lines { 
+        select o.order_id, 
+               o.customer_name,
+               l.item_name,
+               l.quantity
+        from   orders o,
+               order_lines l
+        where  l.order_id = o.order_id
+        order  by o.order_id, l.item_name
+    } {
+        lappend lines "$quantity $item_name"
+        if { [db_multirow_group_last_row_p -column order_id] } {
+            # Last row of this order, prepare the pretty version of the order lines
+            set lines_pretty [join $lines ", "]
+
+            # Reset the lines list, so we start from a fresh with the next row
+            set lines [list]
+        } else {
+            # There are yet more order lines to come for this order,
+            # continue until we've collected all the order lines
+            # The 'continue' keyword means this line will not be added to the resulting multirow
+            continue
+        }
+    }
+
+ + @author Lars Pind (lars@collaboraid.biz) + + @param column The name of the column defining the groups. + + @return 1 if this is the last row before the column value changes, 0 otherwise. +} { + upvar 1 __db_multirow__next_row next_row + if { ![info exists next_row] } { + # If there is no next row, this is the last row + return 1 + } + upvar 1 $column column_value + # Otherwise, it's the last row in the group if the next row has a different value than this row + return [expr ![string equal $column_value $next_row($column)]] +} + + ad_proc db_0or1row { statement_name sql args } { Usage:
db_0or1row statement-name sql [ -bind bind_set_id | -bind bind_value_list ] \ [ -column_array array_name | -column_set set_name ] - +

Performs the SQL query sql. If a row is returned, sets variables @@ -679,37 +843,37 @@ set full_statement_name [db_qd_get_fullname $statement_name] if { [info exists column_array] && [info exists column_set] } { - return -code error "Can't specify both column_array and column_set" + return -code error "Can't specify both column_array and column_set" } if { [info exists column_array] } { - upvar 1 $column_array array_val - if { [info exists array_val] } { - unset array_val - } + upvar 1 $column_array array_val + if { [info exists array_val] } { + unset array_val + } } if { [info exists column_set] } { - upvar 1 $column_set selection + upvar 1 $column_set selection } db_with_handle db { - set selection [db_exec 0or1row $db $full_statement_name $sql] + set selection [db_exec 0or1row $db $full_statement_name $sql] } if { [empty_string_p $selection] } { - return 0 + return 0 } if { [info exists column_array] } { - for { set i 0 } { $i < [ns_set size $selection] } { incr i } { - set array_val([ns_set key $selection $i]) [ns_set value $selection $i] - } + for { set i 0 } { $i < [ns_set size $selection] } { incr i } { + set array_val([ns_set key $selection $i]) [ns_set value $selection $i] + } } elseif { ![info exists column_set] } { - for { set i 0 } { $i < [ns_set size $selection] } { incr i } { - upvar 1 [ns_set key $selection $i] value - set value [ns_set value $selection $i] - } + for { set i 0 } { $i < [ns_set size $selection] } { incr i } { + upvar 1 [ns_set key $selection $i] value + set value [ns_set value $selection $i] + } } return 1 @@ -720,7 +884,7 @@

db_1row statement-name sql [ -bind bind_set_id | -bind bind_value_list ] \ [ -column_array array_name | -column_set set_name ] - +

Performs the SQL query sql. If a row is returned, sets variables @@ -730,7 +894,7 @@ } { if { ![uplevel db_0or1row $args] } { - return -code error "Query did not return any rows." + return -code error "Query did not return any rows." } } @@ -753,7 +917,7 @@ In this example, db_dml triggers an error, so control passes to the on_error block which prints a readable error.

     db_transaction {
-	db_dml test "nonsense"
+        db_dml test "nonsense"
     } on_error {
         ad_return_error "Error in blah/foo/bar" "The error was: $errmsg"
     }
@@ -764,9 +928,9 @@
     transaction is immediately halted and aborted.
     
     db_transaction {
-	db_dml test {insert into footest values(1)}
-	nonsense
-	db_dml test {insert into footest values(2)}
+        db_dml test {insert into footest values(1)}
+        nonsense
+        db_dml test {insert into footest values(2)}
     } 
     
@@ -778,67 +942,67 @@ set arg_c [llength $args] if { $arg_c != 0 && $arg_c != 2 } { - # Either this is a transaction with no error handling or there must be an on_error { code } block. - error $syn_err + # Either this is a transaction with no error handling or there must be an on_error { code } block. + error $syn_err } elseif { $arg_c == 2 } { - # We think they're specifying an on_error block - if { [string compare [lindex $args 0] "on_error"] } { - # Unexpected: they put something besides on_error as a connector. - error $syn_err - } else { - # Success! We got an on_error code block. - set on_error [lindex $args 1] - } + # We think they're specifying an on_error block + if { [string compare [lindex $args 0] "on_error"] } { + # Unexpected: they put something besides on_error as a connector. + error $syn_err + } else { + # Success! We got an on_error code block. + set on_error [lindex $args 1] + } } # Make the error message and database handle available to the on_error block. upvar errmsg errmsg db_with_handle db { - # Preserve the handle, since db_with_handle kills it after executing - # this block. - set dbh $db - # Remember that there's a transaction happening on this handle. - if { ![info exists db_state(transaction_level,$dbh)] } { - set db_state(transaction_level,$dbh) 0 - } - set level [incr db_state(transaction_level,$dbh)] - if { $level == 1 } { - ns_db dml $dbh "begin transaction" - } + # Preserve the handle, since db_with_handle kills it after executing + # this block. + set dbh $db + # Remember that there's a transaction happening on this handle. + if { ![info exists db_state(transaction_level,$dbh)] } { + set db_state(transaction_level,$dbh) 0 + } + set level [incr db_state(transaction_level,$dbh)] + if { $level == 1 } { + ns_db dml $dbh "begin transaction" + } } # Execute the transaction code. set errno [catch { - uplevel 1 $transaction_code + uplevel 1 $transaction_code } errmsg] incr db_state(transaction_level,$dbh) -1 set err_p 0 switch $errno { - 0 { - # TCL_OK - } - 2 { - # TCL_RETURN - } - 3 { - # TCL_BREAK - Abort the transaction and do the break. - ns_db dml $dbh "abort transaction" - db_release_unused_handles - break - } - 4 { - # TCL_CONTINUE - just ignore. - } - default { - # TCL_ERROR or unknown error code: Its a real error. - set err_p 1 - } + 0 { + # TCL_OK + } + 2 { + # TCL_RETURN + } + 3 { + # TCL_BREAK - Abort the transaction and do the break. + ns_db dml $dbh "abort transaction" + db_release_unused_handles + break + } + 4 { + # TCL_CONTINUE - just ignore. + } + default { + # TCL_ERROR or unknown error code: Its a real error. + set err_p 1 + } } if { $err_p || [db_abort_transaction_p]} { - # An error was triggered or the transaction has been aborted. - db_abort_transaction - if { [info exists on_error] && ![empty_string_p $on_error] } { + # An error was triggered or the transaction has been aborted. + db_abort_transaction + if { [info exists on_error] && ![empty_string_p $on_error] } { if {[string equal postgresql [db_type]]} { @@ -867,94 +1031,94 @@ } - # An on_error block exists, so execute it. + # An on_error block exists, so execute it. - set errno [catch { - uplevel 1 $on_error - } on_errmsg] + set errno [catch { + uplevel 1 $on_error + } on_errmsg] - # Determine what do with the error. - set err_p 0 - switch $errno { - 0 { - # TCL_OK - } - - 2 { - # TCL_RETURN - } - 3 { - # TCL_BREAK - ns_db dml $dbh "abort transaction" - db_release_unused_handles - break - } - 4 { - # TCL_CONTINUE - just ignore. - } - default { - # TCL_ERROR or unknown error code: Its a real error. - set err_p 1 - } - } + # Determine what do with the error. + set err_p 0 + switch $errno { + 0 { + # TCL_OK + } + + 2 { + # TCL_RETURN + } + 3 { + # TCL_BREAK + ns_db dml $dbh "abort transaction" + db_release_unused_handles + break + } + 4 { + # TCL_CONTINUE - just ignore. + } + default { + # TCL_ERROR or unknown error code: Its a real error. + set err_p 1 + } + } - if { $err_p } { - # An error was generated from the $on_error block. - if { $level == 1} { - # We're at the top level, so we abort the transaction. - set db_state(db_abort_p,$dbh) 0 - ns_db dml $dbh "abort transaction" - } - # We throw this error because it was thrown from the error handling code that the programmer must fix. - global errorInfo errorCode - error $on_errmsg $errorInfo $errorCode - } else { - # Good, no error thrown by the on_error block. - if { [db_abort_transaction_p] } { - # This means we should abort the transaction. - if { $level == 1 } { - set db_state(db_abort_p,$dbh) 0 - ns_db dml $dbh "abort transaction" - # We still have the transaction generated error. We don't want to throw it, so we log it. - ns_log Error "Aborting transaction due to error:\n$errmsg" - } else { - # Propagate the error up to the next level. - global errorInfo errorCode - error $errmsg $errorInfo $errorCode - } - } else { - # The on_error block has resolved the transaction error. If we're at the top, commit and exit. - # Otherwise, we continue on through the lower transaction levels. - if { $level == 1} { - ns_db dml $dbh "end transaction" - } - } - } - } else { - # There is no on_error block, yet there is an error, so we propagate it. - if { $level == 1 } { - set db_state(db_abort_p,$dbh) 0 - ns_db dml $dbh "abort transaction" - global errorInfo errorCode - error "Transaction aborted: $errmsg" $errorInfo $errorCode - } else { - db_abort_transaction - global errorInfo errorCode - error $errmsg $errorInfo $errorCode - } - } + if { $err_p } { + # An error was generated from the $on_error block. + if { $level == 1} { + # We're at the top level, so we abort the transaction. + set db_state(db_abort_p,$dbh) 0 + ns_db dml $dbh "abort transaction" + } + # We throw this error because it was thrown from the error handling code that the programmer must fix. + global errorInfo errorCode + error $on_errmsg $errorInfo $errorCode + } else { + # Good, no error thrown by the on_error block. + if { [db_abort_transaction_p] } { + # This means we should abort the transaction. + if { $level == 1 } { + set db_state(db_abort_p,$dbh) 0 + ns_db dml $dbh "abort transaction" + # We still have the transaction generated error. We don't want to throw it, so we log it. + ns_log Error "Aborting transaction due to error:\n$errmsg" + } else { + # Propagate the error up to the next level. + global errorInfo errorCode + error $errmsg $errorInfo $errorCode + } + } else { + # The on_error block has resolved the transaction error. If we're at the top, commit and exit. + # Otherwise, we continue on through the lower transaction levels. + if { $level == 1} { + ns_db dml $dbh "end transaction" + } + } + } + } else { + # There is no on_error block, yet there is an error, so we propagate it. + if { $level == 1 } { + set db_state(db_abort_p,$dbh) 0 + ns_db dml $dbh "abort transaction" + global errorInfo errorCode + error "Transaction aborted: $errmsg" $errorInfo $errorCode + } else { + db_abort_transaction + global errorInfo errorCode + error $errmsg $errorInfo $errorCode + } + } } else { - # There was no error from the transaction code. - if { [db_abort_transaction_p] } { - # The user requested the transaction be aborted. - if { $level == 1 } { - set db_state(db_abort_p,$dbh) 0 - ns_db dml $dbh "abort transaction" - } - } elseif { $level == 1 } { - # Success! No errors and no requested abort. Commit. - ns_db dml $dbh "end transaction" - } + # There was no error from the transaction code. + if { [db_abort_transaction_p] } { + # The user requested the transaction be aborted. + if { $level == 1 } { + set db_state(db_abort_p,$dbh) 0 + ns_db dml $dbh "abort transaction" + } + } elseif { $level == 1 } { + # Success! No errors and no requested abort. Commit. + ns_db dml $dbh "end transaction" + } } } @@ -967,21 +1131,21 @@ } { global db_state db_with_handle db { - # We set the abort flag to true. - set db_state(db_abort_p,$db) 1 + # We set the abort flag to true. + set db_state(db_abort_p,$db) 1 } } ad_proc db_abort_transaction_p {} { } { global db_state db_with_handle db { - if { [info exists db_state(db_abort_p,$db)] } { - return $db_state(db_abort_p,$db) - } else { - # No abort flag registered, so we assume everything is ok. - return 0 - } + if { [info exists db_state(db_abort_p,$db)] } { + return $db_state(db_abort_p,$db) + } else { + # No abort flag registered, so we assume everything is ok. + return 0 + } } }