Index: openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl,v diff -u -r1.85 -r1.86 --- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 17 Mar 2005 08:33:04 -0000 1.85 +++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 4 Jun 2006 00:45:47 -0000 1.86 @@ -28,7 +28,7 @@ } ### Scan for all unregistered .info files. - + ns_log Notice "apm_scan_packages: Scanning for new unregistered packages..." set new_spec_files [list] # Loop through all directories in the /packages directory, searching each for a @@ -125,7 +125,7 @@ } ad_proc -private pkg_info_new { package_key spec_file_path provides requires {dependency_p ""} {comment ""}} { - + Returns a datastructure that maintains information about a package. @param package_key The key of the package. @param spec_file_path The path to the package specification file @@ -156,8 +156,8 @@ } ad_proc -private pkg_info_path {pkg_info} { - + @return The full path of the packages dir stored in the package info map. Assumes that the info file is stored in the root dir of the package. @@ -386,11 +386,11 @@ available packages as returned by apm_get_package_repository. @return An array list with the following elements: - + @see apm_get_package_repository @@ -415,7 +415,7 @@ failed {} packages {} } - + # 'pending_packages' is an array keyed by package_key with a value of 1 for each package pending installation # When dependencies have been met, the entry will be unset array set pending_packages [list] @@ -812,7 +812,7 @@ apm_version_enable -callback $callback $version_id } - + # Instantiating, mounting, and after-install callback only invoked on initial install if { ! $upgrade_p } { # After install Tcl proc callback @@ -930,7 +930,7 @@ regsub {@.+} [cc_email_from_party [ad_get_user_id]] "" my_email_name set backup_dir "[apm_workspace_dir]/$package_key-removed-$my_email_name-[ns_fmttime [ns_time] "%Y%m%d-%H:%M:%S"]" - + apm_callback_and_log $callback "
  • Moving packages/$package_key to $backup_dir... " @@ -959,7 +959,7 @@ {-remove_files:boolean} package_key } { - + Deinstall a package from the system. Will unmount and uninstantiate package instances, invoke any before-unstall callback, source any provided sql drop scripts, remove message keys, and delete @@ -970,58 +970,60 @@ # Unmount all instances of this package with the Tcl API that # invokes before-unmount callbacks - db_foreach all_package_instances { - select site_nodes.node_id - from apm_packages, site_nodes - where apm_packages.package_id = site_nodes.object_id - and apm_packages.package_key = :package_key - } { - set url [site_node::get_url -node_id $node_id] - apm_callback_and_log $callback "Unmounting package instance at url $url
    " - site_node::unmount -node_id $node_id - } + db_transaction { + db_foreach all_package_instances { + select site_nodes.node_id + from apm_packages, site_nodes + where apm_packages.package_id = site_nodes.object_id + and apm_packages.package_key = :package_key + } { + set url [site_node::get_url -node_id $node_id] + apm_callback_and_log $callback "Unmounting package instance at url $url
    " + site_node::unmount -node_id $node_id + } - # Delete the package instances with Tcl API that invokes - # before-uninstantiate callbacks - db_foreach all_package_instances { - select package_id - from apm_packages - where package_key = :package_key - } { - apm_callback_and_log $callback "Deleting package instance $package_id
    " - apm_package_instance_delete $package_id - } + # Delete the package instances with Tcl API that invokes + # before-uninstantiate callbacks + db_foreach all_package_instances { + select package_id + from apm_packages + where package_key = :package_key + } { + apm_callback_and_log $callback "Deleting package instance $package_id
    " + apm_package_instance_delete $package_id + } - # Invoke the before-uninstall Tcl callback before the sql drop scripts - apm_invoke_callback_proc -version_id $version_id -type before-uninstall + # Invoke the before-uninstall Tcl callback before the sql drop scripts + apm_invoke_callback_proc -version_id $version_id -type before-uninstall + # Unregister I18N messages + lang::catalog::package_delete -package_key $package_key + + # Remove package from APM tables + apm_callback_and_log $callback "
  • Deleting $package_key..." + db_exec_plsql apm_package_delete { + begin + apm_package_type.drop_type( + package_key => :package_key, + cascade_p => 't' + ); + end; + } + } + # Source SQL drop scripts if {![empty_string_p $sql_drop_scripts]} { apm_callback_and_log $callback "Now executing drop scripts.

    " } + + if { [llength $data_model_files] } { + #Installations/upgrades are done in a separate process, making + #changes that could affect our sessions. This is particularly a + #problem with the content_item package on Oracle. To be on the safe + #side we refresh the db connections after each install/upgrade. + ns_log Debug "apm_package_install_data_model: Bouncing db pools." + db_bounce_pools + } } ad_proc -private apm_package_upgrade_parameters { @@ -1233,9 +1244,9 @@ } ad_proc -private apm_package_install_owners { {-callback apm_dummy_callback} owners version_id} { - + Install all of the owners of the package version. - + } { db_dml apm_delete_owners { delete from apm_package_owners where version_id = :version_id @@ -1410,7 +1421,7 @@ apm::package_version::attributes::store \ -version_id $version_id \ -array local_array - + return $version_id } @@ -1503,7 +1514,7 @@ } ad_proc -private apm_order_upgrade_scripts {upgrade_script_names} { - + Upgrade scripts are ordered so that they may be executed in a sequence that upgrades package. For example, if you start at version 1.0, and need to go to version 2.0, a correct order would be 1.0-1.5, 1.5-1.6, 1.6-2.0. @@ -1521,7 +1532,7 @@ # Strip off any path information. set f1 [lindex [split $f1 /] end] set f2 [lindex [split $f2 /] end] - + # Get the version number from, e.g. the 2.0 from upgrade-2.0-3.0.sql if {[regexp {\-(.*)-.*.sql} $f1 match f1_version_from] && [regexp {\-(.*)-.*.sql} $f2 match f2_version_from]} { @@ -1720,17 +1731,17 @@ @param version_name_2 the second version name @return - +

    - + @author Lars Pind } { db_1row select_sortable_versions {} @@ -1762,9 +1773,9 @@ fall within the from_version_name and to_version_name it'll get executed in the caller's namespace, ordered by the from_version.

    - + Example: - +

     
         ad_proc my_upgrade_callback {
    @@ -1792,9 +1803,9 @@
                 }
             }
         }
    -    
    +
         
    - + @param from_version_name The version you're upgrading from, e.g. '1.3'. @param to_version_name The version you're upgrading to, e.g. '2.4'. @param spec The code chunks in the format described above @@ -1804,7 +1815,7 @@ if { [expr [llength $spec] % 3] != 0 } { error "The length of spec should be dividable by 3" } - + array set chunks [list] foreach { elm_from elm_to elm_chunk } $spec { @@ -1839,7 +1850,7 @@ @param repository_url The URL for the repository channel to get from, or the empty string to seach the local file system instead. - + @param array Name of an array where you want the repository stored. It will be keyed by package-key, and each entry will be an array list list what's returned by apm_read_package_info_file. @@ -1854,7 +1865,7 @@ if { ![empty_string_p $repository_url] } { set manifest_url "${repository_url}manifest.xml" - + # See if we already have it in a client property set manifest [ad_get_client_property acs-admin [string range $manifest_url end-49 end]] @@ -2156,7 +2167,7 @@ } { array set attributes [apm::package_version::attributes::get_spec] array set attribute $attributes($attribute_name) - + return $attribute(pretty_name) } @@ -2296,7 +2307,7 @@ @param The name of an array in the callers environment in which the attribute values will be set (with attribute names as keys and attribute values as values). - + @author Peter Marklund } { upvar $array attributes