Index: openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/00-database-procs.tcl,v
diff -u -r1.48.2.1 -r1.48.2.2
--- openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl	18 Mar 2004 16:51:46 -0000	1.48.2.1
+++ openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl	25 Mar 2004 12:52:37 -0000	1.48.2.2
@@ -803,7 +803,48 @@
     return -code $errno -errorinfo $errinfo -errorcode $errcode $error
 }
 
+ad_proc -private db_get_quote_indices { sql } {
+    Given a piece of SQL, return the indices of single quotes.
+    This is useful when we do bind var substitution because we should
+    not attempt bind var substitution inside quotes. Examples:
 
+    <pre>
+        sql          return value
+       {'a'}           {0 2}      
+       {'a''}           {}
+      {'a'a'a'}       {0 2 4 6}
+      {a'b'c'd'}      {1 3 5 7}
+    </pre>
+
+    @see db_bind_var_subsitution
+} {
+    set quote_indices [list]
+
+    # Returns a list on the format
+    # Example - for sql={'a'a'a'} returns
+    # {0 2} {0 0} {2 2} {3 6} {4 4} {6 6}
+    set all_indices [regexp -inline -indices -all -- {(?:^|[^'])(')(?:[^']|'')+(')(?=$|[^'])} $sql]
+
+    for {set i 0} { $i < [llength $all_indices] } { incr i 3 } {
+        lappend quote_indices [lindex [lindex $all_indices [expr $i + 1]] 0]
+        lappend quote_indices [lindex [lindex $all_indices [expr $i + 2]] 0]
+    }
+
+    return $quote_indices
+}
+
+ad_proc -private db_bind_var_quoted_p { sql bind_start_idx bind_end_idx} {
+
+} {
+    foreach {quote_start_idx quote_end_idx} [db_get_quote_indices $sql] {
+        if { [expr $bind_start_idx > $quote_start_idx] && [expr $bind_end_idx < $quote_end_idx]} {
+            return 1
+        }
+    }
+
+    return 0
+}
+
 ad_proc -private db_bind_var_substitution { sql { bind "" } } {
 
     This proc emulates the bind variable substitution in the postgresql driver.
@@ -820,8 +861,8 @@
             for {set __db_i [expr [llength $__db_lst] - 1]} {$__db_i >= 0} {incr __db_i -1} {
                 set __db_ws [lindex [lindex $__db_lst $__db_i] 0]
                 set __db_we [lindex [lindex $__db_lst $__db_i] 1]
-                set __db_bind_var [string range $__db_sql $__db_ws $__db_we]
-                if {![string match "::*" $__db_bind_var]} {
+                set __db_bind_var [string range $__db_sql $__db_ws $__db_we]                
+                if {![string match "::*" $__db_] && ![db_bind_var_quoted_p $sql $__db_ws $__db_we]} {
                     set __db_tcl_var [string range $__db_bind_var 1 end]
                     set __db_tcl_var [set $__db_tcl_var]
                     if {[string equal $__db_tcl_var ""]} {
@@ -843,7 +884,7 @@
             set ws [lindex [lindex $lst $i] 0]
             set we [lindex [lindex $lst $i] 1]
             set bind_var [string range $sql $ws $we]
-            if {![string match "::*" $bind_var]} {
+            if {![string match "::*" $bind_var] && ![db_bind_var_quoted_p $sql $ws $we]} {
                 set tcl_var [string range $bind_var 1 end]
                 set val $bind_vars($tcl_var)
                 if {[string equal $val ""]} {
Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl,v
diff -u -r1.23.2.1 -r1.23.2.2
--- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl	25 Mar 2004 11:43:32 -0000	1.23.2.1
+++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl	25 Mar 2004 12:52:37 -0000	1.23.2.2
@@ -847,6 +847,54 @@
     aa_log "100 years - we know it's wrong because of Tcl library limitations: [util::age_pretty -timestamp_ansi "1904-01-01 12:00:00" -sysdate_ansi "2004-01-01 12:00:00"]"
 }
 
+aa_register_case \
+    -procs db_get_quote_indices \
+    -cats {api} \
+    db_get_quote_indices {
+        Test the proc db_get_quote_indices.
+        
+        @author Peter Marklund
+} {
+    aa_equals "" [db_get_quote_indices {'a'}] {0 2}
+    aa_equals "" [db_get_quote_indices {'a''}] {}
+    aa_equals "" [db_get_quote_indices {'a'a'a'}] {0 2 4 6} 
+    aa_equals "" [db_get_quote_indices {a'b'c'd''s'}] {1 3 5 10} 
+    aa_equals "" [db_get_quote_indices {'}] {} 
+    aa_equals "" [db_get_quote_indices {''}] {} 
+    aa_equals "" [db_get_quote_indices {a''a}] {} 
+    aa_equals "" [db_get_quote_indices {a'b'a}] {1 3} 
+    aa_equals "" [db_get_quote_indices {'a''b'}] {0 5} 
+}
+
+aa_register_case \
+    -procs db_bind_var_substitution \
+    -cats {api} \
+    db_bind_var_substitution {
+        Test the proc db_bind_var_substitution.
+        
+        @author Peter Marklund
+} {
+    set sql {to_char(fm.posting_date, 'YYYY-MM-DD HH24:MI:SS')}
+    aa_equals "don't subst bind vars in quoted date" [db_bind_var_substitution $sql {SS 3 MI 4}] $sql
+
+    set sql {to_char(fm.posting_date, :SS)}
+    aa_equals "don't subst bind vars in quoted date" [db_bind_var_substitution $sql {SS 3 MI 4}] {to_char(fm.posting_date, '3')}
+
+    set sql {to_char(fm.posting_date, don''t subst ':SS', do subst :SS )}
+    aa_equals "don't subst bind vars in quoted date" [db_bind_var_substitution $sql {SS 3 MI 4}] {to_char(fm.posting_date, don''t subst ':SS', do subst '3' )}
+
+    set SS 3
+    set db_value [db_exec_plsql test_bind {
+        select ':SS'
+    }]
+    aa_equals "db_exec_plsql should not bind quoted var" $db_value ":SS"
+
+    set db_value [db_exec_plsql test_bind {
+        select :SS
+    }]
+    aa_equals "db_exec_plsql bind not quoted var" $db_value "3"
+}
+
 aa_register_case -cats {api} \
     -bugs 1450 \
     acs_tcl__process_enhanced_correctly {