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.108.2.17 -r1.108.2.18 --- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 12 Aug 2014 19:25:51 -0000 1.108.2.17 +++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 12 Aug 2014 19:30:57 -0000 1.108.2.18 @@ -24,7 +24,7 @@ } { if { $path eq "" } { - set path "[apm_workspace_install_dir]" + set path [apm_workspace_install_dir] } ### Scan for all unregistered .info files. @@ -34,50 +34,50 @@ # Loop through all directories in the /packages directory, searching each for a # .info file. foreach dir [lsort [glob -nocomplain "$path/*"]] { - set package_key [file tail $dir] - if { ![file isdirectory $dir] } { - continue - } - if { [apm_ignore_file_p $dir] } { - apm_callback_and_log $callback "Skipping the directory \"$package_key\"." - continue - } + set package_key [file tail $dir] + if { ![file isdirectory $dir] } { + continue + } + if { [apm_ignore_file_p $dir] } { + apm_callback_and_log $callback "Skipping the directory \"$package_key\"." + continue + } - # At this point, we should have a directory that is equivalent to a package_key. - if { [apm_package_installed_p $package_key] } { - if {$new_p} { - continue - } - } - - # Locate the .info file for this package. - if { [catch { set info_file [apm_package_info_file_path -path $path $package_key] } error] } { - apm_callback_and_log -severity Warning $callback "Unable to locate specification file for package $package_key: $error" - continue - } - # We found the .info file. - lappend new_spec_files $info_file - } + # At this point, we should have a directory that is equivalent to a package_key. + if { [apm_package_installed_p $package_key] } { + if {$new_p} { + continue + } + } + # Locate the .info file for this package. + if { [catch { set info_file [apm_package_info_file_path -path $path $package_key] } error] } { + apm_callback_and_log -severity Warning $callback "Unable to locate specification file for package $package_key: $error" + continue + } + # We found the .info file. + lappend new_spec_files $info_file + } + if { [llength $new_spec_files] == 0 } { - ns_log Notice "apm_scan_packages: No new packages found." + ns_log Notice "apm_scan_packages: No new packages found." } return $new_spec_files } - + ad_proc -public apm_dependency_provided_p { { - -dependency_list [list] + -dependency_list [list] } dependency_uri dependency_version } { Returns 1 if the current system provides the dependency inquired about. Returns -1 if the version number is too low. Returns 0 otherwise. @param dependency_list Specify this if you want to a check a list of dependencies of form - {dependency_name dependency_version} in addition to querying the database for what the - system currently provides. + {dependency_name dependency_version} in addition to querying the database for what the + system currently provides. @param dependency_uri The dependency that is being checked. @param dependency_version The version of the dependency being checked. } { @@ -86,41 +86,41 @@ 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 } { - ns_log Debug "apm_dependency_provided_p: Dependency satisfied by previously installed package" - set found_p 1 - } elseif { $version_p == -1 } { - set old_version_p 1 - } + if { $version_p >= 0 } { + ns_log Debug "apm_dependency_provided_p: Dependency satisfied by previously installed package" + set found_p 1 + } elseif { $version_p == -1 } { + set old_version_p 1 + } } # Can't return while inside a db_foreach. if {$found_p} { - return 1 + return 1 } if { $dependency_list ne "" } { - # They provided a list of provisions. - foreach prov $dependency_list { - if {$dependency_uri eq [lindex $prov 0]} { + # They provided a list of provisions. + foreach prov $dependency_list { + 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 } { - ns_log Debug "apm_dependency_provided_p: Dependency satisfied in list of provisions." + ns_log Debug "apm_dependency_provided_p: Dependency satisfied in list of provisions." return 1 } else { set old_version_p 1 } - } - } + } + } } - + if { $old_version_p} { - return -1 + return -1 } else { - return 0 + return 0 } } @@ -161,8 +161,8 @@ @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. + Assumes that the info file is stored in the root + dir of the package. } { return [file dirname [pkg_info_spec $pkg_info]] @@ -237,41 +237,41 @@ @param initial_install Only process spec files with the initial install attribute. @param pkg_info_all If you supply this argument, when a - requirement goes unsatisfied, instead of failing, this proc will - try to add whatever other packages are needed to the install set. The list of package keys to - add will be the third element in the list returned. + requirement goes unsatisfied, instead of failing, this proc will + try to add whatever other packages are needed to the install set. The list of package keys to + add will be the third element in the list returned. @return A list whose first element indicates whether dependencies were satisfied (1 if so, 0 otherwise).\ - The second element is the package info list with the packages ordered according to dependencies.\ - Packages that can be installed come first. Any packages that failed the dependency check come last. - The third element is a list of package keys on additional packages to install, in order to satisfy dependencies. + The second element is the package info list with the packages ordered according to dependencies.\ + Packages that can be installed come first. Any packages that failed the dependency check come last. + The third element is a list of package keys on additional packages to install, in order to satisfy dependencies. } { #### Iterate over the list of info files. ## Every time we satisfy another package, remove it from install_pend, and loop again. ## If we don't satisfy at least one more package, halt. ## install_in - Package info structures for packages that can be installed in a satisfactory order. ## install_pend - Stores package info structures fro packages that might have their dependencies satisfied - ## by packages in the install set. + ## by packages in the install set. ## extra_package_keys - package keys of extra packages to install to satisfy all requirements. set extra_package_keys [list] set updated_p 1 set install_in [list] foreach spec_file $spec_files { - if { [catch { - array set package [apm_read_package_info_file $spec_file] - if { ($package(initial-install-p) eq "t" || !$initial_install_p) - && [apm_package_supports_rdbms_p -package_key $package(package.key)] - } { + if { [catch { + array set package [apm_read_package_info_file $spec_file] + if { ($package(initial-install-p) eq "t" || !$initial_install_p) + && [apm_package_supports_rdbms_p -package_key $package(package.key)] + } { lappend install_pend [pkg_info_new \ - $package(package.key) \ - $spec_file \ - $package(embeds) \ - $package(extends) \ - $package(provides) \ - $package(requires) \ - ""] + $package(package.key) \ + $spec_file \ + $package(embeds) \ + $package(extends) \ + $package(provides) \ + $package(requires) \ + ""] } # Remove this package from the pkg_info_all list ... @@ -284,11 +284,11 @@ } incr counter } - } errmsg]} { - # Failed to parse the specificaton file. - apm_callback_and_log $callback "$spec_file could not be parsed correctly. It is not being installed. - The error: $errmsg" - } + } errmsg]} { + # Failed to parse the specificaton file. + apm_callback_and_log $callback "$spec_file could not be parsed correctly. It is not being installed. + The error: $errmsg" + } } # Outer loop tries to find a package from the pkg_info_all list to add if @@ -306,19 +306,19 @@ foreach prov [pkg_info_provides $pkg_info] { lappend install_in_provides $prov } - } + } # Now determine if we can add another package to the install set. foreach pkg_info $install_pend { set satisfied_p 1 foreach req [concat [pkg_info_embeds $pkg_info] [pkg_info_extends $pkg_info] [pkg_info_requires $pkg_info]] { if {[apm_dependency_provided_p -dependency_list $install_in_provides \ - [lindex $req 0] [lindex $req 1]] != 1} { + [lindex $req 0] [lindex $req 1]] != 1} { # Unsatisfied dependency. set satisfied_p 0 # Check to see if we've recorded it already set errmsg "Requires [lindex $req 0] of version >= [lindex $req 1]." if { ![info exists install_error([pkg_info_key $pkg_info])] || - $errmsg ni $install_error([pkg_info_key $pkg_info])} { + $errmsg ni $install_error([pkg_info_key $pkg_info])} { lappend install_error([pkg_info_key $pkg_info]) $errmsg } lappend new_install_pend $pkg_info @@ -328,14 +328,14 @@ if { $satisfied_p } { # At least one more package was added to the list that can be installed, so repeat. lappend install_in [pkg_info_new \ - [pkg_info_key $pkg_info] \ - [pkg_info_spec $pkg_info] \ - [pkg_info_embeds $pkg_info] \ - [pkg_info_extends $pkg_info] \ - [pkg_info_provides $pkg_info] \ - [pkg_info_requires $pkg_info] \ - "t" \ - "Package satisfies dependencies."] + [pkg_info_key $pkg_info] \ + [pkg_info_spec $pkg_info] \ + [pkg_info_embeds $pkg_info] \ + [pkg_info_extends $pkg_info] \ + [pkg_info_provides $pkg_info] \ + [pkg_info_requires $pkg_info] \ + "t" \ + "Package satisfies dependencies."] set updated_p 1 } } @@ -358,9 +358,9 @@ foreach pkg_info_add $pkg_info_all { # Will this package do anything to change whether this requirement has been satisfied? if { [pkg_info_key $pkg_info_add] eq [lindex $req 0] - && [apm_dependency_provided_p -dependency_list [pkg_info_provides $pkg_info_add] \ - [lindex $req 0] [lindex $req 1]] == 1 - } { + && [apm_dependency_provided_p -dependency_list [pkg_info_provides $pkg_info_add] \ + [lindex $req 0] [lindex $req 1]] == 1 + } { # It sure does. Add it to list of packages to install lappend install_pend $pkg_info_add @@ -389,17 +389,17 @@ } } } - + set install_order(order) $install_in # Update all of the packages that cannot be installed. if { [info exists install_pend] && $install_pend ne "" } { - foreach pkg_info $install_pend { - lappend install_in [pkg_info_new [pkg_info_key $pkg_info] [pkg_info_spec $pkg_info] \ - [pkg_info_embeds $pkg_info] [pkg_info_extends $pkg_info] \ + foreach pkg_info $install_pend { + lappend install_in [pkg_info_new [pkg_info_key $pkg_info] [pkg_info_spec $pkg_info] \ + [pkg_info_embeds $pkg_info] [pkg_info_extends $pkg_info] \ [pkg_info_provides $pkg_info] [pkg_info_requires $pkg_info] \ - "f" $install_error([pkg_info_key $pkg_info])] - } - return [list 0 $install_in] + "f" $install_error([pkg_info_key $pkg_info])] + } + return [list 0 $install_in] } return [list 1 $install_in $extra_package_keys] @@ -417,25 +417,25 @@ @param package_keys The list of package_keys of the packages requested to be installed. @param repository_array Name of an array in the caller's namespace containing the repository of - available packages as returned by apm_get_package_repository. + available packages as returned by apm_get_package_repository. @return An array list with the following elements: @@ -529,7 +529,7 @@ # Record what this package provides, and remove it from the required list, if appropriate foreach prov $version(provides) { - lassign $prov prov_uri prov_version + 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)] || \ @@ -539,8 +539,8 @@ # If what we provide is required, and the required version is less than what we provide, # drop the requirement if { [info exists required($prov_uri)] - && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 - } { + && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 + } { array unset required($prov_uri) } } @@ -576,11 +576,11 @@ # Let's see if this package provides anything we need foreach prov $version(provides) { - lassign $prov prov_uri prov_version + lassign $prov prov_uri prov_version if { [info exists required($prov_uri)] - && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 - } { + && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 + } { ns_log Debug "apm_dependency_check_new: Adding $package_key, as it provides $prov_uri $prov_version" # If this package provides something that's required in a version high enough @@ -622,7 +622,7 @@ # Find unsatisfied requirements foreach req [concat $version(embeds) $version(extends) $version(requires)] { - lassign $req req_uri req_version + lassign $req req_uri req_version if { ![info exists provided($req_uri)] || [apm_version_names_compare $provided($req_uri) $req_version] == -1 } { lappend failed($package_key) [list $req_uri $req_version] if { [info exists provided($req_uri)] } { @@ -636,7 +636,7 @@ set result(failed) [array get failed] } - + return [array get result] } @@ -684,7 +684,7 @@ if { [apm_package_supports_rdbms_p -package_key $package(package.key)] && ![apm_package_installed_p $package(package.key)] - } { + } { lappend install_spec_files $install_spec_file } } @@ -701,23 +701,23 @@ if { [apm_package_supports_rdbms_p -package_key $package(package.key)] && ![apm_package_installed_p $package(package.key)] - } { + } { # Save the package info, we may need it for dependency # satisfaction later lappend pkg_info_list [pkg_info_new $package(package.key) \ - $spec_file \ - $package(embeds) \ - $package(extends) \ - $package(provides) \ - $package(requires) \ - ""] + $spec_file \ + $package(embeds) \ + $package(extends) \ + $package(provides) \ + $package(requires) \ + ""] } } if { [llength $install_spec_files] > 0 } { set dependency_results [apm_dependency_check \ - -pkg_info_all $pkg_info_list \ - $install_spec_files] + -pkg_info_all $pkg_info_list \ + $install_spec_files] if { [lindex $dependency_results 0] == 1 } { apm_packages_full_install -callback apm_ns_write_callback [lindex $dependency_results 1] @@ -769,37 +769,37 @@ # 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 set spec_file_path [apm_package_info_file_path -path [file dirname $package_path] $package_key] } with_catch errmsg { - set package_uri $version(package.url) - set package_type $version(package.type) - set package_name $version(package-name) - set pretty_plural $version(pretty-plural) - set initial_install_p $version(initial-install-p) - set singleton_p $version(singleton-p) - set implements_subsite_p $version(implements-subsite-p) - set inherit_templates_p $version(inherit-templates-p) + set package_uri $version(package.url) + set package_type $version(package.type) + set package_name $version(package-name) + set pretty_plural $version(pretty-plural) + set initial_install_p $version(initial-install-p) + set singleton_p $version(singleton-p) + 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) - set description $version(description) - set release_date $version(release-date) - set vendor $version(vendor) - set vendor_uri $version(vendor.url) - set split_path [split $spec_file_path /] - set relative_path [join [lreplace $split_path 0 [lsearch -exact $package_key $split_path]] /] + set version_name $version(name) + set version_uri $version(url) + set summary $version(summary) + set description_format $version(description.format) + set description $version(description) + set release_date $version(release-date) + set vendor $version(vendor) + set vendor_uri $version(vendor.url) + set split_path [split $spec_file_path /] + set relative_path [join [lreplace $split_path 0 [lsearch -exact $package_key $split_path]] /] - # Register the package if it is not already registered. - if { ![apm_package_registered_p $package_key] } { - apm_package_register \ + # 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 \ @@ -810,7 +810,7 @@ $singleton_p \ $implements_subsite_p \ $inherit_templates_p - } + } # Source Tcl procs and queries to be able # to invoke any Tcl callbacks after mounting and instantiation. Note that this reloading @@ -851,77 +851,77 @@ apm_package_install_data_model -callback $callback -data_model_files $data_model_files $spec_file_path } - # If an older version already exists in apm_package_versions, update it; - # otherwise, insert a new version. - if { $upgrade_p } { + # If an older version already exists in apm_package_versions, update it; + # otherwise, insert a new version. + if { $upgrade_p } { # We are upgrading a package # Load catalog files with upgrade switch before package version is changed in db apm_load_catalog_files -upgrade $package_key - set version_id [apm_package_install_version \ + set version_id [apm_package_install_version \ -callback $callback \ -array version \ $package_key $version_name \ - $version_uri $summary $description $description_format $vendor $vendor_uri $auto_mount $release_date] - apm_version_upgrade $version_id - apm_package_install_dependencies -callback $callback \ + $version_uri $summary $description $description_format $vendor $vendor_uri $auto_mount $release_date] + apm_version_upgrade $version_id + apm_package_install_dependencies -callback $callback \ $version(embeds) $version(extends) $version(provides) $version(requires) $version_id apm_build_one_package_relationships $package_key - apm_package_upgrade_parameters -callback $callback $version(parameters) $package_key + apm_package_upgrade_parameters -callback $callback $version(parameters) $package_key - } else { + } else { # We are installing a new package - set version_id [apm_package_install_version \ + set version_id [apm_package_install_version \ -callback $callback \ -array version \ $package_key $version_name \ - $version_uri $summary $description $description_format $vendor $vendor_uri $auto_mount $release_date] + $version_uri $summary $description $description_format $vendor $vendor_uri $auto_mount $release_date] - if { !$version_id } { - # There was an error. + if { !$version_id } { + # There was an error. ns_log Error "apm_package_install: Package $package_key could not be installed. Received version_id $version_id" - apm_callback_and_log $callback "The package version could not be created." - } + apm_callback_and_log $callback "The package version could not be created." + } - apm_load_catalog_files $package_key - apm_package_install_dependencies -callback $callback \ + apm_load_catalog_files $package_key + apm_package_install_dependencies -callback $callback \ $version(embeds) $version(extends) $version(provides) $version(requires) $version_id apm_build_one_package_relationships $package_key apm_copy_inherited_params $package_key [concat $version(embeds) $version(extends)] - - # Install the parameters for the version. - apm_package_install_parameters -callback $callback $version(parameters) $package_key - } + + # Install the parameters for the version. + apm_package_install_parameters -callback $callback $version(parameters) $package_key + } - # Update all other package information. - apm_package_install_owners -callback $callback $version(owners) $version_id + # Update all other package information. + 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 "

Installed $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" - 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]
-
+ 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]
+
-

