_xotcl-core__xotcl_core_tutorial_2 (private)
_xotcl-core__xotcl_core_tutorial_2
Defined in packages/xotcl-core/tcl/test/xotcl-core-db-tutorial-procs.tcl
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
Source code: set _aa_export {} set body_count 1 foreach testcase_body {{ aa_run_with_teardown -rollback -test_code { ############################################################ # # 2) Create new ACS Object Types, ACS Attributes and # SQL Tables from XOTcl Classes with slot definitions. # # Create a new ACS Object type and an XOTcl class named ::demo::Person. aa_false "Does the ACS Object type ::demo::Person exist in the database" [::xo::db::Class object_type_exists_in_db -object_type ::demo::Person] # We create a new XOTcl Class '::demo::Person'. # By defining this class, the database layer takes care # of creating the ACS Object Type and the necessary table via SQL. # The persistent attributes (stored in the database) are defined # as slots of type ::xo::db::Attribute. set cl [::xo::db::Class create ::demo::Person -superclass ::xo::db::Object -slots { ::xo::db::Attribute create name -column_name pname ::xo::db::Attribute create age -default 0 -datatype integer ::xo::db::Attribute create projects -default {} -multivalued true }] aa_equals "created class has name ::demo::Person" $cl "::demo::Person" aa_true "the object_type ::demo::Person exists" [::xo::db::Class object_type_exists_in_db -object_type ::demo::Person] aa_equals "the SQL attributes are slot names" [lsort [::demo::Person array names db_slot]] {age name person_id projects} # # Create a new instance of ::demo::Person with name 'Gustaf' # # The method 'new_persistent_object' of a database class (instance of ::xo::db::Class) # creates an ACS Object with a fresh id in the database and # creates as well an XOTcl object in memory set p [::demo::Person new_persistent_object -name Gustaf -age 105] aa_true "'$p' looks like a valid object name" [regexp {^::\d+$} $p] aa_true "object $p exists in memory" [nsf::is object $p] set id [$p object_id] aa_true "object $p exists in the db" [::xo::db::Class exists_in_db -id $id] # modify some attributes of the XOTcl object set new_age [$p incr age] # save the modified object data in the database $p save # deleting XOTcl object $p in memory $p destroy aa_true "check, if object $p exists in the database" [::xo::db::Class exists_in_db -id $id] # fetch person again from database: set p [::xo::db::Class get_instance_from_db -id $id] # get the age from the instance set age [$p age] aa_true "age equals the modified age" {$age eq $new_age} #"::xo::db::Class proc delete" ::xo::db::Class delete -id $id aa_false "check, if object $p is deleted in the database" [::xo::db::Class exists_in_db -id $id] # # Now, we create a subclass of ::demo::Person called ::demo::Employee # which has a few more attributes. Again, we define an XOTcl class # ::demo::Employee which creates the ACS Object Type, the ACS # attributes and the table, if necessary. aa_false "Does the ACS Object type ::demo::Employee exist in the database" [::xo::db::Class object_type_exists_in_db -object_type ::demo::Employee] set cl [::xo::db::Class create ::demo::Employee -superclass ::demo::Person -table_name demo_employee -id_column employee_id -slots { ::xo::db::Attribute create salary -datatype integer ::xo::db::Attribute create dept_nr -datatype integer -default "0" }] aa_equals "created class has name ::demo::Employee" $cl "::demo::Employee" aa_true "the object_type ::demo::Employee exists" [::xo::db::Class object_type_exists_in_db -object_type ::demo::Employee] aa_equals "the SQL attributes are slot names" [lsort [::demo::Employee array names db_slot]] {dept_nr employee_id salary} set ot [::demo::Employee object_types] aa_true "demo::Employee has object_types <$ot>" {$ot eq "::demo::Employee"} } }} { aa_log "Running testcase body $body_count" set ::__aa_test_indent [info level] set catch_val [catch $testcase_body msg] if {$catch_val != 0 && $catch_val != 2} { aa_log_result "fail" "xotcl_core_tutorial_2 (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo" } incr body_count }XQL Not present: Generic, PostgreSQL, Oracle