Index: openacs-4/contrib/packages/simulation/tcl/object-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/tcl/Attic/object-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/contrib/packages/simulation/tcl/object-procs.tcl 11 Nov 2003 15:32:46 -0000 1.3 +++ openacs-4/contrib/packages/simulation/tcl/object-procs.tcl 11 Nov 2003 16:58:30 -0000 1.4 @@ -118,7 +118,7 @@ } if { $wrote_file_p } { - ns_log Notice "simulation::object::xml::generate_file - generated new XML file for package $package_id" + ns_log Notice "simulation::object::xml::generate_file - generated new XML file for package $package_id at \$file_path\"" } else { ns_log Notice "simulation::object::xml::generate_file - Did not generate new XML file for package $package_id" } @@ -185,7 +185,7 @@ # Get table names and id column names for the on_map_p attribute of each object type # By using the multirow we avoid a nested db_foreach - set parent_id [bcms::folder::get_id_by_package_id -parent_id 0] + set parent_id [bcms::folder::get_id_by_package_id -package_id $package_id] db_multirow -local sim_table_list select_sim_tables { select aot.table_name, aot.id_column @@ -205,7 +205,7 @@ # Object type loop. template::multirow -local foreach sim_table_list { - db_foreach select_on_map_objects " + set query " select ci.item_id as id, cr.title as name, ci.name as uri, @@ -226,7 +226,8 @@ and ci.live_revision = cr.revision_id and ci.parent_id = :parent_id order by ci.name - " { + " + db_foreach select_on_map_objects $query { set url "${full_package_url}object/$uri" set thumbnail_url "" @@ -235,10 +236,10 @@ set thumbnail_url "${full_package_url}object-content/${thumbnail_uri}" } } - + append xml_doc " \n" # Assuming var names are identical to XML tag names - set xml_tag_names {name url thumbnail_url description} + set xml_tag_names {id name url thumbnail_url description} foreach tag_name $xml_tag_names { append xml_doc " <${tag_name}>[ad_quotehtml [set ${tag_name}]]\n" } Index: openacs-4/contrib/packages/simulation/tcl/test/simulation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/tcl/test/Attic/simulation-procs.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/contrib/packages/simulation/tcl/test/simulation-procs.tcl 29 Oct 2003 12:58:42 -0000 1.1 +++ openacs-4/contrib/packages/simulation/tcl/test/simulation-procs.tcl 11 Nov 2003 16:58:30 -0000 1.2 @@ -26,3 +26,84 @@ aa_true "sim_simulations exists" [expr $simulation_rowcount >= 0] } } + +aa_register_case simulation__generate_xml { + Tests the simulation::object::xml::generate_file proc. + + @author Peter Marklund +} { + aa_run_with_teardown \ + -rollback \ + -test_code { + # Requiring a simulation package at /simulation + # TODO: this is restrictive, can we improve? + array set simulation_node [site_node::get_from_url -url "/simulation"] + set package_id $simulation_node(package_id) + + # Save file_path value + set old_file_path [simulation::object::xml::file_path $package_id] + + # Set test file path + set test_file_path "/tmp/test-map.xml" + parameter::set_value \ + -package_id $package_id \ + -parameter [simulation::object::xml::file_path_param_name] \ + -value $test_file_path + + # Generate file for first time + array unset result + array set result [simulation::object::xml::generate_file -package_id $package_id] + + # Check return values + aa_equals "should write file first time" $result(wrote_file_p) "1" + aa_equals "should write file first time with no errors" $result(errors) "" + + # Re generate file + array unset result + array set result [simulation::object::xml::generate_file -package_id $package_id] + + # Check return values + aa_equals "should not write file without change" $result(wrote_file_p) "0" + aa_equals "should not return errors when not writing" $result(errors) "" + + # Add a map item + set item_id [db_nextval acs_object_id_seq] + set parent_id [bcms::folder::get_id_by_package_id -package_id $package_id] + set content_type "sim_location" + set item_id [bcms::item::create_item \ + -item_id $item_id \ + -item_name "__temporary_test_item__" \ + -parent_id $parent_id \ + -content_type $content_type \ + -storage_type "text"] + set revision_id [bcms::revision::add_revision \ + -item_id $item_id \ + -title "__Temporary test item"] + bcms::revision::set_revision_status \ + -revision_id $revision_id \ + -status "live" + # TODO: how do I set this through a Tcl API? + db_dml set_on_map_p { + update sim_locations + set on_map_p = 't' + where home_id = :revision_id + } + + # Re-generate file + array unset result + array set result [simulation::object::xml::generate_file -package_id $package_id] + + # Check return values + aa_equals "should write file after change" $result(wrote_file_p) "1" + aa_equals "should not return errors when writing after change" $result(errors) "" + + # Reset the file_path parameter value + parameter::set_value \ + -package_id $package_id \ + -parameter [simulation::object::xml::file_path_param_name] \ + -value $old_file_path + + # Remove the test file + file delete -force $test_file_path + } +} Index: openacs-4/packages/simulation/tcl/object-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/tcl/object-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/simulation/tcl/object-procs.tcl 11 Nov 2003 15:32:46 -0000 1.3 +++ openacs-4/packages/simulation/tcl/object-procs.tcl 11 Nov 2003 16:58:30 -0000 1.4 @@ -118,7 +118,7 @@ } if { $wrote_file_p } { - ns_log Notice "simulation::object::xml::generate_file - generated new XML file for package $package_id" + ns_log Notice "simulation::object::xml::generate_file - generated new XML file for package $package_id at \$file_path\"" } else { ns_log Notice "simulation::object::xml::generate_file - Did not generate new XML file for package $package_id" } @@ -185,7 +185,7 @@ # Get table names and id column names for the on_map_p attribute of each object type # By using the multirow we avoid a nested db_foreach - set parent_id [bcms::folder::get_id_by_package_id -parent_id 0] + set parent_id [bcms::folder::get_id_by_package_id -package_id $package_id] db_multirow -local sim_table_list select_sim_tables { select aot.table_name, aot.id_column @@ -205,7 +205,7 @@ # Object type loop. template::multirow -local foreach sim_table_list { - db_foreach select_on_map_objects " + set query " select ci.item_id as id, cr.title as name, ci.name as uri, @@ -226,7 +226,8 @@ and ci.live_revision = cr.revision_id and ci.parent_id = :parent_id order by ci.name - " { + " + db_foreach select_on_map_objects $query { set url "${full_package_url}object/$uri" set thumbnail_url "" @@ -235,10 +236,10 @@ set thumbnail_url "${full_package_url}object-content/${thumbnail_uri}" } } - + append xml_doc " \n" # Assuming var names are identical to XML tag names - set xml_tag_names {name url thumbnail_url description} + set xml_tag_names {id name url thumbnail_url description} foreach tag_name $xml_tag_names { append xml_doc " <${tag_name}>[ad_quotehtml [set ${tag_name}]]\n" } Index: openacs-4/packages/simulation/tcl/test/simulation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/tcl/test/simulation-procs.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/simulation/tcl/test/simulation-procs.tcl 29 Oct 2003 12:58:42 -0000 1.1 +++ openacs-4/packages/simulation/tcl/test/simulation-procs.tcl 11 Nov 2003 16:58:30 -0000 1.2 @@ -26,3 +26,84 @@ aa_true "sim_simulations exists" [expr $simulation_rowcount >= 0] } } + +aa_register_case simulation__generate_xml { + Tests the simulation::object::xml::generate_file proc. + + @author Peter Marklund +} { + aa_run_with_teardown \ + -rollback \ + -test_code { + # Requiring a simulation package at /simulation + # TODO: this is restrictive, can we improve? + array set simulation_node [site_node::get_from_url -url "/simulation"] + set package_id $simulation_node(package_id) + + # Save file_path value + set old_file_path [simulation::object::xml::file_path $package_id] + + # Set test file path + set test_file_path "/tmp/test-map.xml" + parameter::set_value \ + -package_id $package_id \ + -parameter [simulation::object::xml::file_path_param_name] \ + -value $test_file_path + + # Generate file for first time + array unset result + array set result [simulation::object::xml::generate_file -package_id $package_id] + + # Check return values + aa_equals "should write file first time" $result(wrote_file_p) "1" + aa_equals "should write file first time with no errors" $result(errors) "" + + # Re generate file + array unset result + array set result [simulation::object::xml::generate_file -package_id $package_id] + + # Check return values + aa_equals "should not write file without change" $result(wrote_file_p) "0" + aa_equals "should not return errors when not writing" $result(errors) "" + + # Add a map item + set item_id [db_nextval acs_object_id_seq] + set parent_id [bcms::folder::get_id_by_package_id -package_id $package_id] + set content_type "sim_location" + set item_id [bcms::item::create_item \ + -item_id $item_id \ + -item_name "__temporary_test_item__" \ + -parent_id $parent_id \ + -content_type $content_type \ + -storage_type "text"] + set revision_id [bcms::revision::add_revision \ + -item_id $item_id \ + -title "__Temporary test item"] + bcms::revision::set_revision_status \ + -revision_id $revision_id \ + -status "live" + # TODO: how do I set this through a Tcl API? + db_dml set_on_map_p { + update sim_locations + set on_map_p = 't' + where home_id = :revision_id + } + + # Re-generate file + array unset result + array set result [simulation::object::xml::generate_file -package_id $package_id] + + # Check return values + aa_equals "should write file after change" $result(wrote_file_p) "1" + aa_equals "should not return errors when writing after change" $result(errors) "" + + # Reset the file_path parameter value + parameter::set_value \ + -package_id $package_id \ + -parameter [simulation::object::xml::file_path_param_name] \ + -value $old_file_path + + # Remove the test file + file delete -force $test_file_path + } +}