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.34 -r1.35 --- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 15 Feb 2003 23:55:59 -0000 1.34 +++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 25 Feb 2003 16:42:12 -0000 1.35 @@ -355,7 +355,6 @@ ad_proc -private apm_load_catalog_files { -upgrade:boolean package_key - message_catalog_files } { Load catalog files for a package that is either installed or upgraded. If the package is upgraded message key upgrade status is reset before @@ -367,7 +366,7 @@ @author Peter Marklund } { # If acs-lang hasn't been installed yet we simply return - if { [llength [info proc lang::catalog::import_messages_from_file]] == 0 || ![apm_package_installed_p acs-lang] } { + if { [llength [info proc lang::catalog::import_from_files]] == 0 || ![apm_package_installed_p acs-lang] } { return } @@ -377,9 +376,7 @@ } # Load message catalog files - foreach catalog_rel_path $message_catalog_files { - lang::catalog::import_messages_from_file "[acs_package_root_dir $package_key]/${catalog_rel_path}" - } + lang::catalog::import_from_files $package_key # Cache the messages lang::message::cache -package_key $package_key @@ -392,11 +389,10 @@ {-copy_files:boolean} {-load_data_model:boolean} {-data_model_files 0} - {-message_catalog_files {}} {-install_path ""} + {-mount_path ""} spec_file_path } { - Registers a new package and/or version in the database, returning the version_id. If $callback is provided, periodically invokes this procedure with a single argument containing a human-readable (English) status message. @@ -408,6 +404,10 @@ array set version [apm_read_package_info_file $spec_file_path] set package_key $version(package.key) + # Determine if we are upgrading or installing. + set upgrade_from_version_name [apm_package_upgrade_from $package_key $version(name)] + set upgrade_p [expr ![empty_string_p $upgrade_from_version_name]] + if { $copy_files_p } { if { [empty_string_p $install_path] } { set install_path [apm_workspace_install_dir]/$package_key @@ -416,13 +416,6 @@ exec "cp" "-r" -- "$install_path/$package_key" [acs_root_dir]/packages/ } - # Install Queries (OpenACS Query Dispatcher - ben) - apm_package_install_queries $package_key $version(files) - - if { $load_data_model_p } { - apm_package_install_data_model -callback $callback -data_model_files $data_model_files $spec_file_path - } - with_catch errmsg { set package_uri $version(package.url) set package_type $version(package.type) @@ -444,29 +437,24 @@ # Register the package if it is not already registered. if { ![apm_package_registered_p $package_key] } { - apm_package_register -spec_file_path $relative_path \ - $package_key \ - $package_name \ - $pretty_plural \ - $package_uri \ - $package_type \ - $initial_install_p \ - $singleton_p + apm_package_register \ + -spec_file_path $relative_path \ + $package_key \ + $package_name \ + $pretty_plural \ + $package_uri \ + $package_type \ + $initial_install_p \ + $singleton_p } # If an older version already exists in apm_package_versions, update it; # otherwise, insert a new version. - if { [db_0or1row version_exists_p { - select version_id - from apm_package_versions - where package_key = :package_key - and version_id = apm_package.highest_version(:package_key) - } ]} { + if { $upgrade_p } { # We are upgrading a package - set upgrade_p 1 # Load catalog files with upgrade switch before package version is changed in db - apm_load_catalog_files -upgrade $package_key $message_catalog_files + apm_load_catalog_files -upgrade $package_key set version_id [apm_package_install_version -callback $callback $package_key $version_name \ $version_uri $summary $description $description_format $vendor $vendor_uri $auto_mount $release_date] @@ -475,39 +463,56 @@ } else { # We are installing a new package - set upgrade_p 0 # Load catalog files without the upgrade switch before package version is changed in db - apm_load_catalog_files $package_key $message_catalog_files + apm_load_catalog_files $package_key - set version_id [apm_package_install_version -callback $callback $package_key $version_name \ + set version_id [apm_package_install_version \ + -callback $callback \ + $package_key $version_name \ $version_uri $summary $description $description_format $vendor $vendor_uri $auto_mount $release_date] - ns_log Notice "INSTALL-HACK-LOG-BEN: version_id is $version_id" - if { !$version_id } { # There was an error. + ns_log Error "Package $package_key could not be installed. Received version_id $version_id" apm_callback_and_log $callback "The package version could not be created." } - # Install the paramters for the version. + # Install the parameters for the version. apm_package_install_parameters -callback $callback $version(parameters) $package_key } # Update all other package information. apm_package_install_dependencies -callback $callback $version(provides) $version(requires) $version_id apm_package_install_owners -callback $callback $version(owners) $version_id - apm_package_install_files -callback $callback $version(files) $version_id apm_package_install_callbacks -callback $callback $version(callbacks) $version_id apm_callback_and_log $callback "
Installed $version(package-name), version $version(name).
" } { - apm_callback_and_log $callback "
Failed to install $version(package-name), version $version(name). The following error was generated: + apm_callback_and_log -severity Error $callback "
Failed to install $version(package-name), version $version(name). The following error was generated:
" return 0 } + # Source Tcl procs and queries to be able + # to invoke any Tcl callbacks after mounting and instantiation. Note that this reloading + # is only done in the Tcl interpreter of this particular request. + apm_load_libraries -procs -force_reload -packages $package_key + apm_load_queries -packages $package_key + + if { $upgrade_p } { + # Run before-upgrade + apm_invoke_callback_proc -version_id $version_id -type before-upgrade -arg_list [list from_version_name $upgrade_from_version_name to_version_name $version(name)] + } else { + # Run before-install + apm_invoke_callback_proc -version_id $version_id -type before-install + } + + if { $load_data_model_p } { + apm_package_install_data_model -callback $callback -data_model_files $data_model_files $spec_file_path + } + # Enable the package if { $enable_p } { nsv_set apm_enabled_package $package_key 1 @@ -517,38 +522,57 @@ # Instantiating, mounting, and after-install callback only invoked on initial install if { ! $upgrade_p } { - # Source Tcl procs and queries to be able - # to invoke any Tcl callbacks after mounting and instantiation. Note that this reloading - # is only done in the Tcl interpreter of this particular request. - apm_load_libraries -procs -force_reload -packages $package_key - apm_load_queries -packages $package_key + # After install Tcl proc callback + apm_invoke_callback_proc -version_id $version_id -type after-install - if { ![empty_string_p $version(auto-mount)] } { + set priority_mount_path [ad_decode $version(auto-mount) "" $mount_path $version(auto-mount)] + if { ![empty_string_p $priority_mount_path] } { # This is a package that should be auto mounted set parent_id [site_node::get_node_id -url "/"] if { [catch { db_transaction { - set node_id [site_node::new -name $version(auto-mount) -parent_id $parent_id] + set node_id [site_node::new -name $priority_mount_path -parent_id $parent_id] } } error] } { - ns_log Error "Package $version(package-name) could not be mounted at /$version(auto-mount) , there may already me a package mounted there, the error is: $error" - } else { - site_node::instantiate_and_mount -node_id $node_id \ - -node_name $version(auto-mount) \ + # There is already a node with that path, check if there is a package mounted there + array set node [site_node::get -url "/${priority_mount_path}"] + if { [empty_string_p $node(object_id)] } { + # There is no package mounted there so go ahead and mount the new package + set node_id $node(node_id) + } else { + # Don't unmount already mounted packages + set node_id "" + } + } + + if { ![empty_string_p $node_id] } { + + site_node::instantiate_and_mount \ + -node_id $node_id \ + -node_name $priority_mount_path \ -package_name $version(package-name) \ -package_key $package_key - } + + apm_callback_and_log $callback "[ad_quotehtml $errmsg]
Mounted an instance of the package at /${priority_mount_path}
" + } { + # Another package is mounted at the path so we cannot mount + global errorInfo + set error_text "Package $version(package-name) could not be mounted at /$version(auto-mount) , there may already me a package mounted there, the error is: $error" + ns_log Error "$error_text \n\n$errorInfo" + apm_callback_and_log $callback "$error_text
" + } + } elseif { [string equal $package_type "apm_service"] && [string equal $singleton_p "t"] } { # This is a singleton package. Instantiate it automatically, but don't mount. # Using empty context_id apm_package_instance_new $version(package-name) "" $package_key } - - # After install Tcl proc callback - apm_invoke_callback_proc -version_id $version_id -type after-install + } else { + # After upgrade Tcl proc callback + apm_invoke_callback_proc -version_id $version_id -type after-upgrade -arg_list [list from_version_name $upgrade_from_version_name to_version_name $version(name)] } # Flush the installed_p cache @@ -562,7 +586,8 @@ {-version_id ""} package_key version_name version_uri summary description description_format vendor vendor_uri auto_mount {release_date ""} } { - Installs a version of a package into the ACS. + Installs a version of a package. + @return The assigned version id. } { if { [empty_string_p $version_id] } { @@ -700,7 +725,7 @@ set data_model_files [apm_data_model_scripts_find \ -upgrade_from_version_name $upgrade_from_version_name \ -upgrade_to_version_name $upgrade_to_version_name \ - $package_key $version(files)] + $package_key] } if { ![empty_string_p $data_model_files] } { @@ -909,42 +934,6 @@ } } -ad_proc -private apm_package_install_queries { - {-callback apm_dummy_callback} - package_key - files -} { - Given a spec file, reads in the data model files to load from it. - - @param package_key The package key from the .info file. - @param files List of files for this package from the package's .info file - @author Don Baccus (dhogaza@pacifier.com) - - This replaces the brute-force version originally provided by - Ben, which manually searched the package directories rather than - use the package information file. - -} { - set path "[acs_package_root_dir $package_key]" - - - ns_log Notice "APM/QD = loading up package query files for $package_key" - set ul_p 0 - - foreach query_file [apm_query_files_find $package_key $files] { - ns_log Debug "APM/QD: Now processing query file $query_file" - if { !$ul_p } { - apm_callback_and_log $callback "+ + Example: + +
+ + @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 + + @author Lars Pind +} { + 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 { + + # Check that + # from_version_name < elm_from < elm_to < to_version_name + + if { [apm_version_names_compare $from_version_name $elm_from] <= 0 && \ + [apm_version_names_compare $elm_from $elm_to] <= 0 && \ + [apm_version_names_compare $elm_to $to_version_name] <= 0 } { + set chunks($elm_from,$elm_to) $elm_chunk + } + } + + foreach key [lsort -increasing -command apm_upgrade_logic_compare [array names chunks]] { + uplevel $chunks($key) + } +} + + ############## # # Deprecated Procedures+ + apm_upgrade_logic \ + -from_version_name $from \ + -to_version_name $to \ + -spec { + 1.1 1.2 { + ... + } + 1.2 1.3 { + ... + } + 1.4d 1.4d1 { + ... + } + 2.1 2.3 { + ... + } + 2.3 2.4 { + ... + } + } + +