::xotcl::Class ::xo::db::Class

Methods: All Methods Documented Methods Hide Methods
Source: Display Source Hide Source
Variables: Show Variables Hide Variables

Class ::xo::db::Class

::xo::db::Class create ... \
           [ -abstract_p (default "f") ] \
           [ -auto_save (default "false") ] \
           [ -id_column id_column ] \
           [ -name_method (default "") ] \
           [ -object_type (default "[self]") ] \
           [ -pretty_name pretty_name ] \
           [ -pretty_plural pretty_plural ] \
           [ -security_inherit_p (default "t") ] \
           [ -sql_package_name sql_package_name ] \
           [ -supertype (default "acs_object") ] \
           [ -table_name table_name ] \
           [ -with_table (default "true") ]

Defined in

Class Relations

class: ::xotcl::Class
superclass: ::xotcl::Class
subclass: ::xo::db::CrClass, ::xo::PackageMgr

::xotcl::Class create ::xo::db::Class \
     -superclass ::xotcl::Class

Methods (to be applied on the object)

class_to_object_type (scripted)

 xo::db::Class class_to_object_type

Testcases:
xotcl_core_tutorial_2, xotcl-core

if {[:isclass $name]} {
  if {[$name exists object_type]} {
    # The specified class has an object_type defined; return it
    return [$name object_type]
  }
  if {![$name istype ::xo::db::Object]} {
    # The specified class is not subclass of ::xo::db::Object.
    # return acs_object in your desperation.
    return acs_object
  }
}
# Standard mapping rules
switch -glob -- $name {
  ::xo::db::Object   {return acs_object}
  ::xo::db::CrItem   {return content_revision}
  ::xo::db::image    {return image}
  ::xo::db::CrFolder {return content_folder}
  ::xo::db::*        {return [string range $name 10 end]}
  default            {return $name}
}

create_all_functions (scripted)


foreach item [::xo::dc get_all_package_functions] {
  lassign $item package_name object_name

  if {[string match "*TRG" [string toupper $object_name]]} {
    # no need to provide interface to trigger functions
    continue
  }

  set class_name ::xo::db::sql::[string tolower $package_name]
  if {![nsf::is object $class_name]} {

    ::xo::db::Class create $class_name
    #$class_name proc unknown args {
    #  ns_log warning "deprecated ::xo::db::[namespace tail [self]] $args was called."  #      "Use '::acs::dc call [namespace tail [self]] $args]' instead"
    #  return [::acs::dc call [namespace tail [self]] {*}$args]
    #}

  } elseif {![$class_name istype ::xo::db::Class]} {
    #
    # Make sure that we do not create new objects via the next
    # command.
    #
    continue
  }
  $class_name dbproc_nonposargs [string tolower $object_name]
}

delete (scripted, public)
```
 xo::db::Class delete -id id 
```
Delete the object from the database

Switches:

-id (required)

Testcases:
xotcl_core_tutorial_2
```
::acs::dc call acs_object delete -object_id $id
```

delete_all_acs_objects (scripted, public)

 xo::db::Class delete_all_acs_objects -object_type object_type

Delete all acs_objects of the object_type from the database.

Switches:

-object_type (required)

Testcases:
No testcase defined.

set table_name [::xo::db::Class get_table_name -object_type $object_type]
if {$table_name ne ""} {
  ::xo::dc dml delete_instances {delete from :table_name}
}

drop_type (scripted, public)

 xo::db::Class drop_type -object_type object_type  \
    [ -drop_table drop_table ] [ -cascade_p cascade_p ]

Drop the object_type from the database and drop optionally the table. This method deletes as well all acs_objects of the object_type from the database.

Switches:

-object_type (required)
-drop_table (optional, defaults to "f")
-cascade_p (optional, defaults to "t")

Testcases:
No testcase defined.

set table_name [::xo::db::Class get_table_name -object_type $object_type]
if {$table_name ne ""} {
  if {[catch {
    ::xo::dc dml delete_instances "delete from $table_name"
    if {$drop_table} {
      ::xo::dc dml drop_table "drop table $table_name"
    }
  } errorMsg]} {
    ns_log error "error during drop_type: $errorMsg"
  }
}
::acs::dc call acs_object_type drop_type  -object_type $object_type -drop_children_p $cascade_p
return ""

