Index: openacs-4/packages/acs-object-management/tcl/form-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/form-procs.tcl,v diff -u -N -r1.5 -r1.6 --- openacs-4/packages/acs-object-management/tcl/form-procs.tcl 22 Feb 2011 17:37:03 -0000 1.5 +++ openacs-4/packages/acs-object-management/tcl/form-procs.tcl 28 Feb 2011 01:26:31 -0000 1.6 @@ -48,7 +48,8 @@ -array attr set value [template::element::get_value $form $attr(view_attribute)] if { [llength [info procs ::template::data::to_sql::${attr(datatype)}]] } { - set value [template::data::to_sql::${attr(datatype)} $value] + set value [db_string q \ + "select [template::data::to_sql::${attr(datatype)} $value] from dual"] } else { set value "$value" } Index: openacs-4/packages/acs-object-management/tcl/object-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-procs.tcl,v diff -u -N -r1.7 -r1.8 --- openacs-4/packages/acs-object-management/tcl/object-procs.tcl 10 Nov 2010 18:27:20 -0000 1.7 +++ openacs-4/packages/acs-object-management/tcl/object-procs.tcl 28 Feb 2011 01:26:31 -0000 1.8 @@ -11,15 +11,6 @@ namespace eval object {} -ad_proc -private object::quote_attribute_values { - -array:required -} { - upvar $array attributes - foreach attribute [array names attributes] { - set attributes($attribute) "'[DoubleApos $attributes($attribute)]'" - } -} - ad_proc -private object::split_attributes { -object_type:required -attributes_array:required @@ -117,16 +108,10 @@ foreach name [array names our_attributes] { lappend name_list $name set __$name $our_attributes($name) - if {![string match "to_timestamp(*" [set __$name]]} { - lappend value_list ":__${name}" - } else { - lappend value_list "[set __${name}]" - } + lappend value_list ":__${name}" } - set SQL [db_map insert_object] + db_dml insert_object {} - db_dml insert_object_q $SQL - } else { # error for now as we don't handle generics etc return -code error "Generic attributes are not supported." @@ -181,8 +166,6 @@ set attributes_array(object_type) $object_type -# object::quote_attribute_values -array attributes_array - db_transaction { set object_id [object::new_inner \ -object_type $object_type \ @@ -219,7 +202,6 @@ set attributes(creation_user) "[ad_conn user_id]" set attributes(creation_ip) "[ad_conn peeraddr]" set attributes(object_type) "$object_type" -# object::quote_attribute_values -array attributes db_transaction { object::new_inner \ -object_type $object_type \ @@ -330,17 +312,11 @@ foreach name [array names our_attributes] { set __$name $our_attributes($name) - if {![string match "to_timestamp(*" [set __$name]]} { - lappend name_value_list "$name = :__${name}" - } else { - lappend name_value_list "$name = [set __${name}]" - } - + lappend name_value_list "$name = :__${name}" } if { [info exists name_value_list] } { - set SQL [db_map update_object] - db_dml update_object_q $SQL + db_dml update_object {} } } else { @@ -368,16 +344,14 @@ array set attributes_array $attributes if { [ad_conn isconnected] } { - if { ![exists_and_not_null attributes_array(modifying_user)] } { - set attributes_array(modifying_user) [ad_conn user_id] - } - if { ![exists_and_not_null attributes_array(modifying_ip)] } { - set attributes_array(modifying_ip) [ad_conn peeraddr] - } + if { ![exists_and_not_null attributes_array(modifying_user)] } { + set attributes_array(modifying_user) [ad_conn user_id] + } + if { ![exists_and_not_null attributes_array(modifying_ip)] } { + set attributes_array(modifying_ip) [ad_conn peeraddr] + } } -# object::quote_attribute_values -array attributes_array - set object_type [object::get_object_type -object_id $object_id] db_transaction { Index: openacs-4/packages/acs-object-management/tcl/object-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-procs.xql,v diff -u -N -r1.3 -r1.4 --- openacs-4/packages/acs-object-management/tcl/object-procs.xql 11 Dec 2009 00:19:09 -0000 1.3 +++ openacs-4/packages/acs-object-management/tcl/object-procs.xql 28 Feb 2011 01:26:31 -0000 1.4 @@ -1,6 +1,15 @@ + + + select datatype + from acs_attributes a + where a.object_type=:object_type + and a.attribute_name=:name + + + insert into $object_type_info(table_name) @@ -10,6 +19,16 @@ + + + select datatype + from acs_attributes a + where a.object_type=:object_type + and a.attribute_name=:name + + + + update $object_type_info(table_name) Index: openacs-4/packages/acs-object-management/tcl/test/object-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/test/object-procs.tcl,v diff -u -N -r1.2 -r1.3 --- openacs-4/packages/acs-object-management/tcl/test/object-procs.tcl 14 Nov 2010 20:41:05 -0000 1.2 +++ openacs-4/packages/acs-object-management/tcl/test/object-procs.tcl 28 Feb 2011 01:26:31 -0000 1.3 @@ -100,7 +100,7 @@ ad_form -name $view_name \ -form $form_part - foreach {a v} [list s string b 0 n 1000 i 1000000 m 10.00 d 2010-01-01 ts "2010-01-01 00:00:00" td "2010-01-01 00:00:00" t "text" rt "'Single quoted string'"] { + foreach {a v} [list s string b 0 n 1000 i 1000000 m 10.00 d [list 2010 01 01] ts [list 2010 01 01 00 00 00] td [list 2010 01 01 00 00 00] t "text" rt "'Single quoted string'"] { template::element::set_value $view_name $a $v } } error] @@ -109,6 +109,7 @@ aa_false "Object created from form" \ [catch {set object_id [object::new_from_form \ -object_view $view_name \ + -object_id [db_nextval acs_object_id_seq] \ -form $view_name]} error] object::delete -object_id $object_id aa_log $error