-NOTE: If the error comes from a sql script you may try to source it manually. When you are done with that you should revisit the APM and try again but remember to leave the manually souced sql scipts unchecked on the previous page. -

-}] - return 0 +

+ NOTE: If the error comes from a sql script you may try to source it manually. When you are done with that you should revisit the APM and try again but remember to leave the manually souced sql scipts unchecked on the previous page. +

+ }] + return 0 } # Enable the package if { $enable_p } { nsv_set apm_enabled_package $package_key 1 - apm_version_enable -callback $callback $version_id + apm_version_enable -callback $callback $version_id } # Instantiating, mounting, and after-install callback only invoked on initial install @@ -943,24 +943,24 @@ # 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 { $node(object_id) eq "" } { - # There is no package mounted there so go ahead and mount the new package - set node_id $node(node_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 "" + # Don't unmount already mounted packages + set node_id "" } - } + } - if { $node_id ne "" } { + if { $node_id ne "" } { site_node::instantiate_and_mount \ - -node_id $node_id \ - -node_name $priority_mount_path \ - -package_name $version(package-name) \ - -package_key $package_key + -node_id $node_id \ + -node_name $priority_mount_path \ + -package_name $version(package-name) \ + -package_key $package_key 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" @@ -973,7 +973,7 @@ # Using empty context_id apm_package_instance_new -instance_name $version(package-name) \ - -package_key $package_key + -package_key $package_key } } else { # After upgrade Tcl proc callback @@ -989,7 +989,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. } { @@ -1043,10 +1043,10 @@ upvar $array local_array if { $version_id eq "" } { - set version_id [db_null] + set version_id [db_null] } if { $release_date eq "" } { - set release_date [db_null] + set release_date [db_null] } set version_id [db_exec_plsql version_insert {}] @@ -1073,8 +1073,8 @@ } { if {![apm_package_registered_p $package_key]} { - apm_callback_and_log $callback "This package is not installed. Done." - return 0 + apm_callback_and_log $callback "This package is not installed. Done." + return 0 } # Obtain the portion of the email address before the at sign. We'll use this in the name of @@ -1087,15 +1087,15 @@
  • Moving packages/$package_key to $backup_dir... " if { [catch { file rename "$::acs::rootdir/packages/$package_key" $backup_dir } error] } { - apm_callback_and_log $callback "[ns_quotehtml $error]" + apm_callback_and_log $callback "[ns_quotehtml $error]" } else { - apm_callback_and_log $callback "moved." + apm_callback_and_log $callback "moved." } db_dml apm_uninstall_record { - update apm_package_versions - set installed_p = 'f', enabled_p = 'f' - where package_key = :package_key + update apm_package_versions + set installed_p = 'f', enabled_p = 'f' + where package_key = :package_key } apm_callback_and_log $callback "
  • Package marked as deinstalled. @@ -1106,7 +1106,7 @@ ad_proc -private apm_package_delete { {-sql_drop_scripts ""} { - -callback apm_dummy_callback + -callback apm_dummy_callback } {-remove_files:boolean} package_key @@ -1154,12 +1154,12 @@ # 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; + begin + apm_package_type.drop_type( + package_key => :package_key, + cascade_p => 't' + ); + end; } } @@ -1170,19 +1170,19 @@