_categories__category_tree_procs (private)
_categories__category_tree_procs
Defined in packages/categories/tcl/test/categories-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 { # # Create tree # set tree_name foo set tree_description "Just a dummy category tree" set tree_site_wide_p f set tree_id [category_tree::add -description $tree_description -site_wide_p $tree_site_wide_p -name $tree_name] aa_log "Category tree: $tree_name $tree_id" # # Create root category # set root_category_id [category::add -tree_id $tree_id -parent_id "" -name $tree_name] aa_log "Root category: $root_category_id" # # Create children categories # set children {bar1 "" bar2 "" bar3 ""} dict for { name id } $children { set category_id [category::add -tree_id $tree_id -parent_id $root_category_id -description "My category $name" -name $name] dict set children $name $category_id aa_log "New children category: $name $category_id" } # # Create a couple of objects # set object_id_1 [package_instantiate_object acs_object] set object_id_2 [package_instantiate_object acs_object] set object_ids [list $object_id_1 $object_id_2] aa_log "New objects: $object_id_1 $object_id_2" # # Get name # aa_equals "Check category tree name" "[category_tree::get_name $tree_id]" $tree_name # # Get data # aa_equals "Check category tree data" "[category_tree::get_data $tree_id]" "description {$tree_description} tree_name $tree_name site_wide_p $tree_site_wide_p" # # Get ID by name/title # aa_equals "Check category tree ID by name" "[category_tree::get_id $tree_name]" $tree_id aa_equals "Check category tree ID by object title" "[category_tree::get_id_by_object_title -title $tree_name]" $tree_id # # Get root categories of a tree # aa_equals "Check root categories of a tree" "[category_tree::get_categories -tree_id $tree_id]" "$root_category_id" # # Map category tree to an object # category_tree::map -tree_id $tree_id -object_id $object_id_1 category_tree::map -tree_id $tree_id -object_id $object_id_2 aa_equals "Check mapped category trees of an object" "[lindex [category_tree::get_mapped_trees $object_id_1] 0 0]" "$tree_id" foreach mapped_trees [category_tree::get_mapped_trees_from_object_list $object_ids] { aa_equals "Check mapped category trees of an object list" "[lindex $mapped_trees 0 0]" "$tree_id" } set user_id [ad_conn user_id] aa_equals "category_tree::usage returns expected" [category_tree::usage $tree_id] [db_list_of_lists category_tree_usage { select t.pretty_plural, n.object_id, n.title, p.package_id, p.instance_name, acs_permission.permission_p(n.object_id, :user_id, 'read') as read_p from category_tree_map m, acs_objects n, apm_packages p, apm_package_types t where m.tree_id = :tree_id and n.object_id = m.object_id and p.package_id = n.package_id and t.package_key = p.package_key }] # # Edit mapping # category_tree::edit_mapping -tree_id $tree_id -object_id $object_id_1 -assign_single_p t -require_category_p t set assign_single_p [lindex [category_tree::get_mapped_trees $object_id_1] 0 3] set require_category_p [lindex [category_tree::get_mapped_trees $object_id_1] 0 4] aa_equals "Check edited mapped category trees of an object" "assign_single_p: $assign_single_p require_category_p: $require_category_p" "assign_single_p: t require_category_p: t" category_tree::edit_mapping -tree_id $tree_id -object_id $object_id_1 -assign_single_p f -require_category_p f set assign_single_p [lindex [category_tree::get_mapped_trees $object_id_1] 0 3] set require_category_p [lindex [category_tree::get_mapped_trees $object_id_1] 0 4] aa_equals "Check edited mapped category trees of an object" "assign_single_p: $assign_single_p require_category_p: $require_category_p" "assign_single_p: f require_category_p: f" # # Unmap # category_tree::unmap -tree_id $tree_id -object_id $object_id_1 category_tree::unmap -tree_id $tree_id -object_id $object_id_2 aa_equals "Check unmapped category trees of an object" "[category_tree::get_mapped_trees $object_id_1]" "" aa_equals "Check unmapped category trees of an object list" "[category_tree::get_mapped_trees_from_object_list $object_ids]" "" # # Copy # set copy_tree_name "bar" set copy_tree_description "Copied tree" set copy_tree_id [category_tree::add -description $copy_tree_description -site_wide_p f -name $copy_tree_name] aa_log "Category tree: $copy_tree_name $copy_tree_id" category_tree::copy -source_tree $tree_id -dest_tree $copy_tree_id set copy_root_category_id [category_tree::get_categories -tree_id $copy_tree_id] aa_equals "Check copied category tree root name" "[category::get_name $copy_root_category_id]" "$tree_name" aa_equals "Check copied category children" "[lsort [category::get_names [category::get_children -category_id $copy_root_category_id]]]" "[lsort [dict keys $children]]" aa_equals "Count category children" [category::count_children -category_id $copy_root_category_id] 3 # # Change parent (make bar1 parent of bar2) # set bar1_id [dict get $children bar1] set bar2_id [dict get $children bar2] category::change_parent -category_id $bar1_id -tree_id $copy_tree_id -parent_id $bar2_id aa_equals "Check new parent category children" "[category::get_children -category_id $bar2_id]" "$bar1_id" # # Create a meta category from bar1 and bar2 # set user_info [acs::test::user::create] set user_id [dict get $user_info user_id] set user_meta_category_id [category::relation::add_meta_category -category_id_one $bar1_id -category_id_two $bar2_id -user_id $user_id] set meta_category_id [relation::get_object_one -rel_type "user_meta_category_rel" -object_id_two $user_id] aa_log "New meta category $meta_category_id from $bar1_id and $bar2_id" aa_equals "Check categories from a meta category" "[lsort [category::relation::get_meta_categories -rel_id $meta_category_id]]" "[lsort [list $bar1_id $bar2_id]]" # # Update # set new_description "The new description" set new_name "The new name" category_tree::update -tree_id $copy_tree_id -name $new_name -description $new_description aa_equals "Check updated category tree data" "[category_tree::get_data $copy_tree_id]" "description {$new_description} tree_name {$new_name} site_wide_p f" # # Delete # aa_true "Check category tree before deletion" [category_tree::exists_p $copy_tree_id] category_tree::delete $copy_tree_id aa_false "Check category tree after deletion" [category_tree::exists_p $copy_tree_id] } }} { 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" "category_tree_procs (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo" } incr body_count }XQL Not present: Generic, PostgreSQL, Oracle