Forum OpenACS Q&A: Re: Extending ::xo::db::user class
I made one basic mistake - instead of treating class as a parameter, it is a method with an optional argument. ie change:
$u set class ::myapp::Userto
$u class ::myapp::UserAnd it works, so long as I do the insert first. I guess I can subclass save and force an insert if required - is there perhaps a smarter way to do this?
Dear Mark,
the problem is most likely that in your example, the
created user does not have the correct object_type set in
acs_objects. If one loads an object via get_instance_from_db,
it gets its (XOTcl) class from there.
Below is a small script that should help you get started with the example.
Concerning the need to run get_class_from_db in every script:
if you have an application that defines the subtypes,
you should create/fetch the class it in the -procs file,
then these classes are included in the blueprint and do
not have to be fetched at request time.
One other problem with this example is that the acs_attribute
table (as shipped with OpenACS) is not well populated
(e.g. no entry for acs_type 'user'). Since
get_class_from_db uses acs_attributes, and since 'username'
has to be not-null, it is at least necessary to add this
attribute there. Fortunately, it is quite easy to
populate it via the xotcl-db api (see below).
Save the script e.g. in the toplevel www directory and call it from there.
Hope this helps
-gustaf neumann
===============================================
ad_page_contract {
#
# A sample script file to show how to define a subtype of user
#
} {
{flushall:optional 0}
}
set ::__ ""
proc ::say {msg} {uplevel [list append ::__ $msg\n]; ns_log notice "-- $msg"}
if {$flushall} {
set classes {::myapp::User}
::say "Dropping classes $classes"
foreach class $classes {
::xo::db::Class drop_type -object_type $class -cascade_p t
}
}
namespace eval ::myapp {
set acs_party_type [::xo::db::Class get_class_from_db -object_type party]
set acs_person_type [::xo::db::Class get_class_from_db -object_type person]
set acs_user_type [::xo::db::Class get_class_from_db -object_type user]
#
# Complete attribute definition in acs_attributes (not complete)
#
$acs_user_type slots {
::xo::db::Attribute create username \
-datatype string -sqltype varchar(100) \
-pretty_name "Username"
}
foreach class [list $acs_party_type $acs_person_type $acs_user_type] {
::say "slots of $class = [$class array get db_slot]"
}
::say "\n::myapp::User exists in db? [db_string check_type {select 1 from acs_object_types where
object_type = '::myapp::User'} -default 0]"
::say "Create ::myapp::User if necessary"
::xo::db::Class create ::myapp::User \
-superclass $acs_user_type \
-table_name myapp_users \
-slots {
::xo::db::Attribute foo -default "" -datatype string
::xo::db::Attribute bar -datatype integer
}
::say "::myapp::User exists in db? [db_string check_type {select 1 from acs_object_types where
object_type = '::myapp::User'} -default 0]"
::say "slots of ::myapp::User = [::myapp::User array get db_slot]"
set current_users [::myapp::User get_instances_from_db]
::say "\nWe have currenly [llength [$current_users children]] instance in the database"
::say "Delete all objects:"
foreach child [$current_users children] {
::say "... delete [$child serialize]"
$child delete
}
::say "\nCreate a new object"
set object [::myapp::User new_persistent_object \
-first_names "first names" \
-last_name "lastname" \
-username "username" \
-foo somestring -bar 123 ]
::say "object = [$object serialize]"
set id [$object object_id]
$object destroy
::say "Fetch object (show how it works)"
set u [::xo::db::Class get_instance_from_db -id $id]
::say "fetched object = [$u serialize]"
::say "save updated value"
$u set bar 5
$u save
}
ns_return 200 text/plain $::__
Thanks for so much effort Gustaf, it's all starting to make sense! I like how easy it is to correct the missing type information in the db, even for existing acs types.
The problem are the existing acs-object-types. The "type information" is correct, but many acs-attributes are missing, and some of them have wrong entries. Many openacs installations are quite old, and they seem to have missed upgrade scripts, etc. I think, there are even differences between postgresql and oracle. Since nobody uses so far these tables intensively, they are not well maintained.
The approach by adding these via "slots" + ::xo::db::Attribute served me well so far, it fixes the database on the fly, the code works for oracle+postgres, and it does not require a certain openacs release.
It would be certainly nice to have all acs-attributes fixed, but it is certainly some work. Below is the table of non-xo-types, with the number of attributes defined in acs_attributes and the associated tables (from my current working instance, with some fixes). There are 66 types having no attributes defined.
In total, there are about 240 entries missing, if my calculation is correct.
An alternative might be to obtain the information in acs_attributes directly from the system catalogs, but that's as well some work, not sure, whether all information can be obtained from there, and of course, this is quite different on postgres and oracle.
object_type | tablename | acs_count | pg_count | missing
------------------------------+-------------------------------+-----------+----------+---------
acs_mail_body | acs_mail_bodies | 0 | 10 | 9
acs_mail_gc_object | acs_mail_gc_objects | 0 | 1 | 0
acs_mail_link | acs_mail_links | 0 | 2 | 1
acs_mail_multipart | acs_mail_multiparts | 0 | 2 | 1
acs_mail_queue_message | acs_mail_queue_messages | 0 | 1 | 0
acs_message | acs_messages | 0 | 6 | 5
acs_named_object | acs_named_objects | 0 | 3 | 2
acs_object | acs_objects | 11 | 14 | 2
acs_reference_repository | acs_reference_repositories | 0 | 11 | 10
acs_sc_contract | acs_sc_contracts | 0 | 3 | 2
acs_sc_implementation | acs_sc_impls | 0 | 5 | 4
acs_sc_msg_type | acs_sc_msg_types | 0 | 2 | 1
acs_sc_operation | acs_sc_operations | 0 | 9 | 8
admin_rel | admin_rels | 0 | 1 | 0
apm_application | apm_applications | 0 | 1 | 0
apm_package | apm_packages | 3 | 4 | 0
apm_package_version | apm_package_versions | 13 | 23 | 9
apm_parameter | apm_parameters | 8 | 9 | 0
apm_parameter_value | apm_parameter_values | 3 | 4 | 0
apm_service | apm_services | 0 | 1 | 0
application_group | application_groups | 0 | 2 | 1
authority | auth_authorities | 0 | 19 | 18
category | categories | 0 | 6 | 5
category_tree | category_trees | 0 | 2 | 1
composition_rel | composition_rels | 0 | 1 | 0
content_extlink | cr_extlinks | 3 | 4 | 0
content_folder | cr_folders | 2 | 6 | 3
content_item | cr_items | 3 | 12 | 8
content_keyword | cr_keywords | 2 | 6 | 3
content_revision | cr_revisions | 6 | 10 | 3
content_symlink | cr_symlinks | 1 | 3 | 1
content_template | cr_templates | 0 | 1 | 0
cr_item_child_rel | cr_child_rels | 4 | 5 | 0
cr_item_rel | cr_item_rels | 4 | 5 | 0
email_image | users_email_image | 0 | 1 | 0
email_image_rel | email_images | 0 | 1 | 0
file_storage_object | fs_root_folders | 0 | 2 | 1
forums_forum | forums_forums | 0 | 12 | 11
forums_message | forums_messages | 0 | 16 | 15
group | groups | 1 | 3 | 1
image | images | 2 | 3 | 0
journal_entry | journal_entries | 0 | 5 | 4
membership_rel | membership_rels | 0 | 2 | 1
notification | notifications | 0 | 10 | 9
notification_delivery_method | notification_delivery_methods | 0 | 4 | 3
notification_interval | notification_intervals | 0 | 3 | 2
notification_reply | notification_replies | 0 | 7 | 6
notification_request | notification_requests | 0 | 8 | 7
notification_type | notification_types | 0 | 5 | 4
party | parties | 2 | 3 | 0
pinds_blog_category | pinds_blog_categories | 0 | 4 | 3
pinds_blog_entry | pinds_blog_entries | 0 | 10 | 9
rel_constraint | rel_constraints | 0 | 5 | 4
rel_segment | rel_segments | 0 | 4 | 3
relationship | acs_rels | 0 | 4 | 3
rss_gen_subscr | rss_gen_subscrs | 4 | 8 | 3
site_node | site_nodes | 0 | 7 | 6
survey | surveys | 0 | 11 | 10
survey_question | survey_questions | 0 | 10 | 9
survey_response | survey_responses | 0 | 5 | 4
survey_section | survey_sections | 0 | 5 | 4
template_demo_note | template_demo_notes | 3 | 4 | 0
user | users | 1 | 18 | 16
user_portrait_rel | user_portraits | 0 | 1 | 0
weblogger_blogroll_entry | weblogger_blogroll_entries | 0 | 5 | 4
weblogger_channel | weblogger_channels | 0 | 3 | 2
Posted by
Malte Sussdorff
on 10/15/08 07:56 AM
I am curious... Last time I checked XoTCL DB API did not deal with the extension tables in acs_object_type_tables, so when I wanted to instantiate an object of the class this did not take into account the extension table and did not write into that extension table. Additionally I learned the hard way that you need to include the extension tables in an outer join (in contrast to the super class tables, which you can add in a normal join).
I added this in the Dynfield Class, though this support should end up in XoTCL DB class itself.
And fixing all those missing attributes would be great. Intranet Dynfields has a way to do this on the website, so you can choose to create a new attribute from a field in the database, therefore it might be much more convenient to do it manually there instead of going through psql and writing code on your own. This being said, having a default script which just makes some assumptions about the attribute and create them in one go is probably not such a bad move either.
Posted by
Malte Sussdorff
on 10/15/08 08:19 AM
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"
}
