_xotcl-core__xotcl_core_tutorial_4 (private)
_xotcl-core__xotcl_core_tutorial_4
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 { ############################################################ # 4) Create new application classes by sub-typing the # Content Repository, adding additional attributes # # We create a subclass of ::xo::db::CrItem called ::demo::Page # which has a few more attributes. Actually, this class is very # similar to ::xowiki::Page. Again, we define an XOTcl class # ::demo::Page which creates the ACS Object Type, the ACS # attributes and the table, if necessary. aa_false "Does the ACS Object type ::demo::Page exist in the database" [::xo::db::Class object_type_exists_in_db -object_type ::demo::Page] set cl [::xo::db::CrClass create ::demo::Page -superclass ::xo::db::CrItem -pretty_name "demo Page" -mime_type text/html -slots { ::xo::db::CrAttribute create creator }] aa_equals "created class is named ::demo::Page" "::demo::Page" $cl # Create a page object in memory. set i [::demo::Page new -name "page0" -title "Joke of the Month" -creator "GN" -text "Three cannibals meet in a NYC subway station..." ] # Save as a new item under default parent_id (-100), allocates fresh item_id set id [$i save_new] aa_true "the new id is larger than 10" {$id > 10} set item_id [$i item_id] aa_true "the returned id was the item_id" {$id == $item_id} set creator [$i creator] aa_true "the creator in the object is $creator" {$creator == "GN"} aa_log "i: <pre>[$i serialize]</pre>" # Destroy object in memory $i destroy # Fetch item per item_id from the database set o [::demo::Page get_instance_from_db -item_id $item_id] aa_true "the fetched object ($o) has the same item_id as before ($item_id)" {[$o item_id] eq $item_id} aa_log "o: <pre>[$o serialize]</pre>" set creator [$o creator] aa_true "the fetched creator is $creator" {$creator == "GN"} # # Lookup page from CR by name. In general, we do not know, of # which type a page with a certain name is, therefore, we use # ::xo::db::CrClass as interface. # set r [::xo::db::CrClass lookup -name page0] aa_true "lookup returned the item_id" {$r eq $item_id} # Modify the object. $o set title "Kilroy was here" # Save the object with a new revision. $o save $o destroy # # Fetch the object again from the DB and compare the title, # whether it is the new one. # set o [::demo::Page get_instance_from_db -item_id $item_id] aa_true "we fetched an object with the new title" { [$o title] eq "Kilroy was here" } set name en:ppage1 set object [::demo::Page new_persistent_object -name $name] aa_true "new_persistent_object returned <$object>" [nsf::is object $object] aa_true "name correct" {[$object name] eq $name} aa_log "<pre>[$object serialize]</pre>" set r [::xo::db::CrClass lookup -name $name] aa_true "lookup $name returned the item_id" {$r eq [$object item_id]} set o [::demo::Page get_instance_from_db -item_id [$object item_id]] aa_true "the fetched object has the same item_id as before" {[$o item_id] eq [$object item_id]} set item_id [$object item_id] # # delete the object only in the database (different to plain xo::db::Objects) # calls: ::xo::db::CrCache::Item, ::xo::db::CrItem # aa_log "delete method: [$object procsearch delete]" $object delete aa_true "persistent_object deleted in memory" [nsf::is object $object] $object destroy aa_false "persistent_object deleted in memory" [nsf::is object $object] set r [::xo::db::Class exists_in_db -id $item_id] aa_true "exists in db $item_id -> <$r>" {$r eq "0"} set ot [::demo::Page object_types] aa_true "demo::Page has object_types <$ot>" {$ot eq "::demo::Page"} # # Delete a fresh object via " xo::db::CrClass delete" # set name en:ppage2 set object [::demo::Page new_persistent_object -name $name] aa_true "new_persistent_object returned <$object>" [nsf::is object $object] set item_id [$object item_id] xo::db::CrClass delete -item_id $item_id aa_true "persistent_object deleted in memory" [nsf::is object $object] set r [::xo::db::Class exists_in_db -id $item_id] aa_true "exists in db $item_id -> <$r>" {$r eq "0"} # # Manual cleanup # aa_true "Does the ACS Object type ::demo::Page exist in the database" [::xo::db::Class object_type_exists_in_db -object_type ::demo::Page] aa_log "call [::demo::Page procsearch get_instances_from_db]" set instances [::demo::Page get_instances_from_db] aa_equals "get instances from demo page " [llength [$instances children]] 1 foreach o [$instances children] { aa_log "delete $o [$o info precedence]" xo::db::CrClass delete -item_id [$o item_id] } set instances [::demo::Page get_instances_from_db] aa_equals "get instances from demo page " [llength [$instances children]] 0 ::demo::Page drop_object_type aa_false "Does the ACS Object type ::demo::Page exist in the database" [::xo::db::Class object_type_exists_in_db -object_type ::demo::Page] } }} { 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_4 (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo" } incr body_count }XQL Not present: Generic, PostgreSQL, Oracle