Index: openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl,v
diff -u -N -r1.24 -r1.25
--- openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl	9 Mar 2002 02:00:02 -0000	1.24
+++ openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl	14 Aug 2002 18:53:24 -0000	1.25
@@ -35,8 +35,8 @@
 }
 
 proc db_rdbms_compatible_p {rdbms_test rdbms_pattern} {
-    db_qd_log Debug "The RDBMS_TEST is [db_rdbms_get_type $rdbms_test] - [db_rdbms_get_version $rdbms_test]"
-    db_qd_log Debug "The RDBMS_PATTERN is [db_rdbms_get_type $rdbms_pattern] - [db_rdbms_get_version $rdbms_pattern]"
+    db_qd_log QDDebug "The RDBMS_TEST is [db_rdbms_get_type $rdbms_test] - [db_rdbms_get_version $rdbms_test]"
+    db_qd_log QDDebug "The RDBMS_PATTERN is [db_rdbms_get_type $rdbms_pattern] - [db_rdbms_get_version $rdbms_pattern]"
 
     # If the pattern is for all RDBMS, then yeah, compatible
     if {[empty_string_p [db_rdbms_get_type $rdbms_test]]} {
@@ -45,7 +45,7 @@
 
     # If the RDBMS types are not the same, we have a problem
     if {[db_rdbms_get_type $rdbms_test] != [db_rdbms_get_type $rdbms_pattern]} {
-	db_qd_log Debug "compatibility - RDBMS types are different!"
+	db_qd_log QDDebug "compatibility - RDBMS types are different!"
 	return 0
     }
 
@@ -60,7 +60,7 @@
 	return 1
     }
 
-    db_qd_log Debug "compatibility - version numbers are bad!"
+    db_qd_log QDDebug "compatibility - version numbers are bad!"
     return 0
 }
 
@@ -170,7 +170,7 @@
 
     # If util_memoize, we have to go back up one in the stack
     if {[lindex $proc_name 0] == "util_memoize"} {
-	db_qd_log Debug "util_memoize! going up one level"
+	db_qd_log QDDebug "util_memoize! going up one level"
 	set proc_name [info level [expr "-2 - $added_stack_num"]]
     }
 
@@ -184,12 +184,12 @@
 
 	# TEST
 	for {set i 0} {$i < 6} {incr i} {
-	    if {[catch {db_qd_log Debug "LEVEL=$i= [info level [expr "-1 - $i"]]"} errmsg]} {}
+	    if {[catch {db_qd_log QDDebug "LEVEL=$i= [info level [expr "-1 - $i"]]"} errmsg]} {}
 	}
 
 	# Check the ad_conn stuff
 	if {[ns_conn isconnected]} {
-	    if {[catch {db_qd_log Debug "the ad_conn file is [ad_conn file]"} errmsg]} {}
+	    if {[catch {db_qd_log QDDebug "the ad_conn file is [ad_conn file]"} errmsg]} {}
 	}
 
 	# Now we do a check to see if this is a directly accessed URL or a 
