Index: openacs-4/contrib/packages/simulation/lib/object-display.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/lib/Attic/object-display.tcl,v diff -u -r1.10 -r1.11 --- openacs-4/contrib/packages/simulation/lib/object-display.tcl 14 Nov 2003 11:40:35 -0000 1.10 +++ openacs-4/contrib/packages/simulation/lib/object-display.tcl 18 Nov 2003 13:31:31 -0000 1.11 @@ -12,7 +12,7 @@ set root_id [bcms::folder::get_id_by_package_id -parent_id 0] # This little exercise removes the object/ part from the extra_url -set extra_url [eval file join [lrange [file split [ad_conn extra_url]] 2 end]] +set extra_url [eval file join [lrange [file split [ad_conn extra_url]] 1 end]] if { [empty_string_p $extra_url] } { set extra_url "index" @@ -76,7 +76,7 @@ multirow create attributes attribute value set page_title $item(title) -set context [list [list ../object-list "Objects"] $page_title] +set context [list $page_title] foreach name [lsort [array names content]] { multirow append attributes $name $content($name) @@ -97,11 +97,12 @@ -item_id $item(item_id) \ -relation_tag stylesheet \ -return_list] -set first_stylesheet [lindex $related_stylesheets 0] -set stylesheet_id [ns_set get $first_stylesheet item_id] -if { [exists_and_not_null stylesheet_id] } { +if { [llength $related_stylesheets] > 0 } { + set first_stylesheet [lindex $related_stylesheets 0] + set stylesheet_id [ns_set get $first_stylesheet item_id] + array set item [bcms::item::get_item -item_id $stylesheet_id] - set stylesheet_url [file join [ad_conn package_url] object-content $item(name)] + set stylesheet_url [simulation::object::content_url -name $item(name)] } else { set stylesheet_url {} } Index: openacs-4/contrib/packages/simulation/lib/sim-objects.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/lib/Attic/sim-objects.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/contrib/packages/simulation/lib/sim-objects.tcl 18 Nov 2003 12:19:38 -0000 1.3 +++ openacs-4/contrib/packages/simulation/lib/sim-objects.tcl 18 Nov 2003 13:31:31 -0000 1.4 @@ -98,10 +98,10 @@ switch -glob $mime_type { text/* - {} { - set view_url [export_vars -base "object/$name"] + set view_url [simulation::object::url -name $name] } default { - set view_url [export_vars -base "object-content/$name"] + set view_url [simulation::object::content_url -name $name] } } } 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.4 -r1.5 --- openacs-4/contrib/packages/simulation/tcl/object-procs.tcl 11 Nov 2003 16:58:30 -0000 1.4 +++ openacs-4/contrib/packages/simulation/tcl/object-procs.tcl 18 Nov 2003 13:31:32 -0000 1.5 @@ -9,6 +9,40 @@ namespace eval simulation::object {} namespace eval simulation::object::xml {} +ad_proc -private simulation::object::url { + {-package_id ""} + {-name:required} +} { + The URL for the page displaying contents and name of + an item. +} { + if { [empty_string_p $package_id] } { + set package_url [ad_conn package_url] + } else { + set package_id [ad_conn package_id] + set package_url "[ad_url][apm_package_url_from_id $package_id]" + } + + return "${package_url}object/${name}" +} + +ad_proc -private simulation::object::content_url { + {-package_id ""} + {-name:required} +} { + The URL for serving up only the content of an item + with given name. +} { + if { [empty_string_p $package_id] } { + set package_url [ad_conn package_url] + } else { + set package_id [ad_conn package_id] + set package_url "[ad_url][apm_package_url_from_id $package_id]" + } + + return "${package_url}object-content/${name}" +} + ad_proc -private simulation::object::xml::file_sweeper {} { Loop over all simulation package instances and re-generate XML map files for them. @@ -181,8 +215,6 @@ set package_id [ad_conn package_id] } - set full_package_url "[ad_url][apm_package_url_from_id $package_id]" - # 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 -package_id $package_id] @@ -228,12 +260,12 @@ order by ci.name " db_foreach select_on_map_objects $query { - set url "${full_package_url}object/$uri" + set url [simulation::object::content_url -package_id $package_id -name $uri] set thumbnail_url "" if { [lsearch -exact {sim_location sim_prop sim_character} $content_type] != -1 } { if { ![empty_string_p $thumbnail_uri] } { - set thumbnail_url "${full_package_url}object-content/${thumbnail_uri}" + set thumbnail_url [simulation::object::content_url -package_id $package_id -name $thumbnail_uri] } } 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.3 -r1.4 --- openacs-4/contrib/packages/simulation/tcl/test/simulation-procs.tcl 12 Nov 2003 09:36:10 -0000 1.3 +++ openacs-4/contrib/packages/simulation/tcl/test/simulation-procs.tcl 18 Nov 2003 13:31:33 -0000 1.4 @@ -8,6 +8,14 @@ set name [ad_generate_random_string] aa_register_case simulation__data_model { + Test the simulation::object:url and simulation::object::content_url + procs. +} { + aa_log [simulation::object::url -name "test_name"] + aa_log [simulation::object::content_url -name "test_name"] +} + +aa_register_case simulation__data_model { Checks that the data model is present. @author Joel Aufrecht Index: openacs-4/contrib/packages/simulation/test/crawl-links.test =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/test/Attic/crawl-links.test,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/simulation/test/crawl-links.test 18 Nov 2003 13:31:33 -0000 1.1 @@ -0,0 +1,26 @@ +#if { [catch { + # Source Tcl libraries + set script_dir [file dirname [info script]] + source "${script_dir}/../../../etc/install/tcl/test-procs.tcl" + source "${script_dir}/simulation-test-procs.tcl" + + # Test Execution START + + ::twt::log_section "Login the site wide admin" + ::twt::user::login_site_wide_admin + + set simulation_uri /simulation + ::twt::log_section "crawling links starting from $simulation_uri" + ::twt::crawl_links $simulation_uri + +# } result] } { +# global errorInfo + +# # Output error stack trace and HTML response body +# ::twt::log $result +# ::twt::log "*** Tcl TRACE ***" +# ::twt::log $errorInfo +# ::twt::log "The response body is: [response body]" + +# error "Test failed: $result" +# } Index: openacs-4/contrib/packages/simulation/www/map-master.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/www/Attic/map-master.adp,v diff -u -r1.3 -r1.4 --- openacs-4/contrib/packages/simulation/www/map-master.adp 18 Nov 2003 09:44:31 -0000 1.3 +++ openacs-4/contrib/packages/simulation/www/map-master.adp 18 Nov 2003 13:31:33 -0000 1.4 @@ -29,5 +29,3 @@ - - Index: openacs-4/contrib/packages/simulation/www/simulation-master.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/www/Attic/simulation-master.adp,v diff -u -r1.5 -r1.6 --- openacs-4/contrib/packages/simulation/www/simulation-master.adp 18 Nov 2003 09:44:31 -0000 1.5 +++ openacs-4/contrib/packages/simulation/www/simulation-master.adp 18 Nov 2003 13:31:33 -0000 1.6 @@ -8,7 +8,7 @@ Configuration | Documentation | Tests + href="@documentation_url@">Documentation | Tests Index: openacs-4/contrib/packages/simulation/www/simulation-master.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/www/Attic/simulation-master.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/contrib/packages/simulation/www/simulation-master.tcl 18 Nov 2003 09:44:31 -0000 1.2 +++ openacs-4/contrib/packages/simulation/www/simulation-master.tcl 18 Nov 2003 13:31:33 -0000 1.3 @@ -2,3 +2,4 @@ set return_url [ad_return_url] set admin_p [permission::permission_p -object_id $package_id -privilege admin] set parameters_url [export_vars -base "/shared/parameters" {package_id return_url}] +set documentation_url /doc/simulation \ No newline at end of file Index: openacs-4/contrib/packages/simulation/www/citybuild/object-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/simulation/www/citybuild/Attic/object-edit.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/contrib/packages/simulation/www/citybuild/object-edit.tcl 14 Nov 2003 11:40:35 -0000 1.3 +++ openacs-4/contrib/packages/simulation/www/citybuild/object-edit.tcl 18 Nov 2003 13:31:33 -0000 1.4 @@ -719,7 +719,7 @@ set rel_obj_name [db_string name { select name from cr_items where item_id = :related_object_id } -default {}] if { ![empty_string_p $rel_obj_name] } { - set thumb_url [export_vars -base "object-content/$rel_obj_name"] + set thumb_url [simulation::object::content_url -name $rel_obj_name] append elm_before_html {} append elm_before_html { } append elm_before_html { 0 } { + set first_stylesheet [lindex $related_stylesheets 0] + set stylesheet_id [ns_set get $first_stylesheet item_id] + array set item [bcms::item::get_item -item_id $stylesheet_id] - set stylesheet_url [file join [ad_conn package_url] object-content $item(name)] + set stylesheet_url [simulation::object::content_url -name $item(name)] } else { set stylesheet_url {} } Index: openacs-4/packages/simulation/lib/sim-objects.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/lib/sim-objects.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/simulation/lib/sim-objects.tcl 18 Nov 2003 12:19:38 -0000 1.3 +++ openacs-4/packages/simulation/lib/sim-objects.tcl 18 Nov 2003 13:31:31 -0000 1.4 @@ -98,10 +98,10 @@ switch -glob $mime_type { text/* - {} { - set view_url [export_vars -base "object/$name"] + set view_url [simulation::object::url -name $name] } default { - set view_url [export_vars -base "object-content/$name"] + set view_url [simulation::object::content_url -name $name] } } } 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.4 -r1.5 --- openacs-4/packages/simulation/tcl/object-procs.tcl 11 Nov 2003 16:58:30 -0000 1.4 +++ openacs-4/packages/simulation/tcl/object-procs.tcl 18 Nov 2003 13:31:32 -0000 1.5 @@ -9,6 +9,40 @@ namespace eval simulation::object {} namespace eval simulation::object::xml {} +ad_proc -private simulation::object::url { + {-package_id ""} + {-name:required} +} { + The URL for the page displaying contents and name of + an item. +} { + if { [empty_string_p $package_id] } { + set package_url [ad_conn package_url] + } else { + set package_id [ad_conn package_id] + set package_url "[ad_url][apm_package_url_from_id $package_id]" + } + + return "${package_url}object/${name}" +} + +ad_proc -private simulation::object::content_url { + {-package_id ""} + {-name:required} +} { + The URL for serving up only the content of an item + with given name. +} { + if { [empty_string_p $package_id] } { + set package_url [ad_conn package_url] + } else { + set package_id [ad_conn package_id] + set package_url "[ad_url][apm_package_url_from_id $package_id]" + } + + return "${package_url}object-content/${name}" +} + ad_proc -private simulation::object::xml::file_sweeper {} { Loop over all simulation package instances and re-generate XML map files for them. @@ -181,8 +215,6 @@ set package_id [ad_conn package_id] } - set full_package_url "[ad_url][apm_package_url_from_id $package_id]" - # 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 -package_id $package_id] @@ -228,12 +260,12 @@ order by ci.name " db_foreach select_on_map_objects $query { - set url "${full_package_url}object/$uri" + set url [simulation::object::content_url -package_id $package_id -name $uri] set thumbnail_url "" if { [lsearch -exact {sim_location sim_prop sim_character} $content_type] != -1 } { if { ![empty_string_p $thumbnail_uri] } { - set thumbnail_url "${full_package_url}object-content/${thumbnail_uri}" + set thumbnail_url [simulation::object::content_url -package_id $package_id -name $thumbnail_uri] } } 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.3 -r1.4 --- openacs-4/packages/simulation/tcl/test/simulation-procs.tcl 12 Nov 2003 09:36:10 -0000 1.3 +++ openacs-4/packages/simulation/tcl/test/simulation-procs.tcl 18 Nov 2003 13:31:33 -0000 1.4 @@ -8,6 +8,14 @@ set name [ad_generate_random_string] aa_register_case simulation__data_model { + Test the simulation::object:url and simulation::object::content_url + procs. +} { + aa_log [simulation::object::url -name "test_name"] + aa_log [simulation::object::content_url -name "test_name"] +} + +aa_register_case simulation__data_model { Checks that the data model is present. @author Joel Aufrecht Index: openacs-4/packages/simulation/test/crawl-links.test =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/test/Attic/crawl-links.test,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/simulation/test/crawl-links.test 18 Nov 2003 13:31:33 -0000 1.1 @@ -0,0 +1,26 @@ +#if { [catch { + # Source Tcl libraries + set script_dir [file dirname [info script]] + source "${script_dir}/../../../etc/install/tcl/test-procs.tcl" + source "${script_dir}/simulation-test-procs.tcl" + + # Test Execution START + + ::twt::log_section "Login the site wide admin" + ::twt::user::login_site_wide_admin + + set simulation_uri /simulation + ::twt::log_section "crawling links starting from $simulation_uri" + ::twt::crawl_links $simulation_uri + +# } result] } { +# global errorInfo + +# # Output error stack trace and HTML response body +# ::twt::log $result +# ::twt::log "*** Tcl TRACE ***" +# ::twt::log $errorInfo +# ::twt::log "The response body is: [response body]" + +# error "Test failed: $result" +# } Index: openacs-4/packages/simulation/www/map-master.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/www/map-master.adp,v diff -u -r1.3 -r1.4 --- openacs-4/packages/simulation/www/map-master.adp 18 Nov 2003 09:44:31 -0000 1.3 +++ openacs-4/packages/simulation/www/map-master.adp 18 Nov 2003 13:31:33 -0000 1.4 @@ -29,5 +29,3 @@ - - Index: openacs-4/packages/simulation/www/simulation-master.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/www/simulation-master.adp,v diff -u -r1.5 -r1.6 --- openacs-4/packages/simulation/www/simulation-master.adp 18 Nov 2003 09:44:31 -0000 1.5 +++ openacs-4/packages/simulation/www/simulation-master.adp 18 Nov 2003 13:31:33 -0000 1.6 @@ -8,7 +8,7 @@ Configuration | Documentation | Tests + href="@documentation_url@">Documentation | Tests Index: openacs-4/packages/simulation/www/simulation-master.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/www/simulation-master.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/simulation/www/simulation-master.tcl 18 Nov 2003 09:44:31 -0000 1.2 +++ openacs-4/packages/simulation/www/simulation-master.tcl 18 Nov 2003 13:31:33 -0000 1.3 @@ -2,3 +2,4 @@ set return_url [ad_return_url] set admin_p [permission::permission_p -object_id $package_id -privilege admin] set parameters_url [export_vars -base "/shared/parameters" {package_id return_url}] +set documentation_url /doc/simulation \ No newline at end of file Index: openacs-4/packages/simulation/www/citybuild/object-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/simulation/www/citybuild/object-edit.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/simulation/www/citybuild/object-edit.tcl 14 Nov 2003 11:40:35 -0000 1.3 +++ openacs-4/packages/simulation/www/citybuild/object-edit.tcl 18 Nov 2003 13:31:33 -0000 1.4 @@ -719,7 +719,7 @@ set rel_obj_name [db_string name { select name from cr_items where item_id = :related_object_id } -default {}] if { ![empty_string_p $rel_obj_name] } { - set thumb_url [export_vars -base "object-content/$rel_obj_name"] + set thumb_url [simulation::object::content_url -name $rel_obj_name] append elm_before_html {} append elm_before_html { } append elm_before_html {