exists_in_db (scripted, public)
```
 xo::db::Class exists_in_db -id id 
```
Check, if an acs_object exists in the database.

Switches:

-id (required)

Returns:
0 or 1

Testcases:
xotcl_core_tutorial_1, xotcl_core_tutorial_2, xotcl_core_tutorial_4, test_xo_db_object, test_cr_items
```
return [::xo::dc 0or1row -prepare integer select_object {
  select 1 from acs_objects where object_id = :id
}]
```

get_class_from_db (scripted, public)

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

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

# 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

get_instance_from_db (scripted, public)

 xo::db::Class get_instance_from_db -id id

Create an XOTcl object from an acs_object_id. This method determines the type and initializes the object from the information stored in the database. The XOTcl object is destroyed automatically on cleanup (end of a connection request).

Switches:

-id (required, integer)

Returns:
fully qualified object

Testcases:
xotcl_core_tutorial_1, xotcl_core_tutorial_2, test_xo_db_object

set type  [:get_object_type -id $id]
set class [::xo::db::Class object_type_to_class $type]
if {![:isclass $class]} {
  error "no class $class defined"
}
set r [$class create ::$id]
$r db_1row dbqd..get_instance [$class fetch_query $id]
$r set object_id $id
$r destroy_on_cleanup
$r initialize_loaded_object
return $r

get_object_type (scripted, public)

 xo::db::Class get_object_type -id id

Return the object type for the give id.

Switches:

-id (required, integer)

Returns:
object_type, typically an XOTcl class

Testcases:
xotcl_core_tutorial_1, xotcl_core_tutorial_2

xo::xotcl_object_type_cache eval -partition_key $id $id {
  ::xo::dc 1row get_class "select object_type from acs_objects where object_id=:id"
  return $object_type
}

get_table_name (scripted, public)
```
 xo::db::Class get_table_name -object_type object_type 
```
Get the table_name of an object_type from the database. If the object_type does not exist, the return value is empty.

Switches:

-object_type (required)

Returns:
table_name

Testcases:
xotcl_core_tutorial_2
```
return [::xo::dc get_value get_table_name {
  select lower(table_name) as table_name from acs_object_types where object_type = :object_type
} ""]
```

object_type_exists_in_db (scripted, public)

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

Check, if an object_type exists in the database.

Switches:

-object_type (optional)

Returns:
0 or 1

Testcases:
xotcl_core_tutorial_2, xotcl_core_tutorial_4

return [::xo::dc 0or1row check_type {
  select 1 from acs_object_types where object_type = :object_type
}]

object_type_to_class (scripted)

 xo::db::Class object_type_to_class

Testcases:
xotcl_core_tutorial_1, xotcl-core, xotcl_core_tutorial_2, test_xo_db_object, test_cr_items, xowiki_test_cases, link_tests, slot_interactions, path_resolve

switch -glob -- $name {
  acs_object       {return ::xo::db::Object}
  content_revision -
  content_item     {return ::xo::db::CrItem}
  content_folder   {return ::xo::db::CrFolder}
  ::*              {return $name}
  default          {return ::xo::db::$name}
}

Methods (to be applied on instances)

abstract_p (setter)
auto_save (setter)

check_default_values (scripted)

if {![info exists :pretty_name]}   {set :pretty_name [namespace tail [self]]}
if {![info exists :pretty_plural]} {set :pretty_plural ${:pretty_name}}

check_table_atts (scripted, public)

 <instance of xo::db::Class> check_table_atts

Check table_name and id_column and set meaningful defaults, if these attributes are not provided.

Testcases:
xotcl_core_tutorial_2, xotcl_core_tutorial_3, xotcl_core_tutorial_4

:check_default_values
set table_name_error_tail ""
set id_column_error_tail ""