@@ -203,27 +203,27 @@
         switch $proc_name {
 
             ns_sourceproc {
-                db_qd_log Debug "We are in a WWW page, woohoo!"
+                db_qd_log QDDebug "We are in a WWW page, woohoo!"
                 set real_url_p 1
                 set url [ns_conn url]
             }
 
             rp_handle_tcl_request {
-                db_qd_log Debug "We are in a VUH page sourced by rp_handle_tcl_request, woohoo!"
+                db_qd_log QDDebug "We are in a VUH page sourced by rp_handle_tcl_request, woohoo!"
                 set real_url_p 0
                 regsub {\.vuh} [ad_conn file] {} url
                 set url [ad_make_relative_path $url]
                 regsub {^/?packages} $url {} url
             }
 
             template::frm_page_handler {
-                db_qd_log Debug "We are in the template system's form page debugger!"
+                db_qd_log QDDebug "We are in the template system's form page debugger!"
                 set real_url_p 1
                 regsub {\.frm} [ad_conn url] {} url
             }
 
             default {
-                db_qd_log Debug "We are in a WWW page sourced by apm_source, woohoo!"
+                db_qd_log QDDebug "We are in a WWW page sourced by apm_source, woohoo!"
                 set real_url_p 0
                 set url [lindex $proc_name 1]
                 set url [ad_make_relative_path $url]
@@ -243,7 +243,7 @@
 	# We insert the "www" after the package key
 	regexp {^([^\.]*)(.*)} $url all package_key rest
 
-	db_qd_log Debug "package key is $package_key and rest is $rest"
+	db_qd_log QDDebug "package key is $package_key and rest is $rest"
 
 	if {$real_url_p} {
 	    set full_name [db_qd_make_absolute_path "${package_key}.www${rest}." $local_name]
@@ -263,14 +263,14 @@
         # (Openacs - DanW)
 
         set calling_namespace [string range [uplevel [expr 1 + $added_stack_num] {namespace current}] 2 end]
-        db_qd_log Debug "calling namespace = $calling_namespace"
+        db_qd_log QDDebug "calling namespace = $calling_namespace"
 
         if {![string equal $calling_namespace ""] && 
             ![regexp {::} $proc_name all]} {
 
             set proc_name ${calling_namespace}::${proc_name}
         }
-	db_qd_log Debug "proc_name is -$proc_name-"
+	db_qd_log QDDebug "proc_name is -$proc_name-"
 
 	# We use the ad_proc construct!! 
 	# (woohoo, can't believe that was actually useful!)
@@ -279,14 +279,14 @@
 	# probably dealing with one of the bootstrap procs, and so we just
 	# return a bogus proc name
 	if {![nsv_exists api_proc_doc $proc_name]} {
-	    db_qd_log Debug "there is no documented proc with name $proc_name -- we used default SQL"
+	    db_qd_log QDDebug "there is no documented proc with name $proc_name -- we used default SQL"
 	    return [db_qd_null_path]
 	}
 
 	array set doc_elements [nsv_get api_proc_doc $proc_name]
 	set url $doc_elements(script)
 
-	db_qd_log Debug "tcl file is $url"
+	db_qd_log QDDebug "tcl file is $url"
 
 	regsub {.tcl$} $url {} url
 
@@ -298,14 +298,31 @@
 	# We need to remove packages.
 	regexp {^packages\.(.*)} $url all rest
 
-	db_qd_log Debug "TEMP - QD: proc_name is $proc_name"
-	db_qd_log Debug "TEMP - QD: local_name is $local_name"
+	db_qd_log QDDebug "TEMP - QD: proc_name is $proc_name"
+	db_qd_log QDDebug "TEMP - QD: local_name is $local_name"
 
 	# set full_name "acs.$rest.${proc_name}.${local_name}"
 	set full_name [db_qd_make_absolute_path "${rest}.${proc_name}." $local_name]
     }
 
-    db_qd_log Debug "generated fullname of $full_name"
+    db_qd_log QDDebug "generated fullname of $full_name"
+    
+    # aks - making debug output actually useable
+    if {[llength $proc_name] > 1} {
+        
+        set proc_name_with_parameters "[lindex $proc_name 0] "
+        
+        set i 1
+        foreach parameter [lrange $proc_name  1 end] {
+            append proc_name_with_parameters "parameter$i: $parameter " 
+            incr i
+        }
+    } else {
+        set proc_name_with_parameters $proc_name
+    }
+
+    db_qd_log Debug "db_qd_get_fullname: following query in file: $url proc: $proc_name_with_parameters"
+
     return $full_name
 }
 
@@ -381,7 +398,7 @@
     # we're going to assume smaller files for now. Plus, this doesn't happen
     # often.
 
-    db_qd_log Debug "Loading $file_tag"
+    db_qd_log QDDebug "Loading $file_tag"
 
     # Read entire contents
     set whole_file [read $file_pointer]
@@ -392,18 +409,16 @@
     # Iterate and parse out each query
     set parsing_state [db_qd_internal_parse_init $whole_file $file_tag]
     
-    db_qd_log Debug "parsing state - $parsing_state"
-
     # We need this for queries with relative paths
     set acs_file_path [ad_make_relative_path $file_tag]
     set queryname_root [db_qd_internal_get_queryname_root $acs_file_path]
 
-    db_qd_log Debug "queryname root is $queryname_root"
+    db_qd_log Debug "db_qd_internal_load_queries: \n file: [lindex $parsing_state 4] \n default_rdbms: [lindex parsing_state 3] \n queryname_root: $queryname_root"
 
     while {1} {
 	set result [db_qd_internal_parse_one_query $parsing_state]
 	
-	db_qd_log Debug "one parse result -$result-"
+	db_qd_log QDDebug "one parse result -$result-"
 
 	# If we get the empty string, we are done parsing
 	if {$result == ""} {
@@ -413,7 +428,7 @@
 	set one_query [lindex $result 0]
 	set parsing_state [lindex $result 1]
 
-	db_qd_log Debug "loaded one query - [db_fullquery_get_name $one_query]"
+	db_qd_log QDDebug "loaded one query - [db_fullquery_get_name $one_query]"
 
 	# Relative Path for the Query
 	if {[db_qd_relative_path_p [db_fullquery_get_name $one_query]]} {
@@ -429,7 +444,7 @@
 
 	    set one_query $new_fullquery
 
-	    db_qd_log Debug "relative path, replaced name with $new_name"
+	    db_qd_log QDDebug "relative path, replaced name with $new_name"
 	}
 
 	# Store the query
@@ -459,7 +474,7 @@
     }
 
     # See if we have the correct location for this query
-    db_qd_log Debug "query $fullquery_name from [db_fullquery_get_load_location $fullquery_array]"
+    db_qd_log QDDebug "query $fullquery_name from [db_fullquery_get_load_location $fullquery_array]"
 
     # reload the fullquery
     set fullquery_array [nsv_get OACS_FULLQUERIES $fullquery_name]
@@ -481,7 +496,7 @@
 
     set name [db_fullquery_get_name $fullquery]
 
-    db_qd_log Debug "Query $name is compatible! fullquery = $fullquery, name = $name"
+    db_qd_log QDDebug "Query $name is compatible! fullquery = $fullquery, name = $name"
 
     # If we already have a query for that name, we need to
     # figure out which one is *most* compatible.
@@ -554,24 +569,22 @@
 
     # Check that it's a queryset
     if {[xml_node_get_name $root_node] != "queryset"} {
-	db_qd_log Debug "OH OH, error, first node is [xml_node_get_name $root_node]"
-	# CHANGE THIS: throw an error!!!
-	return ""
+	db_qd_log Error "OH OH, error, first node is [xml_node_get_name $root_node] and not 'queryset'"
+        return ""
     }
 
     # Extract the default RDBMS if there is one
     set rdbms_nodes [xml_node_get_children_by_name $root_node rdbms]
     if {[llength $rdbms_nodes] > 0} {
 	set default_rdbms [db_rdbms_parse_from_xml_node [lindex $rdbms_nodes 0]]
-	db_qd_log Debug "Detected DEFAULT RDBMS for whole queryset: $default_rdbms"
+	db_qd_log QDDebug "Detected DEFAULT RDBMS for whole queryset: $default_rdbms"
     } else {
 	set default_rdbms ""
     }
 
     set parsed_stuff [xml_node_get_children_by_name $root_node fullquery]
+    db_qd_log QDDebug "db_qd_internal_parse_init extra info : index: $index; parsed_stuff: $parsed_stuff; parsed_doc: $parsed_doc;"
 
-    db_qd_log Debug "end of parse_init: $index; $parsed_stuff; $parsed_doc; $default_rdbms; $file_path"
-
     return [list $index $parsed_stuff $parsed_doc $default_rdbms $file_path]
 }
 
@@ -591,16 +604,12 @@
     set default_rdbms [lindex $parsing_state 3]
     set file_path [lindex $parsing_state 4]
 
-    db_qd_log Debug "default_rdbms is $default_rdbms"
-
-    db_qd_log Debug "node_list is $node_list with length [llength $node_list] and index $index"
-
     # BASE CASE
     if {[llength $node_list] <= $index} {
 	# Clean up
 	xml_doc_free $parsed_doc
 
-	db_qd_log Debug "Cleaning up, done parsing"
+	db_qd_log QDDebug "Cleaning up, done parsing"
 
 	# return nothing
 	return ""
@@ -627,7 +636,7 @@
 
 # Parse one query from an XML node
 proc db_qd_internal_parse_one_query_from_xml_node {one_query_node {default_rdbms {}} {file_path {}}} {
-    db_qd_log Debug "parsing one query node in XML with name -[xml_node_get_name $one_query_node]-"
+    db_qd_log QDDebug "parsing one query node in XML with name -[xml_node_get_name $one_query_node]-"
 
     # Check that this is a fullquery
     if {[xml_node_get_name $one_query_node] != "fullquery"} {
@@ -644,7 +653,7 @@
     
     # If we have no RDBMS specified, use the default
     if {[llength $rdbms_nodes] == 0} {
-	db_qd_log Debug "Wow, Nelly, no RDBMS for this query, using default rdbms $default_rdbms"
+	db_qd_log QDDebug "Wow, Nelly, no RDBMS for this query, using default rdbms $default_rdbms"
 	set rdbms $default_rdbms
     } else {
 	set rdbms_node [lindex $rdbms_nodes 0]
@@ -666,7 +675,7 @@
     set type [xml_node_get_content [xml_node_get_first_child_by_name $rdbms_node type]]
     set version [xml_node_get_content [xml_node_get_first_child_by_name $rdbms_node version]]
 
-    db_qd_log Debug "PARSER = RDBMS parser - $type - $version"
+    db_qd_log QDDebug "PARSER = RDBMS parser - $type - $version"
 
     return [db_rdbms_create $type $version]
 }
@@ -749,7 +758,7 @@
 	set rest_of_file_content [string range $rest_of_file_content [expr "$first_querytext_close + $querytext_close_len"] end]
     }
 
-    db_qd_log Debug "new massaged file content: \n $new_file_content \n"
+    db_qd_log QDDebug "new massaged file content: \n $new_file_content \n"
 
     return $new_file_content
 }
@@ -761,7 +770,9 @@
 
 proc db_qd_log {level msg} {
     # Centralized DB QD logging
-    # We switch everything to debug for now
-    ns_log $level "QD_LOGGER = $msg"
+    # If you want to debug the DQ, change QDDebug below to Debug
+    if {![string equal "QDDebug" $level]} {
+        ns_log $level "$msg"
+    }
 }