Forum OpenACS Q&A: Re: Extending ::xo::db::user class

To give a taster of what I mean, here is the change to the object class to fetch the data from the tables:

##################################
#
# Retrieve an IM Dynfield Object
#
##################################

::im::dynfield::Class ad_proc get_instance_from_db {
    -id:required
} {
    Create an XOTcl object from an acs_object_id. This method detemines the type and initializes the object
    from the information stored in the database. The object is automatically destroyed on cleanup.
    
    
    It differs from ::xo::db::Class in the way that it can deref the values
} {
    ns_log Notice "Getting instance for ID : $id"
    set type  [::xo::db::Class get_object_type -id $id]
    if {$type eq "user"} {
        set type "person"
    }
    set class [my object_type_to_class "$type"]
    if {![my isclass $class]} {
      error "no class $class defined"
    }
    set r [$class create ::$id]
    $r db_1row dbq..get_instance [$class fetch_query $id]

    # Now set the multivalues
    foreach attribute_name [$class set multival_attrs] {
        set slot "${class}::slot::${attribute_name}"
        switch [$slot table_name] {
            im_dynfield_cat_multi_value {
                $r set $attribute_name [db_list ids "select category_id from im_dynfield_cat_multi_value where object_id = :id and attrib
ute_id = [$slot dynfield_attribute_id]"]
                $r set ${attribute_name}_deref [db_list values "select im_category_from_id(category_id) from im_dynfield_cat_multi_value 
where object_id = :id and attribute_id = [$slot dynfield_attribute_id]"]
            }
            im_dynfield_attr_multi_value {
                $r set $attribute_name [db_list values "select value from im_dynfield_attr_multi_value where object_id = :id and attribut
e_id = [$slot dynfield_attribute_id]"]
                $r set ${attribute_name}_deref [$r $attribute_name]
            }
        }
    }
    $r set object_type $type
    $r set object_types [::im::dynfield::Class object_supertypes -object_type person]
    $r set object_id $id
    $r destroy_on_cleanup
    $r initialize_loaded_object
    return $r
}

::im::dynfield::Class ad_instproc fetch_query {id} {
    Returns the full SQL statement to get all non multivalue values for an object_id.
    The object should be of a dynfield enable object though
} {
    set tables [list]
    set extra_tables [list]
    set attributes [list]
    set id_column [my id_column]
    set left_joins ""
    set join_expressions [list "[my table_name].$id_column = $id"]
    set ref_column "[my table_name].${id_column}"
    foreach cl [concat [self] [my info heritage]] {
            if {$cl eq "::xotcl::Object"} break
            set tn [$cl table_name]
            if {$tn ne "" && [lsearch $tables $tn] < 0} {
                lappend tables $tn
                
                #my log "--db_slots of $cl = [$cl array get db_slot]"
                foreach {slot_name slot} [$cl array get db_slot] {
                        # avoid duplicate output names
                        set name [$slot name]
                        if {[lsearch [im_dynfield_multimap_tables] [$slot table_name]] <0  && ![info exists names($name)]} {
                            lappend attributes [$slot attribute_reference $tn]
                        }
                        set names($name) 1
                        set names($name) 1
                }
            
                if {$cl ne [self]} {
                        lappend join_expressions "$tn.[$cl id_column] = $ref_column"
                }
            
                # Deal with the extra tables
                db_foreach table "select table_name, id_column from acs_object_type_tables where object_type = '[$cl object_type]' and ta
ble_name not in ([template::util::tcl_to_sql_list $tables])" {
                    lappend extra_tables [list $table_name $id_column]
                }
            }
    }
    foreach extra_table $extra_tables {
        set table_name [lindex $extra_table 0]
        set id_column [lindex $extra_table 1]
        if {[lsearch $tables $table_name] <0 } {
            # Extra table, join_expression needed
            lappend left_joins "left outer join $table_name on (acs_objects.object_id = ${table_name}.${id_column})"
        }
    }
    return "SELECT [join $attributes ,]\nFROM [join $tables ,] [join $left_joins " "] \nWHERE [join $join_expressions { and }] limit 1"
}