if {![info exists :sql_package_name]} {
  set :sql_package_name [self]
  #:log "-- sql_package_name of [self] is '${:sql_package_name}'"
}
if {[string length ${:sql_package_name}] > 30} {
  error "SQL package_name '${:sql_package_name}' can be maximal 30 characters long! Please specify a shorter sql_package_name in the class definition."
}
if {${:sql_package_name} eq ""} {
  error "Cannot determine SQL package_name. Please specify it explicitly!"
}

if {![info exists :table_name]} {
  set tail [namespace tail [self]]
  regexp {^::([^:]+)::} [self] _ head
  :table_name [string tolower ${head}_$tail]
  #:log "-- table_name of [self] is '[:table_name]'"
  set table_name_error_tail ", or use different namespaces/class names"
}

if {![info exists :id_column]} {
  set :id_column [string tolower [namespace tail [self]]]_id
  set id_column_error_tail ", or use different class names"
  #:log "-- created id_column '[:id_column]'"
}

if {![regexp {^[[:alpha:]_][[:alnum:]_]*$} [:table_name]]} {
  error "Table name '[:table_name]' is unsafe in SQL:  Please specify a different table_name$table_name_error_tail."
}

if {[string length [:table_name]] > 30} {
  error "SQL table_name '[:table_name]' can be maximal 30 characters long! Please specify a shorter table_name in the class definition."
}

if {![regexp {^[[:alpha:]_][[:alnum:]_]*$} [:id_column]]} {
  error "Name for id_column '[:id_column]' is unsafe in SQL:  Please specify a different id_column$id_column_error_tail"
}

collect_constraints (scripted)

set attname [$att name]
# Index is always created after table creation, so it is always ok
# to collect this...
if {[$att exists index]} {
  lappend :db_constraints($attname) [list index [$att set index]]
}
# ...in all other cases, when column doesn not exist will be
# created properly. No need to collect constraints.
if {[::xo::db::require exists_column ${:table_name} $attname]} {
  if {[$att exists unique] && [$att set unique]} {
    lappend :db_constraints($attname) unique
  }
  if {[$att exists not_null] && [$att set not_null]} {
    lappend :db_constraints($attname) not_null
  }
  if {![string is space [$att set references]]} {
    lappend :db_constraints($attname) [list references [$att set references]]
  }
  if {[$att exists default]} {
    lappend :db_constraints($attname) [list default [$att set default]]
  }
}

create_object_type (scripted, public)

 <instance of xo::db::Class> create_object_type

Create an acs object_type for the current XOTcl class

Testcases:
xotcl_core_tutorial_2

:check_default_values
:check_table_atts

# The default supertype is acs_object. If the supertype
# was not changed (still acs_object), we map the superclass
# to the object_type to obtain the ACS supertype.
if {${:supertype} eq "acs_object"} {
  set :supertype [::xo::db::Class class_to_object_type [:info superclass]]
}

::acs::dc call acs_object_type create_type  -object_type   ${:object_type}  -supertype     ${:supertype}  -pretty_name   ${:pretty_name}  -pretty_plural ${:pretty_plural}  -table_name    ${:table_name}  -id_column     ${:id_column}  -abstract_p    ${:abstract_p}  -name_method   ${:name_method}  -package_name  [:sql_package_name]

db_slots (scripted)


array set :db_slot [list]
array set :db_constraints [list]
#
# First get all ::xo::db::Attribute slots and check later,
# if we have to add the id_column automatically.
#
# :log "--setting db_slot all=[:info slots]"
foreach att [:info slots] {
  #:log "--checking $att [$att istype ::xo::db::Attribute] [$att info class]"
  if {![$att istype ::xo::db::Attribute]} continue
  set :db_slot([$att name]) $att
  :collect_constraints $att
}
if {[self] ne "::xo::db::Object"} {
  if {[info exists :id_column] && ![info exists :db_slot(${:id_column})]} {
    # create automatically the slot for the id column
    :slots [subst {
      ::xo::db::Attribute create ${:id_column}  -pretty_name "ID"  -datatype integer  -create_acs_attribute false
    }]
    set :db_slot(${:id_column}) [self]::slot::${:id_column}
  }
}
#:log "--setting db_slot of [self] to [array names _db_slot]"

dbproc_nonposargs (scripted)

