Index: openacs-4/packages/tlf-assignments/tcl/test/tlf-assignment-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/tlf-assignments/tcl/test/tlf-assignment-test-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/tlf-assignments/tcl/test/tlf-assignment-test-procs.tcl 22 Nov 2023 12:23:01 -0000 1.1
@@ -0,0 +1,187 @@
+namespace eval ::tlf_cassignments {
+ aa_register_init_class \
+ tlf_assignment_require_test_instance {
+ Make sure the test instance is there and create it if necessary.
+ } {
+ aa_export_vars {_test_instance_name _test_instance_package_id _user_id _user_info}
+ set _test_instance_name /tlf-assignments-test
+ set package_id [::acs::test::require_package_instance \
+ -package_key tlf-assignments \
+ -instance_name $_test_instance_name \
+ -empty]
+
+ set _test_instance_package_id $package_id
+ aa_log "Test instance package_id: $_test_instance_package_id"
+ set _user_id [db_nextval acs_object_id_seq]
+ set _user_info [acs::test::user::create -user_id $_user_id -admin]
+ acs::test::confirm_email -user_id $_user_id
+ } {
+ #
+ # Cleanup: unmount the test instance
+ #
+ set node_id [site_node::get_node_id_from_object_id -object_id $_test_instance_package_id]
+ site_node::unmount -node_id $node_id
+ site_node::delete -node_id $node_id -delete_package
+ #
+ # Delete the test user
+ #
+ ::xo::dc list delete {
+ select acs_object__delete(object_id)
+ from acs_objects
+ where creation_user in (:_user_id)
+ }
+ acs::test::user::delete -user_id $_user_id
+ }
+
+ aa_register_case -init_classes {tlf_assignment_require_test_instance} -cats {web} -procs {
+ "::xowiki::Package lookup"
+ } tlf_assignment_items_exist {
+ Check if workflow items are available after correct installation
+ } {
+ set user_id $_user_id
+ set user_info $_user_info
+ set instance $_test_instance_name
+ ::xo::Package initialize -url $instance/
+ set submit_item [::$package_id lookup -name abgabe-stud.wf]
+ aa_true "submission wf item is not 0" {$submit_item != 0}
+ set create_item [::$package_id lookup -name create-assignment.wf]
+ aa_true "create wf item is not 0" {$create_item != 0}
+ }
+
+ aa_register_case -procs {
+ tlf_assignment_portlet::add_self_to_page
+ tlf_assignment_portlet::remove_self_from_page
+ } -cats {
+ api
+ } tlf_assignment_add_remove_from_page {
+ Test add/remove portlet procs.
+ } {
+ #
+ # Helper proc to check portal elements
+ #
+ proc portlet_exists_p {portal_id} {
+ set portlet_name [tlf_assignment_portlet::get_my_name]
+ return [db_0or1row portlet_in_portal {
+ select 1 from dual where exists (
+ select 1
+ from portal_element_map pem,
+ portal_pages pp
+ where pp.portal_id = :portal_id
+ and pp.page_id = pem.page_id
+ and pem.name = :portlet_name
+ )
+ }]
+ }
+
+ aa_run_with_teardown -rollback -test_code {
+ set community_id [dotlrn_community::new -community_type dotlrn_community -pretty_name test]
+ if {$community_id eq ""} {
+ aa_error "Community creation failed"
+ }
+ set portal_id [dotlrn_community::get_admin_portal_id -community_id $community_id]
+ set package_id [dotlrn::instantiate_and_mount $community_id [ast_installer package_key]]
+
+ #add portlet
+ tlf_assignment_portlet::add_self_to_page \
+ -portal_id $portal_id \
+ -package_id $package_id \
+ -param_action ""
+ aa_true "Portlet is in community portal after addition" "[portlet_exists_p $portal_id]"
+ #remove portlet
+ tlf_assignment_portlet::remove_self_from_page \
+ -portal_id $portal_id \
+ -package_id $package_id
+ aa_false "Portlet is in community portal after removal" "[portlet_exists_p $portal_id]"
+ #re-add portlet
+ tlf_assignment_portlet::add_self_to_page \
+ -portal_id $portal_id \
+ -package_id $package_id \
+ -param_action ""
+ aa_true "Portlet is in community portal after addition" "[portlet_exists_p $portal_id]"
+ }
+ }
+
+ aa_register_case -procs {
+ "tlf_assignment_portlet::show"
+ } -cats {
+ api
+ smoke
+ } tlf_assignment_render_portlet {
+ Test rendering of the portlet
+ } {
+ set package_id [db_string get_any_bm {
+ select max(package_id) from apm_packages
+ where package_key = 'tlf-assignments'
+ }]
+ aa_log "package_id $package_id"
+ set cf [list \
+ package_id $package_id \
+ shaded_p false \
+ scoped_p false \
+ ]
+ set portlet [acs_sc::invoke \
+ -contract portal_datasource \
+ -operation Show \
+ -impl tlf_assignment_portlet \
+ -call_args [list $cf]]
+
+ aa_log "Portlet returns: [ns_quotehtml $portlet]"
+
+ aa_false "No error was returned" {
+ [string first "Error in include template" $portlet] >= 0
+ }
+ }
+
+ aa_register_case -procs {
+ "AssignmentCoreWFprocs www-submit"
+ } -init_classes {
+ tlf_assignment_require_test_instance
+ } -cats {
+ api smoke
+ } tlf_assignment_create_new_assignment {
+ creates a new assignment and submits it
+ } {
+ set user_id $_user_id
+ set user_info $_user_info
+ set instance $_test_instance_name
+ ::xo::Package initialize -url $instance/
+ set request_info [acs::test::login $user_info]
+ #create new assignment
+ set testassignment [::xowiki::test::create_form_page \
+ -user_id $user_id \
+ -last_request $request_info \
+ -instance $instance \
+ -parent_id [$package_id set folder_id] \
+ -form_name create-assignment.wf \
+ -path "" \
+ -update {
+ _title "Test Assignment"
+ _name create_assignment1
+ __action_create_new ""
+ exercise_form "textarea"
+ beurteilung "sofort"
+ modus "passed"
+ }]
+ set assignment_item [dict get $testassignment item_id]
+ aa_equals item_state "[$assignment_item state]" "assign"
+ #publish new assignment
+ set page [::xowiki::test::edit_form_page \
+ -user_id $user_id \
+ -last_request $request_info \
+ -instance $instance \
+ -refetch=false \
+ -path create_assignment1 \
+ -update {
+ __action_saveZB ""
+ zuweisen "alle"
+ }
+ ]
+ #submit assignment
+ set d [acs::test::http \
+ -user_id $user_id \
+ -depth 2 \
+ -last_request $request_info \
+ [export_vars -base $instance/create_assignment1 {{m submit}}]]
+ aa_equals submit_status [dict get $d status] 200
+ }
+}