_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