#
# This method compiles a stored procedure into an XOTcl method
# using a classic nonpositional argument style interface.
#
# The current implementation should work on PostgreSQL and Oracle
# (not tested) but will not work, when a single OpenACS instance
# want to talk to PostgreSQL and Oracle simultaneously. Not sure,
# how important this is...
#
if {$object_name eq "set"} {
  :log "We cannot handle object_name = '$object_name' in this version"
  return
}
#
# Object names have the form of e.g. ::xo::db::apm_parameter.
# Therefore, we use the namespace tail as sql_package_name.
#
set package_name  [:sql_package_name [namespace tail [self]]]
set sql_info      [::xo::dc generate_psql $package_name $object_name]

# puts "sql_command=$sql_command"
# puts "sql_info=$sql_info"
array set defined [dict get $sql_info defined]

set nonposarg_list [list [list -dbn ""]]
foreach arg_name [dict get $sql_info arg_order] {
  # special rule for DBN ... todo: proc has to handle this as well
  set nonposarg_name [expr {$arg_name eq "DBN" ? "DBN" : [string tolower $arg_name]}]
  #
  # handling of default values:
  #  - no value ("") --> the attribute is required
  #  - value different from NULL --> make it default
  #  - otherwise: non-required argument
  #
  set default_value $defined($arg_name)
  if {$default_value eq ""} {
    set arg -$nonposarg_name:required
  } elseif {[string tolower $default_value] ne "null"} {
    set arg [list -$nonposarg_name $default_value]
  } else {
    set arg -$nonposarg_name
  }
  lappend nonposarg_list $arg
}
# When the new method is executed within a contains, -childof is
# appended. We have to added it here to avoid complains. Xotcl 2.0
# should find better ways to handle contain or the new invocation.
if {$object_name eq "new"} {lappend nonposarg_list -childof}
#:log "-- define $object_name $nonposarg_list"

#ns_log notice final=[dict get $sql_info body]
:ad_proc $object_name $nonposarg_list {Automatically generated method} [dict get $sql_info body]

drop_object_type (scripted, public)

 <instance of xo::db::Class> drop_object_type \
    [ -cascade cascade ]

Drop an acs object_type; cascde true means that the attributes are dropped as well.

Switches:

-cascade (optional, defaults to "true")

Testcases:
No testcase defined.

::acs::dc call acs_object_type drop_type  -object_type ${:object_type}  -cascade_p [expr {$cascade ? "t" : "f"}]

fetch_query (scripted)

set tables [list]
set attributes [list]
set id_column [:id_column]
set join_expressions [list "[:table_name].$id_column = $id"]
foreach cl [list [self] {*}[:info heritage]] {
  #if {$cl eq "::xo::db::Object"} break
  if {$cl eq "::xotcl::Object"} break
  set tn [$cl table_name]
  if {$tn  ne ""} {
    lappend tables $tn
    #: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 {![info exists names($name)]} {
        lappend attributes [$slot attribute_reference $tn]
      }
      set names($name) 1
    }
    if {$cl ne [self]} {
      lappend join_expressions "$tn.[$cl id_column] = [:table_name].$id_column"
    }
  }
}
return "SELECT [join $attributes ,]\nFROM [join $tables ,]\nWHERE [join $join_expressions { and }]"

get_context (scripted)

:upvar  $package_id_var package_id  $user_id_var user_id  $ip_var ip

if {![info exists package_id]} {
  if {[nsf::is object ::xo::cc]} {
    set package_id    [::xo::cc package_id]
  } elseif {[ns_conn isconnected]} {
    set package_id    [ad_conn package_id]
  } else {
    set package_id ""
  }
}
if {![info exists user_id]} {
  if {[nsf::is object ::xo::cc]} {
    set user_id    [::xo::cc user_id]
  } elseif {[ns_conn isconnected]} {
    set user_id    [ad_conn user_id]
  } else {
    set user_id 0
  }
}
if {![info exists ip]} {
  if {[ns_conn isconnected]} {
    set ip [ad_conn peeraddr]
  } else {
    set ip [ns_info address]
  }
}

