_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