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.109 -r1.110 --- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 27 Oct 2014 16:40:05 -0000 1.109 +++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 7 Aug 2017 23:47:59 -0000 1.110 @@ -85,11 +85,12 @@ set old_version_p 0 set found_p 0 ns_log Debug "apm_dependency_provided_p: Scanning for $dependency_uri version $dependency_version" - db_foreach apm_dependency_check {} { - if { $version_p >= 0 } { + foreach service_version [db_list get_service_versions {}] { + set version_p [expr {[apm_version_names_compare $service_version $dependency_version] >= 0}] + if { $version_p } { ns_log Debug "apm_dependency_provided_p: Dependency satisfied by previously installed package" set found_p 1 - } elseif { $version_p == -1 } { + } else { set old_version_p 1 } } @@ -105,9 +106,8 @@ if {$dependency_uri eq [lindex $prov 0]} { set provided_version [lindex $prov 1] - set provided_p [db_string version_greater_p {}] - - if { $provided_p >= 0 } { + set provided_p [expr {[apm_version_names_compare $provided_version $dependency_version] >= 0}] + if { $provided_p } { ns_log Debug "apm_dependency_provided_p: Dependency satisfied in list of provisions." return 1 } else { @@ -124,7 +124,10 @@ } } -ad_proc -private pkg_info_new { package_key spec_file_path embeds extends provides requires {dependency_p ""} {comment ""}} { +ad_proc -private pkg_info_new { + package_key spec_file_path embeds extends provides requires + {dependency_p ""} {comment ""} +} { Returns a datastructure that maintains information about a package. @param package_key The key of the package. @@ -534,8 +537,9 @@ lassign $prov prov_uri prov_version # If what we provide is not already provided, or the alredady provided version is # less than what we provide, record this new provision - if { ![info exists provided($prov_uri)] || \ - [apm_version_names_compare $provided($prov_uri) $prov_version] == -1 } { + if { ![info exists provided($prov_uri)] + || [apm_version_names_compare $provided($prov_uri) $prov_version] == -1 + } { set provided($prov_uri) $prov_version } # If what we provide is required, and the required version is less than what we provide, @@ -751,6 +755,7 @@ {-enable:boolean} {-callback apm_dummy_callback} {-load_data_model:boolean} + {-install_from_repository:boolean} {-data_model_files 0} {-package_path ""} {-mount_path ""} @@ -765,14 +770,31 @@ } { set version_id 0 array set version [apm_read_package_info_file $spec_file_path] - set package_key $version(package.key) + set package_key $version(package.key) + set version_name $version(name) - apm_callback_and_log $callback "

Installing $version(package-name) $version(name)

" - # Determine if we are upgrading or installing. set upgrade_from_version_name [apm_package_upgrade_from $package_key $version(name)] + + if {$upgrade_from_version_name ne "" && $upgrade_from_version_name eq $version_name} { + # + # nothing to do. + # + ns_log notice "apm_package_install package $package_key already installed in version $version_name" + return [apm_version_id_from_package_key $package_key] + } + set upgrade_p [expr {$upgrade_from_version_name ne ""}] + if {$upgrade_p} { + set operations {Upgrading Upgraded} + } else { + set operations {Installing Installed} + } + + + apm_callback_and_log $callback "

[lindex $operations 0] $version(package-name) $version(name)

" + if { [string match "[apm_workspace_install_dir]*" $package_path] } { # Package is being installed from the apm_workspace dir (expanded from .apm file) @@ -783,8 +805,7 @@ } # Move the package into the packages dir - #exec "mv" "$package_path" "$::acs::rootdir/packages" - file rename $package_path $::acs::rootdir/packages + file rename -- $package_path $::acs::rootdir/packages # We moved the spec file, so update its path set package_path $old_package_path @@ -801,7 +822,6 @@ set implements_subsite_p $version(implements-subsite-p) set inherit_templates_p $version(inherit-templates-p) set auto_mount $version(auto-mount) - set version_name $version(name) set version_uri $version(url) set summary $version(summary) set description_format $version(description.format) @@ -831,15 +851,15 @@ # to invoke any Tcl callbacks after mounting and instantiation. Note that this reloading # is only done in the Tcl interpreter of this particular request. # Note that acs-tcl is a special case as its procs are always sourced on startup from boostrap.tcl - if { $package_key ne "acs-tcl" } { + if { 1 || $package_key ne "acs-tcl" } { apm_load_libraries -procs -force_reload -packages $package_key apm_load_queries -packages $package_key } # Get the callbacks in an array, since we can't rely on the # before-upgrade being in the db (since it might have changed) # and the before-install definitely won't be there since - # it's not added til later here. + # it's not added until later here. array set callbacks $version(callbacks) @@ -914,15 +934,14 @@ apm_package_install_owners -callback $callback $version(owners) $version_id apm_package_install_callbacks -callback $callback $version(callbacks) $version_id apm_build_subsite_packages_list - - apm_callback_and_log $callback "

Installed $version(package-name), version $version(name).

" + + apm_callback_and_log $callback "

[lindex $operations 1] $version(package-name), version $version(name).

" } { - global errorInfo - ns_log Error "apm_package_install: Error installing $version(package-name) version $version(name): $errmsg\n$errorInfo" + ns_log Error "apm_package_install: Error installing $version(package-name) version $version(name): $errmsg\n$::errorInfo" apm_callback_and_log -severity Error $callback [subst {

Failed to install $version(package-name), version $version(name). The following error was generated:

- [ad_quotehtml $errmsg] + [ns_quotehtml $errmsg]

@@ -977,9 +996,8 @@ apm_callback_and_log $callback "

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 be a package mounted there, the error is: $error" - ns_log Error "apm_package_install: $error_text \n\n$errorInfo" + ns_log Error "apm_package_install: $error_text \n\n$::errorInfo" apm_callback_and_log $callback "

$error_text

" } @@ -990,9 +1008,20 @@ apm_package_instance_new -instance_name $version(package-name) \ -package_key $package_key } + + + if {[file exists $::acs::rootdir/packages/$package_key/install.xml]} { + # + # Run install.xml only for new installs + # + ns_log notice "===== RUN /packages/$package_key/install.xml" + apm::process_install_xml -install_from_repository=$install_from_repository_p /packages/$package_key/install.xml "" + } + } 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)] + 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 @@ -1004,7 +1033,7 @@ ad_proc apm_unregister_disinherited_params { package_key dependency_id } { Remove parameters for package_key that have been disinherited (i.e., the - dependency that caused them to be inherited have been removed). Called only + dependency that caused them to be inherited have been removed). Called only by the APM and keep it that way, please. } { @@ -1094,14 +1123,14 @@ # Obtain the portion of the email address before the at sign. We'll use this in the name of # the backup directory for the package. - regsub {@.+} [cc_email_from_party [ad_conn user_id]] "" my_email_name + regsub {@.+} [party::email -party_id [ad_conn 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"]" + 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... " - if { [catch { file rename "$::acs::rootdir/packages/$package_key" $backup_dir } error] } { + if { [catch { file rename -- "$::acs::rootdir/packages/$package_key" $backup_dir } error] } { apm_callback_and_log $callback "[ns_quotehtml $error]" } else { apm_callback_and_log $callback "moved." @@ -1120,19 +1149,18 @@ ad_proc -private apm_package_delete { {-sql_drop_scripts ""} - { - -callback apm_dummy_callback - } + {-callback apm_dummy_callback} {-remove_files:boolean} package_key } { - Deinstall a package from the system. Will unmount and uninstantiate + De-install a package from the system. Will unmount and uninstantiate package instances, invoke any before-uninstall callback, source any provided sql drop scripts, remove message keys, and delete the package from the APM tables. } { + # get the supposedly unique enabled version of this package set version_id [apm_version_id_from_package_key $package_key] # Unmount all instances of this package with the Tcl API that @@ -1168,14 +1196,7 @@ # 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; - } + db_exec_plsql apm_package_delete {} } # Source SQL drop scripts @@ -1194,7 +1215,7 @@ # Optionally remove the files from the filesystem if {$remove_files_p==1} { if { [catch { - file delete -force [acs_package_root_dir $package_key] + file delete -force -- [acs_package_root_dir $package_key] } error] } { apm_callback_and_log $callback "
  • Unable to delete [acs_package_root_dir $package_key]:$error" } @@ -1214,11 +1235,7 @@ } { Deletes a version from the database. } { - db_exec_plsql apm_version_delete { - begin - apm_package_version.del(version_id => :version_id); - end; - } + db_exec_plsql apm_version_delete {} } ad_proc -public apm_package_version_count {package_key} { @@ -1263,26 +1280,23 @@ foreach item $data_model_files { lassign $item file_path file_type + ns_log Debug "apm_package_install_data_model: Now processing $file_path of type $file_type" if {$file_type eq "data_model_create" || $file_type eq "data_model_upgrade" } { if { !$ul_p } { apm_callback_and_log $callback "