get_instances_from_db (scripted, public)

 <instance of xo::db::Class> get_instances_from_db \
    [ -select_attributes select_attributes ] \
    [ -from_clause from_clause ] [ -where_clause where_clause ] \
    [ -orderby orderby ] [ -page_size page_size ] \
    [ -page_number page_number ] [ -initialize initialize ]

Returns a set (ordered composite) of the answer tuples of an 'instance_select_query' with the same attributes. Note that the returned objects might by partially instantiated.

Switches:

-select_attributes (optional)
-from_clause (optional)
-where_clause (optional)
-orderby (optional)
-page_size (optional, defaults to "20")
-page_number (optional)
-initialize (optional, defaults to "true")

Returns:
ordered composite

Testcases:
No testcase defined.

set s [:instantiate_objects  -object_class [self]  -sql [:instance_select_query  -select_attributes $select_attributes  -from_clause $from_clause  -where_clause $where_clause  -orderby $orderby  -page_size $page_size  -page_number $page_number  ]  -initialize $initialize]
return $s

id_column (setter)

init (scripted)

if {![::xo::db::Class object_type_exists_in_db -object_type [:object_type]]} {
  :create_object_type
}
:init_type_hierarchy
:check_table_atts
:db_slots

if {[:with_table]} {
  set table_definition [:table_definition]
  if {$table_definition ne ""} {
    ::xo::db::require table [:table_name] $table_definition
    :require_constraints
  }
  :mk_update_method
  :mk_insert_method
}
next

init_type_hierarchy (scripted)

set object_type ${:object_type}
set :object_type_key [::xo::dc list get_tree_sortkey {
  select tree_sortkey from acs_object_types
  where object_type = :object_type
}]

initialize_acs_object (scripted)

#
# This method is called, whenever a new (fresh) object with
# a new object_id is created.
#
$obj set object_id $id
# construct the same object_title as acs_object.new() does
$obj set object_title "[:pretty_name] $id"
#$obj set object_type [:object_type]

instance_select_query (scripted, public)

 <instance of xo::db::Class> instance_select_query \
    [ -select_attributes select_attributes ] [ -orderby orderby ] \
    [ -where_clause where_clause ] [ -from_clause from_clause ] \
    [ -count on|off ] [ -page_size page_size ] \
    [ -page_number page_number ]

Returns the SQL-query to select ACS Objects of the object_type of the class.

Switches:

-select_attributes (optional)
attributes for the SQL query to be retrieved. if no attributes are specified, all attributes are retrieved.
-orderby (optional)
for ordering the solution set
-where_clause (optional)
clause for restricting the answer set
-from_clause (optional)
-count (optional, boolean, defaults to "false")
return the query for counting the solutions
-page_size (optional, defaults to "20")
-page_number (optional)

Returns:
SQL query

Testcases:
No testcase defined.

set tables [list]
set id_column [:id_column]

if {$count} {
  set select_attributes "count(*)"
  set orderby ""         ;# no need to order when we count
  set page_number  ""    ;# no pagination when count is used
}

set all_attributes [expr {$select_attributes eq ""}]
set join_expressions [list]
foreach cl [list [self] {*}[:info heritage]] {
  #if {$cl eq "::xo::db::Object"} break
  if {$cl eq "::xotcl::Object"} break
  set tn [$cl table_name]

  if {$tn  ne ""} {
    lappend tables $tn
    if {$all_attributes} {
      foreach {slot_name slot} [$cl array get db_slot] {
        # avoid duplicate output names
        set name [$slot name]
        if {![info exists names($name)]} {
          lappend select_attributes [$slot attribute_reference $tn]
        }
        set names($name) 1
      }
    }
    if {$cl ne [self]} {
      lappend join_expressions "$tn.[$cl id_column] = [:table_name].$id_column"
    }
  }
}

if {$page_number ne ""} {
  set limit $page_size
  set offset [expr {$page_size*($page_number-1)}]
} else {
  set limit ""
  set offset ""
}
set sql [::xo::dc select  -vars   [join $select_attributes ,]  -from  "[join $tables ,] $from_clause"  -where  [string trim "[join $join_expressions { and }] $where_clause"]  -orderby $orderby  -limit $limit -offset $offset]
return $sql

