::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}
}

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)

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"
}

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]

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"}]

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

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

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_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]]
```

Variables

::xo::db::Class set __default_metaclass ::xotcl::Class
::xo::db::Class set __default_superclass ::xotcl::Object
::xo::db::Class array set exclude_attribute {persons,bio 1 persons,bio_mime_type 1}

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)

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)

check_table_atts (scripted, public)

create_object_type (scripted, public)

drop_object_type (scripted, public)

get_instances_from_db (scripted, public)

instance_select_query (scripted, public)

instantiate_objects (scripted, public)

new_persistent_object (scripted, public)

object_types (scripted, public)

Variables