OpenACS

gustafn
committed
MAIN:gustafn:20180407110347
on 07 Apr 18
modernize Tcl
openacs-4/.../acs-object-management/tcl/object-procs.tcl (+2 -2)
25 25     supertype_attributes_array will contain the values for the attributes that
26 26     belong to the set of given object_type's supertypes.
27 27
28 28     This is used privately to generate insert/update dml statements for each of the
29 29     tables associated with a given type's inheritance hierarchy.
30 30
31 31     @param object_type The object type we're processing.
32 32     @param attributes_array The attributes for the object type and all of its supertypes.
33 33     @param type_attributes_array Output array for the attribute values for the object type.
34 34     @param supertype_attributes_array Output array for the attribute values for all of
35 35            the type's supertypes.
36 36
37 37 } {
38 38     upvar $attributes_array local_attributes_array
39 39     upvar $type_attributes_array local_type_attributes_array
40 40     upvar $supertype_attributes_array local_supertype_attributes_array
41 41
42 42     set type_attribute_names [object_type::get_attribute_names \
43 43                                  -object_type $object_type]
44 44     foreach attribute_name [array names local_attributes_array] {
45           if { [lsearch -exact $type_attribute_names $attribute_name] == -1 } {
  45         if {$attribute_name ni $type_attribute_names} {
46 46             set local_supertype_attributes_array($attribute_name) \
47 47                 $local_attributes_array($attribute_name)
48 48         } else {
49 49             set local_type_attributes_array($attribute_name) \
50 50                 $local_attributes_array($attribute_name)
51 51         }
52 52     }
53 53 }
54 54      
55 55 ad_proc -private object::new_inner {
56 56     -object_type:required
57 57     -object_id:required
58 58     {-parent_id ""}
59 59     {-item_id ""}
60 60     -attributes:required
61 61 } {
62 62
63 63     Private function called by object::new to create a new object of a given type.  It
64 64     recursively walks the type hierarchy, inserting table values for the type's
65 65     supertypes as it goes.  object::new wraps the outer call in a transaction to