instantiate_objects (scripted, public)

 <instance of xo::db::Class> instantiate_objects [ -dbn dbn ] \
    [ -sql sql ] [ -full_statement_name full_statement_name ] \
    [ -as_ordered_composite on|off ] [ -object_class object_class ] \
    [ -named_objects on|off ] \
    [ -object_named_after object_named_after ] \
    [ -destroy_on_cleanup on|off ] [ -keep_existing_objects on|off ] \
    [ -ignore_missing_package_ids on|off ] [ -initialize initialize ]

Retrieve multiple objects from the database using the given SQL query and create XOTcl objects from the tuples.

Switches:

-dbn (optional)
-sql (optional)
The SQL query to retrieve tuples. Note that if the SQL query only returns a restricted set of attributes, the objects will be only partially instantiated.
-full_statement_name (optional)
-as_ordered_composite (optional, boolean, defaults to "true")
return an ordered composite object preserving the order. If the flag is false, one has to use "info instances" to access the resulted objects.
-object_class (optional, defaults to "::xotcl::Object")
specifies the XOTcl class, for which instances are created.
-named_objects (optional, boolean, defaults to "false")
If this flag is true, the value of the id_column is used for the name of the created objects (object will be named e.g. ::13738). Otherwise, objects are created with the XOTcl "new" method to avoid object name clashes.
-object_named_after (optional)
-destroy_on_cleanup (optional, boolean, defaults to "true")
If this flag is true, the objects (and ordered composite) will be automatically destroyed on cleanup (typically after the request was processed).
-keep_existing_objects (optional, boolean, defaults to "false")
-ignore_missing_package_ids (optional, boolean, defaults to "false")
-initialize (optional, defaults to "true")
can be used to avoid full initialization, when a large series of objects is loaded. Per default, these objects are initialized via initialize_loaded_object, when the are of type ::xo::db::Object

Testcases:
xowiki_test_cases


if {$object_class eq ""} {set object_class [self]}
if {$sql eq ""} {set sql [:instance_select_query]}
if {$as_ordered_composite} {
  set __result [::xo::OrderedComposite new]
  if {$destroy_on_cleanup} {$__result destroy_on_cleanup}
} else {
  set __result [list]
}
if {$named_objects} {
  if {$object_named_after eq ""} {
    set object_named_after [:id_column]
  }
}

set sets [uplevel [list ::xo::dc sets -dbn $dbn dbqd..[self proc] $sql]]
foreach selection $sets {
  if {$named_objects} {
    set object_name ::[ns_set get $selection $object_named_after]
    if {[nsf::is object $object_name]} {
      set o $object_name
      set new 0
    } else {
      set o [$object_class create $object_name]
      set new 1
    }
  } else {
    set new 0
    set o [$object_class new]
  }
  if {$as_ordered_composite} {
    $__result add $o
  } else {
    if {$destroy_on_cleanup} {
      $o destroy_on_cleanup
    }
    lappend __result $o
  }

  if {!$new && $keep_existing_objects} {
    #ns_log notice "+++ instantiate_objects keep existing object $o"
    continue
  }
  $o mset [ns_set array $selection]
  ns_set free $selection

  if {[$o exists object_type]} {
    #
    # Set the object type if it looks like managed from XOTcl.
    #
    set object_type [$o set object_type]
    if {[string match "::*" $object_type]} {
      $o class $object_type
    }
  }
  if {$initialize && [$o istype ::xo::db::Object]} {
    if {![$o exists package_id]} {
      if {[$o exists object_package_id]} {
        $o set package_id [$o set object_package_id]
      } elseif {!$ignore_missing_package_ids} {
        ns_log warning "[namespace tail [$o info class]] $o has no package_id and no object_package_id"
      }
    }
    ad_try {
      $o initialize_loaded_object
    } on error {errorMsg} {
      set context [lmap var {name item_id revision_id} {
        if {![$o exists $var]} continue
        set _ "$var [$o set $var]"
      }]
      ns_log error "$o initialize_loaded_object [join $context]"  "=> [lsort [$o info vars]] -> $errorMsg"
    }
  }
  #:log "--DB more = $continue [$o serialize]"
}

