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.15.2.1 -r1.15.2.2 --- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 22 Jan 2003 18:26:51 -0000 1.15.2.1 +++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 5 Mar 2003 14:40:42 -0000 1.15.2.2 @@ -80,15 +80,7 @@ set old_version_p 0 set found_p 0 ns_log Debug "Scanning for $dependency_uri version $dependency_version" - db_foreach apm_dependency_check { - select apm_package_version.version_name_greater(service_version, :dependency_version) as version_p - from apm_package_dependencies d, apm_package_types a, apm_package_versions v - where d.dependency_type = 'provides' - and d.version_id = v.version_id - and d.service_uri = :dependency_uri - and v.installed_p = 't' - and a.package_key = v.package_key - } { + db_foreach apm_dependency_check {} { if { $version_p >= 0 } { ns_log Debug "Dependency satisfied by previously installed package" set found_p 1 @@ -105,19 +97,17 @@ if { ![empty_string_p $dependency_list] } { # They provided a list of provisions. foreach prov $dependency_list { - if {![string compare $dependency_uri [lindex $prov 0]] } { - if { $dependency_version <= [lindex $prov 1] } { + if { [string equal $dependency_uri [lindex $prov 0]] } { + + set provided_version [lindex $prov 1] + set provided_p [db_string version_greater_p {}] + + if { $provided_p >= 0 } { ns_log Debug "Dependency satisfied in list of provisions." - return 1 - } else { - if [catch { - if { $dependency_version > [lindex $prov 1] } { - set old_version_p 1 - } - } errmsg] { - ns_log Error "Error processing dependencies: $errmsg" - } - } + return 1 + } else { + set old_version_p 1 + } } } } @@ -204,77 +194,150 @@ ad_proc -private apm_dependency_check { {-callback apm_dummy_callback} {-initial_install:boolean} + {-pkg_info_all {}} spec_files } { Check dependencies of all the packages provided. @param spec_files A list of spec files to be processed. @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. @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. + 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 - Packages that can be installed in a satisfactory order. - ## install_pend - Stores packages that might have their dependencies satisfied + ## 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. + ## 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 { ([string equal $package(initial-install-p) "t"] || !$initial_install_p) && \ - [db_package_supports_rdbms_p $package(database_support)] } { - lappend install_pend [pkg_info_new $package(package.key) $spec_file $package(provides) $package(requires) ""] + [apm_package_supports_rdbms_p -package_key $package(package.key)] } { + lappend install_pend [pkg_info_new $package(package.key) $spec_file $package(provides) $package(requires) ""] } + + # Remove this package from the pkg_info_all list ... + # either we're already installing it, or it can't be installed + set counter 0 + foreach pkg_info $pkg_info_all { + if { [string equal [pkg_info_key $pkg_info] $package(package.key)] } { + set pkg_info_all [lreplace $pkg_info_all $counter $counter] + break + } + 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" } } - while { $updated_p && [exists_and_not_null install_pend]} { - set install_in_provides [list] - set new_install_pend [list] - set updated_p 0 - # Generate the list of dependencies currently provided by the install set. - foreach pkg_info $install_in { - 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 [pkg_info_requires $pkg_info] { - if {[apm_dependency_provided_p -dependency_list $install_in_provides \ - [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])] || \ - [lsearch -exact $install_error([pkg_info_key $pkg_info]) $errmsg] == -1} { - lappend install_error([pkg_info_key $pkg_info]) $errmsg - } - lappend new_install_pend $pkg_info - break - } - } - 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_provides $pkg_info] [pkg_info_requires $pkg_info] \ - "t" "Package satisfies dependencies."] - set updated_p 1 - } - } - set install_pend $new_install_pend - } + # Outer loop tries to find a package from the pkg_info_all list to add if + # we're stuck because of unsatisfied dependencies + set updated_p 1 + while { $updated_p } { + # Inner loop tries to add another package from the install_pend list + while { $updated_p && [exists_and_not_null install_pend]} { + set install_in_provides [list] + set new_install_pend [list] + set updated_p 0 + # Generate the list of dependencies currently provided by the install set. + foreach pkg_info $install_in { + 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 [pkg_info_requires $pkg_info] { + if {[apm_dependency_provided_p -dependency_list $install_in_provides \ + [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])] || \ + [lsearch -exact $install_error([pkg_info_key $pkg_info]) $errmsg] == -1} { + lappend install_error([pkg_info_key $pkg_info]) $errmsg + } + lappend new_install_pend $pkg_info + break + } + } + 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_provides $pkg_info] [pkg_info_requires $pkg_info] \ + "t" "Package satisfies dependencies."] + set updated_p 1 + } + } + set install_pend $new_install_pend + } + + set updated_p 0 + + if { [exists_and_not_null install_pend] && [llength $pkg_info_all] > 0 } { + # Okay, there are some packages that could not be installed + + # Let's find a package, which + # - have unsatisfied requirements + # - and we have a package in pkg_info_all which provides what this package requires + + foreach pkg_info $install_pend { + set satisfied_p 1 + foreach req [pkg_info_requires $pkg_info] { + set counter 0 + foreach pkg_info_add $pkg_info_all { + # Will this package do anything to change whether this requirement has been satisfied? + if { [apm_dependency_provided_p [lindex $req 0] [lindex $req 1]] == 0 && \ + [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 + + # Add it to list of extra package keys + lappend extra_package_keys [pkg_info_key $pkg_info_add] + + # Remove it from list of packages that we can possibly install + set pkg_info_all [lreplace $pkg_info_all $counter $counter] + + # Note that we've made changes + set updated_p 1 + + # Now break out of pkg_info_all loop + break + } + incr counter + } + if { $updated_p } { + break + } + } + if { $updated_p } { + break + } + } + } + } + set install_order(order) $install_in # Update all of the packages that cannot be installed. if { [exists_and_not_null install_pend] } { @@ -285,28 +348,35 @@ } return [list 0 $install_in] } - return [list 1 $install_in] + + return [list 1 $install_in $extra_package_keys] } - ad_proc -private apm_package_install { + {-enable:boolean} {-callback apm_dummy_callback} {-copy_files:boolean} {-load_data_model:boolean} {-data_model_files 0} {-install_path ""} - spec_file_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. + @param spec_file_path The path to an XML .info file relative to @return The version_id if successfully installed, 0 otherwise. } { set version_id 0 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 @@ -315,20 +385,14 @@ 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) 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 auto_mount $version(auto-mount) set version_name $version(name) set version_uri $version(url) set summary $version(summary) @@ -339,80 +403,156 @@ 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 $package_key $package_name $pretty_plural $package_uri $package_type $initial_install_p $singleton_p $relative_path + 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 version_id [apm_package_install_version -callback $callback $package_key $version_name \ - $version_uri $summary $description $description_format $vendor $vendor_uri $release_date] + $version_uri $summary $description $description_format $vendor $vendor_uri $auto_mount $release_date] apm_version_upgrade $version_id apm_package_upgrade_parameters -callback $callback $version(parameters) $package_key + } else { - set version_id [apm_package_install_version -callback $callback $package_key $version_name \ - $version_uri $summary $description $description_format $vendor $vendor_uri $release_date] + # We are installing a new package - ns_log Notice "INSTALL-HACK-LOG-BEN: version_id is $version_id" + 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] 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: 


 [ad_quotehtml $errmsg]
" return 0 } - if {![string compare $package_type "apm_service"] && ![string compare $singleton_p "t"]} { - # This is a singleton package. Instantiate it automatically. - if {[catch { - db_exec_plsql package_instantiate_mount { - declare - instance_id apm_packages.package_id%TYPE; - begin - instance_id := apm_package.new( - instance_name => :package_name, - package_key => :package_key, - context_id => acs.magic_object_id('default_context') - ); - end; - } - } errmsg]} { - apm_callback_and_log $callback "[string totitle $package_key] not instantiated.

Error: - 

[ad_quotehtml $errmsg]
" - } else { - apm_callback_and_log $callback "[string totitle $package_key] instantiated as $package_key.

" - } + + # 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 + + 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 + apm_invoke_callback_proc -version_id $version_id -type after-install + + 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 $priority_mount_path -parent_id $parent_id] + } + } error] } { + # 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] } { + + ns_log Notice "Mounting new instance of package $package_key at /${priority_mount_path}" + 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 "

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 + ns_log Notice "Creating singleton instance of package $package_key" + apm_package_instance_new $version(package-name) "" $package_key + } + } 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 + util_memoize_flush [list apm_package_installed_p_not_cached $package_key] + return $version_id } ad_proc -private apm_package_install_version { - { - -callback apm_dummy_callback - -version_id "" - } - package_key version_name version_uri summary description description_format vendor vendor_uri {release_date ""} + {-callback apm_dummy_callback} + {-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] } { @@ -422,24 +562,11 @@ set release_date [db_null] } - return [db_exec_plsql version_insert { - begin - :1 := apm_package_version.new( - version_id => :version_id, - package_key => :package_key, - version_name => :version_name, - version_uri => :version_uri, - summary => :summary, - description_format => :description_format, - description => :description, - release_date => :release_date, - vendor => :vendor, - vendor_uri => :vendor_uri, - installed_p => 't', - data_model_loaded_p => 't' - ); - end; - }] + return [db_exec_plsql version_insert {}] + + # Every package provides by default the service that is the package itself + # This spares the developer from having to visit the dependency page + apm_interface_add $version_id $package_key $version_name } @@ -506,13 +633,14 @@ end; } # Remove the files from the filesystem - if {$remove_files_p == 1} { + if {$remove_files_p==1} { if { [catch { 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" } } + apm_callback_and_log $callback "

    Done." } @@ -563,7 +691,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] } { @@ -753,40 +881,23 @@ } } -ad_proc -private apm_package_install_queries { +ad_proc -private apm_package_install_callbacks { {-callback apm_dummy_callback} - package_key - files + callback_list + version_id } { - Given a spec file, reads in the data model files to load from it. + Install the Tcl proc callbacks for the package version. - @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. - + @author Peter Marklund } { - set path "[acs_package_root_dir $package_key]" + db_dml delete_all_callbacks { + delete from apm_package_callbacks + where version_id = :version_id + } - - 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 "

    \n" - } } ad_proc -private apm_package_install_spec { version_id } { @@ -887,9 +998,16 @@ apm_callback_and_log $callback "

    Package disabled." } - ad_proc -public apm_package_register { - package_key pretty_name pretty_plural package_uri package_type initial_install_p singleton_p {spec_file_path ""} {spec_file_mtime ""} + {-spec_file_path ""} + {-spec_file_mtime ""} + package_key + pretty_name + pretty_plural + package_uri + package_type + initial_install_p + singleton_p } { Register the package in the system. } { @@ -903,35 +1021,9 @@ } if { ![string compare $package_type "apm_application"] } { - db_exec_plsql application_register { - begin - apm.register_application ( - package_key => :package_key, - package_uri => :package_uri, - pretty_name => :pretty_name, - pretty_plural => :pretty_plural, - initial_install_p => :initial_install_p, - singleton_p => :singleton_p, - spec_file_path => :spec_file_path, - spec_file_mtime => :spec_file_mtime - ); - end; - } + db_exec_plsql application_register {} } elseif { ![string compare $package_type "apm_service"] } { - db_exec_plsql service_register { - begin - apm.register_service ( - package_key => :package_key, - package_uri => :package_uri, - pretty_name => :pretty_name, - pretty_plural => :pretty_plural, - initial_install_p => :initial_install_p, - singleton_p => :singleton_p, - spec_file_path => :spec_file_path, - spec_file_mtime => :spec_file_mtime - ); - end; - } + db_exec_plsql service_register {} } else { error "Unrecognized package type: $package_type" } @@ -941,31 +1033,16 @@ { -callback apm_dummy_callback } - version_id version_name version_uri summary description description_format vendor vendor_uri {release_date ""} + version_id version_name version_uri summary description description_format vendor vendor_uri auto_mount {release_date ""} } { Update a version in the system to new information. } { if { [empty_string_p $release_date] } { set release_date [db_null] } - return [db_exec_plsql apm_version_update { - begin - :1 := apm_package_version.edit( - version_id => :version_id, - version_name => :version_name, - version_uri => :version_uri, - summary => :summary, - description_format => :description_format, - description => :description, - release_date => :release_date, - vendor => :vendor, - vendor_uri => :vendor_uri, - installed_p => 't', - data_model_loaded_p => 't' - ); - end; - }] + + return [db_exec_plsql apm_version_update {}] } @@ -976,8 +1053,6 @@ } { Loads the data model, installs, enables, instantiates, and mounts all of the packages in pkg_list. - Each package is mounted at /package-key. - } { foreach pkg_info $pkg_info_list { @@ -988,58 +1063,17 @@ set version_id [apm_version_enable -callback $callback \ [apm_package_install -callback $callback $spec_file]] } errmsg] } { - apm_callback_and_log $callback "

    [string totitle $package_key] not installed. + global errorInfo + apm_callback_and_log -severity Error $callback "

    [string totitle $package_key] not installed.

    Error: -

    [ad_quotehtml $errmsg]
    " +
    [ad_quotehtml $errmsg]
    [ad_quotehtml $errorInfo]
    " } } } -ad_proc -private apm_package_instantiate_and_mount { - { - -callback apm_dummy_callback - } package_key} { - - Automatically instantiate and mount a package of the indicated type. - -} { -# Instantiate and mount the package. - if { [catch { - db_exec_plsql package_instantiate_and_mount { - declare - main_site_id site_nodes.node_id%TYPE; - instance_id apm_packages.package_id%TYPE; - node_id site_nodes.node_id%TYPE; - begin - main_site_id := site_node.node_id('/'); - - instance_id := apm_package.new( - package_key => :package_key, - context_id => main_site_id - ); - - node_id := site_node.new( - parent_id => main_site_id, - name => :package_key, - directory_p => 't', - pattern_p => 't', - object_id => instance_id - ); - end; - } - } errmsg]} { - apm_callback_and_log $callback "[string totitle $package_key] not mounted.

    Error: -

    [ad_quotehtml $errmsg]
    " - } else { - apm_callback_and_log $callback "[string totitle $package_key] mounted at /$package_key/.

    " - } -} - ad_proc -private apm_package_upgrade_p {package_key version_name} { - @return 1 if a version of the indicated package_key of version lower than version_name \ is already installed in the system, 0 otherwise. - } { return [db_string apm_package_upgrade_p { select apm_package_version.version_name_greater(:version_name, version_name) upgrade_p @@ -1049,6 +1083,22 @@ } -default 0] } +ad_proc -private apm_package_upgrade_from { package_key version_name } { + @param package_key The package you're installing + @param version_name The version of the package you're installing + @return the version of the package currently installed, which we're upgrading from, if it's + different from the version_name passed in. If this is not an upgrade, returns the empty string. +} { + return [db_string apm_package_upgrade_from { + select version_name + from apm_package_versions + where package_key = :package_key + and version_id = apm_package.highest_version(:package_key) + and version_name != :version_name + } -default ""] +} + + ad_proc -private apm_version_upgrade {version_id} { Upgrade a package to a locally maintained later version. @@ -1116,7 +1166,7 @@ ad_proc -private apm_data_model_scripts_find { {-upgrade_from_version_name ""} {-upgrade_to_version_name ""} - package_key file_list + package_key } { @param version_id What version the files belong to. @param upgrade Set this switch if you want the scripts for upgrading. @@ -1130,10 +1180,10 @@ } set data_model_list [list] set upgrade_file_list [list] - foreach file $file_list { - set path [lindex $file 0] - set file_type [lindex $file 1] - set file_db_type [lindex $file 2] + set file_list [apm_get_package_files -file_types $types_to_retrieve -package_key $package_key] + foreach path $file_list { + set file_type [apm_guess_file_type $package_key $path] + set file_db_type [apm_guess_db_type $package_key $path] apm_log APMDebug "APM: Checking \"$path\" of type \"$file_type\" and db_type \"$file_db_type\"." # DRB: we return datamodel files which match the given database type or for which no db_type @@ -1158,6 +1208,7 @@ } set file_list [concat [apm_order_upgrade_scripts $upgrade_file_list] $data_model_list] apm_log APMDebug "APM: Data model scripts for $package_key: $file_list" + ns_log Notice "pm debug APM: Data model scripts for $package_key: $file_list" return $file_list } @@ -1189,3 +1240,185 @@ ns_log Notice "APM: Query files for $package_key: $query_file_list" return $query_file_list } + +ad_proc -private apm_mount_core_packages {} { +

    + Mount, and set permissions for a number of packages + part of the OpenACS core. The packages are singletons that have + already been instantiated during installation. The main site + needs to have been set up prior to invoking this proc. +

    + +

    + The reason mounting is done here and not via the auto-mount + feature of the APM is that there is a circular dependency between + acs-subsite and acs-content-repository. The package acs-subsite + requires acs-content-repository and so we cannot install acs-subsite + before acs-content-repository in order to be able to mount acs-content-repository. +

    + + @author Peter Marklund +} { + ns_log Notice "Starting instantiation and mounting of core packages" + + # Mount acs-admin + ns_log Notice "Mounting acs-admin" + site_node::instantiate_and_mount -package_key acs-admin + + # Mount acs-service-contract + ns_log Notice "Mounting acs-service-contract" + site_node::instantiate_and_mount -package_key acs-service-contract + + # Mount the acs-content-repository + ns_log Notice "Mounting acs-content-repository" + site_node::instantiate_and_mount -package_key acs-content-repository + + # Mount acs-core-docs + ns_log Notice "Mounting acs-core-docs" + site_node::instantiate_and_mount -node_name doc \ + -package_key acs-core-docs + + # Mount the acs-api-browser + ns_log Notice "Mounting acs-api-browser" + set api_browser_id \ + [site_node::instantiate_and_mount -node_name api-doc \ + -package_key acs-api-browser] + # Only registered users should have permission to access the + # api-browser + permission::grant -party_id [acs_magic_object registered_users] \ + -object_id $api_browser_id \ + -privilege read + permission::set_not_inherit -object_id $api_browser_id + + ns_log Notice "Core packages instantiated and mounted" +} + +ad_proc -private apm_version_name_compare { + version_name_1 + version_name_2 +} { + Compare two version names (e.g. '1.2d3' and '3.5b') as for which comes before which. The example here would return -1. + @param version_name_1 the first version name + @param version_name_2 the second version name + @return 1 if version_name_1 comes after version_name_2, 0 if they are the same, -1 if version_name_1 comes before version_name_2. + @author Lars Pind +} { + db_1row select_sortable_versions {} + return [string compare $sortable_version_1 $sortable_version_2] +} + +ad_proc -public apm_version_names_compare { + version_name_1 + version_name_2 +} { + Compare two version names (e.g. '1.2d3' and '3.5b') as for which comes before which. The example here would return -1. + @param version_name_1 the first version name + @param version_name_2 the second version name + @return 1 if version_name_1 comes after version_name_2, 0 if they are the same, -1 if version_name_1 comes before version_name_2. + + @author Lars Pind +} { + db_1row select_sortable_versions {} + return [string compare $sortable_version_1 $sortable_version_2] +} + +ad_proc -private apm_upgrade_logic_compare { + from_to_key_1 + from_to_key_2 +} { + Compare the from-versions in two of apm_upgrade_logic's array entries on the form 'from_version_name,to_version_name'. + + @param from_to_key the key from the array in apm_upgrade_logic + @return 1 if 1 comes after 2, 0 if they are the same, -1 if 1 comes before 2. + + @author Lars Pind +} { + return [apm_version_names_compare [lindex [split $from_to_key_1 ","] 0] [lindex [split $from_to_key_2 ","] 0]] +} + +ad_proc -public apm_upgrade_logic { + {-from_version_name:required} + {-to_version_name:required} + {-spec:required} +} { + Logic to help upgrade a package. + The spec contains a list on the form \{ from_version to_version code_chunk from_version to_version code_chunk ... \}. + The list is compared against the from_version_name and to_version_name parameters supplied, and the code_chunks that + 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: + + 

    +
+    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 {
+            ...
+        }
+    }
+    
+
    + + @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 +# +############# + +ad_proc -private -deprecated -warn apm_package_instantiate_and_mount { + {-callback apm_dummy_callback} + package_key +} { + Instantiate and mount a package of the indicated type. This proc + has been deprecated and will be removed. Please change to using + site_node::instantiate_and_mount instead. + + @see site_node::instantiate_and_mount +} { + site_node::instantiate_and_mount -package_key $package_key +}