xo::db::Class proc get_class_from_db (public)

 xo::db::Class get_class_from_db [ -object_type object_type ]

Defined in /var/www/openacs.org/packages/xotcl-core/tcl/05-db-procs.tcl

Fetch an acs_object_type from the database and create an XOTcl class from this information.

Switches:

-object_type (optional)

Returns:

class name of the created XOTcl class

Testcases:

xotcl_core_tutorial_3

Source code:

# some table_names and id_columns in acs_object_types are unfortunately uppercase,
# so we have to convert to lowercase here....
::xo::dc 1row fetch_class {
  select object_type, supertype, pretty_name, lower(id_column) as id_column, lower(table_name) as table_name
  from acs_object_types where object_type = :object_type
}
set classname [:object_type_to_class $object_type]
if {![:isclass $classname]} {
  # the XOTcl class does not exist, we create it
  #:log "--db create class $classname superclass $supertype"
  ::xo::db::Class create $classname  -superclass [:object_type_to_class $supertype]  -object_type $object_type  -supertype $supertype  -pretty_name $pretty_name  -id_column $id_column  -table_name $table_name  -sql_package_name [namespace tail $classname]  -noinit
} else {
  #:log "--db we have a class $classname"
}
set attributes [::xo::dc list_of_lists get_atts {
  select attribute_name, pretty_name, pretty_plural, datatype,
  default_value, min_n_values, max_n_values
  from acs_attributes where object_type = :object_type
}]

set slots ""
foreach att_info $attributes {
  lassign $att_info attribute_name pretty_name pretty_plural datatype  default_value min_n_values max_n_values

  # ignore some erroneous definitions in the acs meta model
  if {[info exists :exclude_attribute($table_name,$attribute_name)]} {
    continue
  }

  set defined_att($attribute_name) 1
  set cmd [list ::xo::db::Attribute create $attribute_name  -pretty_name $pretty_name  -pretty_plural $pretty_plural  -datatype $datatype  -min_n_values $min_n_values  -max_n_values $max_n_values]

  if {$default_value ne ""} {
    # if the default_value is "", we assume, no default
    lappend cmd -default $default_value
  }
  append slots $cmd \n
}
ad_try {
  $classname slots $slots
} on error {errorMsg} {
  error "Error during slots: $errorMsg"
}

$classname init
return $classname

XQL Not present:

Generic, PostgreSQL, Oracle