return $__result

mk_insert_method (scripted)

# create method 'insert' for the application class
# The caller (e.g. method new) should care about db_transaction
:instproc insert {} {
  set __table_name [[self class] table_name]
  set __id [[self class] id_column]
  set :$__id ${:object_id}
  :log "ID insert in $__table_name, id = $__id = [set :$__id]"
  next
  foreach {__slot_name __slot} [[self class] array get db_slot] {
    if {[info exists :$__slot_name]} {
      set $__slot_name [set :$__slot_name]
      lappend __vars $__slot_name
      lappend __atts [$__slot column_name]
    }
  }
  ::xo::dc dml insert_$__table_name "insert into $__table_name
    ([join $__atts ,]) values (:[join $__vars ,:])"
}

mk_update_method (scripted)

set updates [list]
set vars [list]
foreach {slot_name slot} [array get :db_slot] {
  $slot instvar name column_name
  if {$column_name ne [:id_column]} {
    lappend updates "$column_name = :$name"
    lappend vars $name
  }
}
if {[llength $updates] == 0} return
:instproc update {} [subst {
  ::xo::dc transaction {
    next
    :instvar object_id $vars
    ::xo::dc dml update_[:table_name] {update [:table_name]
      set [join $updates ,] where [:id_column] = :object_id
    }
  }
}]

name_method (setter)

new_acs_object (scripted)

:get_context package_id creation_user creation_ip

set id [::acs::dc call acs_object new  -object_type [::xo::db::Class class_to_object_type [self]]  -title $object_title  -package_id $package_id  -creation_user $creation_user  -creation_ip $creation_ip  -context_id $context_id  -security_inherit_p [:security_inherit_p]]
return $id

new_persistent_object (scripted, public)

 <instance of xo::db::Class> new_persistent_object \
    [ -package_id package_id ] [ -creation_user creation_user ] \
    [ -creation_ip creation_ip ] args [ args... ]

Create a new instance of the given class, configure it with the given arguments and insert it into the database. The XOTcl object is destroyed automatically on cleanup (end of a connection request).

Switches:

-package_id (optional)
-creation_user (optional)
-creation_ip (optional)

Parameters:

args (required)

Returns:
fully qualified object

Testcases:
xotcl_core_tutorial_1, xotcl_core_tutorial_2

:get_context package_id creation_user creation_ip
::xo::dc transaction {
  set id [:new_acs_object  -package_id $package_id  -creation_user $creation_user  -creation_ip $creation_ip  ""]
  #[self class] set during_fetch 1
  ad_try {
    :create ::$id {*}$args
  } on error {errorMsg} {
    ad_log error "create fails: $errorMsg"
  }
  #[self class] unset during_fetch
  :initialize_acs_object ::$id $id
  ::$id insert
}
::$id destroy_on_cleanup
return ::$id

object_type (setter)
object_types (scripted, public)
```
 <instance of xo::db::Class> object_types \
    [ -subtypes_first on|off ]
```
Return the type and subtypes of the class, on which the method is called. If subtypes_first is specified, the subtypes are returned first.

Switches:

-subtypes_first (optional, boolean, defaults to "false")

Returns:
list of object_types

Testcases:
xotcl_core_tutorial_2, xotcl_core_tutorial_4
```
return [::xo::dc list get_object_types  [:object_types_query -subtypes_first $subtypes_first]]
```

object_types_query (scripted)

set object_type_key ${:object_type_key}
set order_clause [expr {$subtypes_first ? "order by tree_sortkey desc":""}]
return "select object_type from acs_object_types where
  tree_sortkey between '$object_type_key' and tree_right('$object_type_key')
  $order_clause"

pretty_name (setter)
pretty_plural (setter)

require_constraints (scripted)

set table_name [:table_name]
foreach col [array names :db_constraints] {
  foreach constr [set :db_constraints($col)] {
    set type  [lindex $constr 0]
    set value [join [lrange $constr 1 end]]
    switch -- $type {
      "unique" {
        ::xo::db::require unique  -table $table_name -col $col
      }
      "index" {
        set value [expr {[string is true $value] ? "" : $value}]
        ::xo::db::require index -using $value  -table $table_name -col $col
      }
      "not_null" {
        ::xo::db::require not_null  -table $table_name -col $col
      }
      "references" {
        ::xo::db::require references  -table $table_name -col $col  -ref $value
      }
      "default" {
        ::xo::db::require default  -table $table_name -col $col  -value $value
      }
    }
  }
}

security_inherit_p (setter)
sql_package_name (setter)
supertype (setter)

table_definition (scripted)

array set column_specs [list]
#
# iterate over the slots and collect the column_specs for table generation
#
foreach {slot_name slot} [array get :db_slot] {
  if {![$slot create_table_attribute]} continue
  set column_name [$slot column_name]
  set column_specs($column_name)  [$slot column_spec -id_column [expr {$column_name eq ${:id_column}}]]
}

# Requires collected constraints on object's table.
::xo::db::Class instproc require_constraints {} {
  set table_name [:table_name]
  foreach col [array names :db_constraints] {
    foreach constr [set :db_constraints($col)] {
      set type  [lindex $constr 0]
      set value [join [lrange $constr 1 end]]
      switch -- $type {
        "unique" {
          ::xo::db::require unique  -table $table_name -col $col
        }
        "index" {
          set value [expr {[string is true $value] ? "" : $value}]
          ::xo::db::require index -using $value  -table $table_name -col $col
        }
        "not_null" {
          ::xo::db::require not_null  -table $table_name -col $col
        }
        "references" {
          ::xo::db::require references  -table $table_name -col $col  -ref $value
        }
        "default" {
          ::xo::db::require default  -table $table_name -col $col  -value $value
        }
      }
    }
  }
}

if {[array size column_specs] > 0} {
  if {${:table_name} eq ""} {error "no table_name specified"}
  if {${:id_column} eq ""}  {error "no id_column specified"}
  if {![info exists column_specs(${:id_column})]} {
    error "no ::xo::db::Attribute slot for id_column '${:id_column}' specified"
  }
  set table_specs [list]
  foreach {att spec} [array get column_specs] {lappend table_specs $att $spec}
  set table_definition $table_specs
} else {
  set table_definition ""
}
# :log table_definition=$table_definition
return $table_definition

table_name (setter)

unknown (scripted)

error "Error: unknown database method '$m' for [self]"

with_table (setter)

Methods: All Methods Documented Methods Hide Methods
Source: Display Source Hide Source
Variables: Show Variables Hide Variables

Class ::xo::db::Class

Class Relations

Methods (to be applied on the object)

class_to_object_type (scripted)

create_all_functions (scripted)

delete (scripted, public)

delete_all_acs_objects (scripted, public)

drop_type (scripted, public)

exists_in_db (scripted, public)

get_class_from_db (scripted, public)

get_instance_from_db (scripted, public)

get_object_type (scripted, public)

get_table_name (scripted, public)

object_type_exists_in_db (scripted, public)

object_type_to_class (scripted)

Methods (to be applied on instances)

abstract_p (setter)

auto_save (setter)

check_default_values (scripted)

check_table_atts (scripted, public)

collect_constraints (scripted)

create_object_type (scripted, public)

db_slots (scripted)

dbproc_nonposargs (scripted)

drop_object_type (scripted, public)

fetch_query (scripted)

get_context (scripted)

get_instances_from_db (scripted, public)

id_column (setter)

init (scripted)

init_type_hierarchy (scripted)

initialize_acs_object (scripted)

instance_select_query (scripted, public)

instantiate_objects (scripted, public)

mk_insert_method (scripted)

mk_update_method (scripted)

name_method (setter)

new_acs_object (scripted)

new_persistent_object (scripted, public)

object_type (setter)

object_types (scripted, public)

object_types_query (scripted)

pretty_name (setter)

pretty_plural (setter)

require_constraints (scripted)

security_inherit_p (setter)

sql_package_name (setter)

supertype (setter)

table_definition (scripted)

table_name (setter)

unknown (scripted)

with_table (setter)