[ad_quotehtml $package_errors($file)]
[ad_quotehtml $package_errors($file)]
There - $exist_n_error_files with errors that prevented complete - reloading. Fix the problem, then reload the - package again to finish the reload. -
- " + if {$n_errors > 1} { + set exist_n_error_files "were $n_errors files" + } else { + set exist_n_error_files "was $n_errors file" + } + append body " +There + $exist_n_error_files with errors that prevented complete + reloading. Fix the problem, then reload the + package again to finish the reload. +
+ " } } if { [info exists files_to_watch_p] } { append body [subst { - If you know you're going to be modifying one of the above files frequently, - select the "watch this file" link next to a filename to cause the interpreters to - reload the file immediately whenever it is changed.-
+
$path should be
- relative to the package directory (e.g., www/index.tcl
+ relative to the package directory (e.g., www/index.tcl)
for /packages/bboard/admin-www/index.tcl. We use the following rules:
.sql are considered data-model files,
.dat are considered SQL data files.
.ctl are considered sql data loader control files.
- or if any path contains the substring upgrade, data-model upgrade
- files.
- .sqlj are considered sqlj_code files.
+ or if any path contains the substring upgrade, data-model upgrade files.
+ .sqlj are considered sqlj_code files.
.info are considered package specification files.
.xql are considered query files.
.java are considered java code files.
.jar are considered java archive files.
doc are considered
documentation files.
.pl or .sh or
- which have a path component named
+ which have a path component named
bin, are considered shell-executable files.
templates are considered
template files.
@@ -55,27 +54,27 @@
are considered content-page files.
lib
are considered include_page files.
- -procs(-)+()*.tcl) or -init.tcl are considered
+ -procs(-)+()*.tcl)
+ or -init.tcl are considered
Tcl procedure or Tcl initialization files, respectively.
- .tcl are considered Tcl utility script files (normally
- found only in the bootstrap installer).
+ .tcl are considered Tcl utility script files
+ (normally found only in the bootstrap installer).
.xml in the directory catalog are
- considered message catalog files.
+ considered message catalog files.
- Returns all files, or files of a certain types, belonging to an APM - package. Ignores files based on proc apm_include_file_p and determines file type - of files with proc apm_guess_file_type. Only returns file with no db type or a - db type matching that of the system. -
++ Returns all files, or files of a certain types, belonging to an APM + package. Ignores files based on proc apm_include_file_p and determines file type + of files with proc apm_guess_file_type. Only returns file with no db type or a + db type matching that of the system. +
-- Goes directly to the filesystem to find - files instead of using a file listing in the package info file or the database. -
++ Goes directly to the filesystem to find + files instead of using a file listing in the package info file or the database. +
- @param package_key The key of the package to return file paths for - @param file_types The type of files to return. If not provided files of all types - recognized by the APM are returned. - @param package_path The full path of the root directory of the package. Defaults to - acs_package_root_dir. + @param package_key The key of the package to return file paths for + @param file_types The type of files to return. If not provided files of all types + recognized by the APM are returned. + @param package_path The full path of the root directory of the package. Defaults to + acs_package_root_dir. - @return The paths, relative to the root dir of the package, of matching files. + @return The paths, relative to the root dir of the package, of matching files. - @author Peter Marklund + @author Peter Marklund - @see apm_include_file_p - @see apm_guess_file_type - @see apm_guess_db_type + @see apm_include_file_p + @see apm_guess_file_type + @see apm_guess_db_type } { if { $package_path eq "" } { set package_path [acs_package_root_dir $package_key] } if {$all_p} { - set file_function "" + set file_function "" } else { - set file_function [expr {$include_data_model_files_p ? "apm_include_data_model_file_p" : "apm_include_file_p"}] + set file_function [expr {$include_data_model_files_p ? "apm_include_data_model_file_p" : "apm_include_file_p"}] } set files [lsort [ad_find_all_files -check_file_func $file_function $package_path]] # We don't assume db_type proc is defined yet @@ -283,34 +282,33 @@ Guesses and returns the database type key corresponding to a particular path (or an empty string if none is known).$path should be
- relative to the package directory (e.g., www/index.tcl
- for /packages/bboard/admin-www/index.tcl.
+ relative to the package directory (e.g., www/index.tcl for /packages/bboard/admin-www/index.tcl).
We consider two cases:
-
+
1. Data model files.
- If the path contains a string matching "sql/" followed by a database type known
- to this version of OpenACS, the file is assumed to be specific to that database type.
- The empty string is returned for all other data model files.
+ If the path contains a string matching "sql/" followed by a database type known
+ to this version of OpenACS, the file is assumed to be specific to that database type.
+ The empty string is returned for all other data model files.
- Example: "sql/postgresql/apm-create.sql" is assumed to be the PostgreSQL-specific
- file used to create the APM datamodel.
+ Example: "sql/postgresql/apm-create.sql" is assumed to be the PostgreSQL-specific
+ file used to create the APM datamodel.
- If the path contains a string matching "sql/common" the file is assumed to be
- compatible with all supported RDBMS's and a blank db_type is returned.
+ If the path contains a string matching "sql/common" the file is assumed to be
+ compatible with all supported RDBMS's and a blank db_type is returned.
- Otherwise "oracle" is returned. This is a hardwired kludge to allow us to
- handle legacy ACS 4 packages.
+ Otherwise "oracle" is returned. This is a hardwired kludge to allow us to
+ handle legacy ACS 4 packages.
2. Other files.
- If it is a tcl, xql, or sqlj file not under the sql dir and whose name
- ends in a dash and database type, the file is assumed to be specific to
- that database type.
+ If it is a tcl, xql, or sqlj file not under the sql dir and whose name
+ ends in a dash and database type, the file is assumed to be specific to
+ that database type.
- Example: "tcl/10-database-postgresql-proc.tcl" is asusmed to be the file that
- defines the PostgreSQL-specific portions of the database API.
+ Example: "tcl/10-database-postgresql-proc.tcl" is asusmed to be the file that
+ defines the PostgreSQL-specific portions of the database API.
} {
set components [split $path "/"]
@@ -368,26 +366,26 @@
apm_library_mtime
} {
if {$errorVarName ne ""} {
- upvar $errorVarName errors
+ upvar $errorVarName errors
} else {
- array set errors [list]
+ array set errors [list]
}
if { ![file exists $__file] } {
- ns_log "Error" "Unable to source $__file: file does not exist."
- return 0
+ ns_log "Error" "Unable to source $__file: file does not exist."
+ return 0
}
set r_file [ad_make_relative_path $__file]
# Actually do the source.
if { [catch { source $__file } errorMsg] } {
- set backTrace $::errorInfo
- ns_log "Error" "Error sourcing $__file:\n$backTrace"
- set package_key ""
- regexp {/packages/([^/]+)/} $__file -> package_key
- lappend errors($package_key) $r_file $backTrace
- return 0
+ set backTrace $::errorInfo
+ ns_log "Error" "Error sourcing $__file:\n$backTrace"
+ set package_key ""
+ regexp {/packages/([^/]+)/} $__file -> package_key
+ lappend errors($package_key) $r_file $backTrace
+ return 0
}
nsv_set apm_library_mtime $r_file [file mtime $__file]
@@ -462,13 +460,13 @@
# DRB: We can't parse the $package_key.info file at this point in time, primarily because
# grabbing the package information uses not only the XML file but tables from the APM,
- # which haven't been loaded yet if we're installing. So we just snarf all of the
- # queryfiles in this package that match the current database or no database
+ # which haven't been loaded yet if we're installing. So we just snarf all of the
+ # queryfiles in this package that match the current database or no database
# (which we interpret to mean all supported databases).
set files [ad_find_all_files $::acs::rootdir/packages/$package_key]
if { [llength $files] == 0 } {
- error "Unable to locate $::acs::rootdir/packages/$package_key/*."
+ error "Unable to locate $::acs::rootdir/packages/$package_key/*."
}
foreach file [lsort $files] {
@@ -478,7 +476,7 @@
if {$file_type eq "query_file" &&
($file_db_type eq "" || $file_db_type eq $db_type)} {
- db_qd_load_query_file $file
+ db_qd_load_query_file $file
}
}
}
@@ -519,23 +517,23 @@
} {
if {[file isdirectory $path]} {
- #
- # ignored directories
- #
- set parts [file split $path]
- if {[lindex $parts end] eq "resources" && [lindex $parts end-1] eq "www"} {
- return 1
- }
+ #
+ # ignored directories
+ #
+ set parts [file split $path]
+ if {[lindex $parts end] eq "resources" && [lindex $parts end-1] eq "www"} {
+ return 1
+ }
- set dir_list {CVS .git catalog}
- if {!$data_model_files_p} {
- lappend dir_list "upgrade"
+ set dir_list {CVS .git catalog}
+ if {!$data_model_files_p} {
+ lappend dir_list "upgrade"
+ }
+
+ if {[lindex $parts end] in $dir_list} {
+ return 1
+ }
}
-
- if {[lindex $parts end] in $dir_list} {
- return 1
- }
- }
#
# ignored extensions
#
@@ -597,9 +595,16 @@
set doCopy [expr {$to_version_name eq "5.8.1d3"}]
if {$doCopy} {
- set source [acs_root_dir]/packages/acs-bootstrap-installer/installer/tcl
- foreach file [glob -nocomplain $source/*tcl] {
- file copy -force $file [acs_root_dir]/tcl
- }
+ set source [acs_root_dir]/packages/acs-bootstrap-installer/installer/tcl
+ foreach file [glob -nocomplain $source/*tcl] {
+ file copy -force $file [acs_root_dir]/tcl
+ }
}
}
+
+#
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
Index: openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl,v
diff -u -r1.42.2.7 -r1.42.2.8
--- openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 7 Aug 2014 19:09:26 -0000 1.42.2.7
+++ openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 7 Aug 2014 19:24:52 -0000 1.42.2.8
@@ -104,9 +104,9 @@
# If the query being tested was written for a version that is older than
# the current RDBMS then we have compatibility. Otherwise we don't.
foreach t [split [db_rdbms_get_version $rdbms_test ] "\."] \
- p [split [db_rdbms_get_version $rdbms_pattern] "\."] {
- if {$t != $p} {return [expr {$t < $p}]}
- }
+ p [split [db_rdbms_get_version $rdbms_pattern] "\."] {
+ if {$t != $p} {return [expr {$t < $p}]}
+ }
# Same version (though not strictly "older") is OK
return 1
@@ -532,12 +532,12 @@
set new_name [db_qd_make_absolute_path $queryname_root [db_fullquery_get_name $one_query]]
set new_fullquery [db_fullquery_create \
- $new_name \
- [db_fullquery_get_querytext $one_query] \
- [db_fullquery_get_bind_vars $one_query] \
- [db_fullquery_get_query_type $one_query] \
- [db_fullquery_get_rdbms $one_query] \
- [db_fullquery_get_load_location $one_query]]
+ $new_name \
+ [db_fullquery_get_querytext $one_query] \
+ [db_fullquery_get_bind_vars $one_query] \
+ [db_fullquery_get_query_type $one_query] \
+ [db_fullquery_get_rdbms $one_query] \
+ [db_fullquery_get_load_location $one_query]]
set one_query $new_fullquery
@@ -549,7 +549,7 @@
}
set relative_path [string range $file_tag \
- [expr { [string length $::acs::rootdir] + 1 }] end]
+ [expr { [string length $::acs::rootdir] + 1 }] end]
nsv_set apm_library_mtime $relative_path [file mtime $file_tag]
}
@@ -894,3 +894,10 @@
if { $remove_ad_proc_p } {
rename ad_proc {}
}
+
+#
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
Index: openacs-4/packages/acs-tcl/tcl/apm-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-procs.tcl,v
diff -u -r1.94.2.16 -r1.94.2.17
--- openacs-4/packages/acs-tcl/tcl/apm-procs.tcl 7 Aug 2014 19:09:26 -0000 1.94.2.16
+++ openacs-4/packages/acs-tcl/tcl/apm-procs.tcl 7 Aug 2014 19:24:52 -0000 1.94.2.17
@@ -115,9 +115,9 @@
}
ad_proc -public apm_ns_write_callback { string } {
-
+
A simple callback which prints out the log message to the server stream.
-
+
} {
ns_write $string
}
@@ -195,7 +195,7 @@
global apm_package_url_resolution
foreach package $package_list {
- lassign $package package_key dependency_type
+ lassign $package package_key dependency_type
if { [info exists apm_visited_package_keys($package_key)] } {
continue
}
@@ -204,27 +204,27 @@
"" { lappend apm_package_url_resolution $::acs::rootdir/packages/$package_key/www }
embeds {
- # Reference to an embedded package is through URLs relative to the embedding
- # package's mount point, taking one of the forms package-key,
- # admin/package-key and sitewide-admin/package-key. These map to package-key/embed,
- # package-key/embed/admin, and package-key/embed/sitewide-admin respectively.
+ # Reference to an embedded package is through URLs relative to the embedding
+ # package's mount point, taking one of the forms package-key,
+ # admin/package-key and sitewide-admin/package-key. These map to package-key/embed,
+ # package-key/embed/admin, and package-key/embed/sitewide-admin respectively.
- # We break references like package-key/admin because such references are unsafe,
- # as the request processor will not perform the expected permission check.
+ # We break references like package-key/admin because such references are unsafe,
+ # as the request processor will not perform the expected permission check.
- lappend apm_package_url_resolution \
- [list $::acs::rootdir/packages/$package_key/embed/admin admin/$package_key]
- lappend apm_package_url_resolution \
- [list "" $package_key/admin]
+ lappend apm_package_url_resolution \
+ [list $::acs::rootdir/packages/$package_key/embed/admin admin/$package_key]
+ lappend apm_package_url_resolution \
+ [list "" $package_key/admin]
- lappend apm_package_url_resolution \
- [list $::acs::rootdir/packages/$package_key/embed/sitewide-admin \
- sitewide-admin/$package_key]
- lappend apm_package_url_resolution \
- [list "" $package_key/sitewide-admin]
+ lappend apm_package_url_resolution \
+ [list $::acs::rootdir/packages/$package_key/embed/sitewide-admin \
+ sitewide-admin/$package_key]
+ lappend apm_package_url_resolution \
+ [list "" $package_key/sitewide-admin]
- lappend apm_package_url_resolution \
- [list $::acs::rootdir/packages/$package_key/embed $package_key]
+ lappend apm_package_url_resolution \
+ [list $::acs::rootdir/packages/$package_key/embed $package_key]
}
default {
error "apm_package_list_url_resolution: dependency type is $dependency_type"
@@ -235,9 +235,9 @@
# Make sure old versions work ...
foreach package $package_list {
- lassign $package package_key dependency_type
+ lassign $package package_key dependency_type
set inherit_templates_p t
-#fix!
+ #fix!
catch { db_1row get_inherit_templates_p {} }
apm_package_list_url_resolution [db_list_of_lists get_dependencies {}]
}
@@ -383,8 +383,8 @@
@param file_list A list of paths relative to $::acs::rootdir
@param force_reload Mark the files for reload even if their modification
- time in the nsv cache doesn't differ from the one
- in the filesystem.
+ time in the nsv cache doesn't differ from the one
+ in the filesystem.
@return The list of files marked for reload.
@@ -394,22 +394,22 @@
foreach relative_path $file_list {
set full_path "$::acs::rootdir/$relative_path"
- # If the file exists, and either has never been loaded or has an mtime
- # which differs the mtime it had when last loaded, mark to be loaded.
- if { [file isfile $full_path] } {
- set mtime [file mtime $full_path]
- if { $force_reload_p
- || (![nsv_exists apm_library_mtime $relative_path]
- || [nsv_get apm_library_mtime $relative_path] != $mtime
- || [clock seconds]-$mtime < 5) } {
- lappend changed_files $relative_path
- }
- }
+ # If the file exists, and either has never been loaded or has an mtime
+ # which differs the mtime it had when last loaded, mark to be loaded.
+ if { [file isfile $full_path] } {
+ set mtime [file mtime $full_path]
+ if { $force_reload_p
+ || (![nsv_exists apm_library_mtime $relative_path]
+ || [nsv_get apm_library_mtime $relative_path] != $mtime
+ || [clock seconds]-$mtime < 5) } {
+ lappend changed_files $relative_path
+ }
+ }
}
if { [llength $changed_files] > 0 } {
- set reload [nsv_incr apm_properties reload_level]
- nsv_set apm_reload $reload $changed_files
+ set reload [nsv_incr apm_properties reload_level]
+ nsv_set apm_reload $reload $changed_files
}
return $changed_files
@@ -422,7 +422,7 @@
Examines all tcl_procs files in package version $version_id; if any have
changed since they were loaded, marks (in the apm_reload array) that
they must be reloaded by each Tcl interpreter (using the
- apm_load_any_changed_libraries procedure).
+ apm_load_any_changed_libraries procedure).
Saves a list of files that have changed (and thus marked to be reloaded) in
the variable named $file_info_var, if provided. Each element
@@ -432,11 +432,11 @@
} {
if { $changed_files_var ne "" } {
- upvar $changed_files_var changed_files
+ upvar $changed_files_var changed_files
}
- ns_log notice "apm_mark_version_for_reload try to get package_key from $version_id"
+ ns_log notice "apm_mark_version_for_reload try to get package_key from $version_id"
set package_key [apm_package_key_from_version_id $version_id]
- ns_log notice "apm_mark_version_for_reload $package_key $version_id"
+ ns_log notice "apm_mark_version_for_reload $package_key $version_id"
set changed_files [list]
set file_types [list tcl_procs query_file]
@@ -445,8 +445,8 @@
}
foreach path [apm_get_package_files -package_key $package_key -file_types $file_types] {
- set full_path "[acs_package_root_dir $package_key]/$path"
- set relative_path "packages/$package_key/$path"
+ set full_path "[acs_package_root_dir $package_key]/$path"
+ set relative_path "packages/$package_key/$path"
set reload_file [apm_mark_files_for_reload $relative_path]
if { [llength $reload_file] > 0 } {
@@ -459,14 +459,14 @@
ad_proc -private apm_version_load_status { version_id } {
If a version needs to be reloaded (i.e., a -procs.tcl has changed
- or been added since the version was loaded), returns "needs_reload".
+ or been added since the version was loaded), returns "needs_reload".
If the version has never been loaded, returns "never_loaded". If the
version is up-to-date, returns "up_to_date".
} {
# See if the version was ever loaded.
if { ![apm_package_version_enabled_p $version_id] } {
- return "never_loaded"
+ return "never_loaded"
}
set package_key [apm_package_key_from_version_id $version_id]
@@ -475,37 +475,37 @@
lappend procs_types test_procs
}
foreach file [apm_get_package_files -package_key $package_key -file_types $procs_types] {
- # If $file has never been loaded, i.e., it has been added to the version
- # since the version was initially loaded, return needs_reload.
- if { ![nsv_exists apm_library_mtime "packages/$package_key/$file"] } {
- return "needs_reload"
- }
+ # If $file has never been loaded, i.e., it has been added to the version
+ # since the version was initially loaded, return needs_reload.
+ if { ![nsv_exists apm_library_mtime "packages/$package_key/$file"] } {
+ return "needs_reload"
+ }
- set full_path "[acs_package_root_dir $package_key]/$file"
- # If $file had a different mtime when it was last loaded, return
- # needs_reload. (If the file should exist but doesn't, just skip it.)
- if { [file exists $full_path]
- && [file mtime $full_path] ne [nsv_get apm_library_mtime "packages/$package_key/$file"]
- } {
- return "needs_reload"
- }
+ set full_path "[acs_package_root_dir $package_key]/$file"
+ # If $file had a different mtime when it was last loaded, return
+ # needs_reload. (If the file should exist but doesn't, just skip it.)
+ if { [file exists $full_path]
+ && [file mtime $full_path] ne [nsv_get apm_library_mtime "packages/$package_key/$file"]
+ } {
+ return "needs_reload"
+ }
}
foreach file [apm_get_package_files -package_key $package_key -file_types "query_file"] {
- # If $file has never been loaded, i.e., it has been added to the version
- # since the version was initially loaded, return needs_reload.
- if { ![nsv_exists apm_library_mtime "packages/$package_key/$file"] } {
- return "needs_reload"
- }
+ # If $file has never been loaded, i.e., it has been added to the version
+ # since the version was initially loaded, return needs_reload.
+ if { ![nsv_exists apm_library_mtime "packages/$package_key/$file"] } {
+ return "needs_reload"
+ }
- set full_path "[acs_package_root_dir $package_key]/$file"
- # If $file had a different mtime when it was last loaded, return
- # needs_reload. (If the file should exist but doesn't, just skip it.)
- if { [file exists $full_path]
- && [file mtime $full_path] ne [nsv_get apm_library_mtime "packages/$package_key/$file"]
- } {
- return "needs_reload"
- }
+ set full_path "[acs_package_root_dir $package_key]/$file"
+ # If $file had a different mtime when it was last loaded, return
+ # needs_reload. (If the file should exist but doesn't, just skip it.)
+ if { [file exists $full_path]
+ && [file mtime $full_path] ne [nsv_get apm_library_mtime "packages/$package_key/$file"]
+ } {
+ return "needs_reload"
+ }
}
return "up_to_date"
@@ -525,7 +525,7 @@
current interpreter for installed, enabled packages. Only loads
files which have not yet been loaded. This is intended to be called only during server
initialization (since it loads libraries only into the running interpreter, as opposed
- to in *all* active interpreters).
+ to in *all* active interpreters).
} {
set file_types [list]
@@ -541,7 +541,7 @@
if { $test_init_p } {
lappend file_types test_init
}
-
+
if { $packages eq "" } {
set packages [apm_enabled_packages]
}
@@ -552,11 +552,11 @@
set paths [apm_get_package_files -package_key $package -file_types $file_types]
- foreach path [lsort $paths] {
- lappend files [list $package $path]
- }
+ foreach path [lsort $paths] {
+ lappend files [list $package $path]
+ }
}
-
+
# Release all outstanding database handles (since the file we're sourcing
# might be using the ns_db database API as opposed to the new db_* API).
db_release_unused_handles
@@ -586,13 +586,13 @@
@param force_reload Reload Tcl libraries even if they are already loaded.
@param load_libraries Switch to indicate if Tcl libraries in (-procs.tcl and -init.tcl)
- files should be loaded. Defaults to true.
+ files should be loaded. Defaults to true.
@param load_queries Switch to indicate if xql query files should be loaded. Default true.
@param packages A list of package_keys for packages to be loaded. Defaults to
- all enabled packages. These packages, along with the packages
- they depend on, will be loaded in dependency-order using the
- information provided in the packages' "provides" and "requires"
- attributes.
+ all enabled packages. These packages, along with the packages
+ they depend on, will be loaded in dependency-order using the
+ information provided in the packages' "provides" and "requires"
+ attributes.
@see apm_mark_version_for_reload
@@ -626,26 +626,26 @@
# Load up the Automated Tests and associated Queries if necessary
if {$load_tests_p} {
- apm_load_libraries -force_reload=$force_reload_p -packages $packages -test_procs
- apm_load_queries -packages $packages_to_load -test_queries
+ apm_load_libraries -force_reload=$force_reload_p -packages $packages -test_procs
+ apm_load_queries -packages $packages_to_load -test_queries
}
if { $load_libraries_p } {
# branimir: acs-lang needs to be initialized before anything else
# because there are packages whose *-init.tcl files depend on it.
- apm_load_libraries -force_reload=$force_reload_p -init -packages acs-lang
- set p [lsearch $packages_to_load acs-lang]
- if {$p > -1} {
- set unique_packages [lreplace $packages_to_load $p $p]
- } else {
- set unique_packages $packages_to_load
- }
+ apm_load_libraries -force_reload=$force_reload_p -init -packages acs-lang
+ set p [lsearch $packages_to_load acs-lang]
+ if {$p > -1} {
+ set unique_packages [lreplace $packages_to_load $p $p]
+ } else {
+ set unique_packages $packages_to_load
+ }
apm_load_libraries -force_reload=$force_reload_p -init -packages $unique_packages
}
# Load up the Automated Tests initialisation scripts if necessary
if {$load_tests_p} {
- apm_load_libraries -force_reload=$force_reload_p -packages $packages_to_load -test_init
+ apm_load_libraries -force_reload=$force_reload_p -packages $packages_to_load -test_init
}
}
@@ -672,7 +672,7 @@
set files [ad_find_all_files $::acs::rootdir/packages/$package]
if { [llength $files] == 0 } {
- ns_log Error "apm_load_queries: Unable to locate $::acs::rootdir/packages/$package/*. when scanning for SQL queries to load."
+ ns_log Error "apm_load_queries: Unable to locate $::acs::rootdir/packages/$package/*. when scanning for SQL queries to load."
}
set testdir "$::acs::rootdir/packages/$package/tcl/test"
@@ -684,9 +684,9 @@
set file_type [apm_guess_file_type $package $file]
if {![string compare -length $testlength $testdir $file]} {
- set is_test_file_p 1
+ set is_test_file_p 1
} else {
- set is_test_file_p 0
+ set is_test_file_p 0
}
#
@@ -701,10 +701,10 @@
# !( 1 ^ 1 ) = Yep
#
if {!($test_queries_p ^ $is_test_file_p)
- && $file_type eq "query_file"
- && ($file_db_type eq "" || $file_db_type eq [db_type])
- } {
- db_qd_load_query_file $file
+ && $file_type eq "query_file"
+ && ($file_db_type eq "" || $file_db_type eq [db_type])
+ } {
+ db_qd_load_query_file $file
}
}
}
@@ -719,7 +719,7 @@
set dirs [list]
lappend dirs $path
foreach subdir [glob -nocomplain -type d [file join $path *]] {
- set dirs [concat $dirs [apm_subdirs $subdir]]
+ set dirs [concat $dirs [apm_subdirs $subdir]]
}
return $dirs
}
@@ -757,45 +757,45 @@
apm_mark_version_for_reload. If any watches are set, examines watched
files to see whether they need to be reloaded as well. This is intended
to be called only by the request processor (since it should be invoked
- before any filters or registered procedures are applied).
+ before any filters or registered procedures are applied).
} {
if {$errorVarName ne ""} {
- upvar $errorVarName errors
+ upvar $errorVarName errors
} else {
- array set errors [list]
+ array set errors [list]
}
# Determine the current reload level in this interpreter by calling
# apm_reload_level_in_this_interpreter. If this fails, we define the reload level to be
# zero.
if { [catch { set reload_level [apm_reload_level_in_this_interpreter] } error] } {
- proc apm_reload_level_in_this_interpreter {} { return 0 }
- set reload_level 0
+ proc apm_reload_level_in_this_interpreter {} { return 0 }
+ set reload_level 0
}
# Check watched files, adding them to files_to_reload if they have
# changed.
set files_to_reload [list]
foreach file [nsv_array names apm_reload_watch] {
- set path "$::acs::rootdir/$file"
- ns_log Debug "APM: File being watched: $path"
+ set path "$::acs::rootdir/$file"
+ ns_log Debug "APM: File being watched: $path"
- if { [file exists $path]
- && (![nsv_exists apm_library_mtime $file] ||
- [file mtime $path] ne [nsv_get apm_library_mtime $file])
- } {
- lappend files_to_reload $file
- }
+ if { [file exists $path]
+ && (![nsv_exists apm_library_mtime $file] ||
+ [file mtime $path] ne [nsv_get apm_library_mtime $file])
+ } {
+ lappend files_to_reload $file
+ }
}
# If there are any changed watched files, stick another entry on the
# reload queue.
if { [llength $files_to_reload] > 0 } {
- ns_log Notice "apm_load_any_changed_libraries: Watched file[ad_decode [llength $files_to_reload] 1 "" "s"] [join $files_to_reload ", "] [ad_decode [llength $files_to_reload] 1 "has" "have"] changed: reloading."
- set new_level [nsv_incr apm_properties reload_level]
- nsv_set apm_reload $new_level $files_to_reload
+ ns_log Notice "apm_load_any_changed_libraries: Watched file[ad_decode [llength $files_to_reload] 1 "" "s"] [join $files_to_reload ", "] [ad_decode [llength $files_to_reload] 1 "has" "have"] changed: reloading."
+ set new_level [nsv_incr apm_properties reload_level]
+ nsv_set apm_reload $new_level $files_to_reload
}
set changed_reload_level_p 0
@@ -804,22 +804,22 @@
# reload the same one twice.
array set reloaded_files [list]
while { $reload_level < [nsv_get apm_properties reload_level] } {
- incr reload_level
- set changed_reload_level_p 1
- # If there's no entry in apm_reload for that reload level, back out.
- if { ![nsv_exists apm_reload $reload_level] } {
- incr reload_level -1
- break
- }
- foreach file [nsv_get apm_reload $reload_level] {
- # If we haven't yet reloaded the file in this loop, source it.
- if { ![info exists reloaded_files($file)] } {
- if { [array size reloaded_files] == 0 } {
- # Perform this ns_log only during the first iteration of this loop.
- ns_log Notice "apm_load_any_changed_libraries: Reloading *-procs.tcl files in this interpreter..."
- }
- # File is usually of form packages/package_key
- set file_path "$::acs::rootdir/$file"
+ incr reload_level
+ set changed_reload_level_p 1
+ # If there's no entry in apm_reload for that reload level, back out.
+ if { ![nsv_exists apm_reload $reload_level] } {
+ incr reload_level -1
+ break
+ }
+ foreach file [nsv_get apm_reload $reload_level] {
+ # If we haven't yet reloaded the file in this loop, source it.
+ if { ![info exists reloaded_files($file)] } {
+ if { [array size reloaded_files] == 0 } {
+ # Perform this ns_log only during the first iteration of this loop.
+ ns_log Notice "apm_load_any_changed_libraries: Reloading *-procs.tcl files in this interpreter..."
+ }
+ # File is usually of form packages/package_key
+ set file_path "$::acs::rootdir/$file"
set file_ext [file extension $file_path]
switch $file_ext {
@@ -839,15 +839,15 @@
}
}
- set reloaded_files($file) 1
- }
- }
+ set reloaded_files($file) 1
+ }
+ }
}
# We changed the reload level in this interpreter, so redefine the
# apm_reload_level_in_this_interpreter proc.
if { $changed_reload_level_p } {
- proc apm_reload_level_in_this_interpreter {} "return $reload_level"
+ proc apm_reload_level_in_this_interpreter {} "return $reload_level"
}
}
@@ -856,17 +856,17 @@
Returns a CVS release tag for a particular package key and version name.
-2} {
- regsub -all {\.} [string toupper "$package_key-$version_name"] "-" release_tag
- return $release_tag
-}
+ 2} {
+ regsub -all {\.} [string toupper "$package_key-$version_name"] "-" release_tag
+ return $release_tag
+ }
ad_proc -public apm_package_parameters {package_key} {
@return A list of all the package parameter names.
} {
return [db_list get_names {
- select parameter_name from apm_parameters
- where package_key = :package_key
+ select parameter_name from apm_parameters
+ where package_key = :package_key
}]
}
@@ -900,8 +900,8 @@
} {
### Query the database for the indicated package_key
return [db_string apm_package_registered_p {
- select 1 from apm_package_types
- where package_key = :package_key
+ select 1 from apm_package_types
+ where package_key = :package_key
} -default 0]
}
@@ -955,11 +955,11 @@
@return the version_id of the highest installed version of a package.
} {
return [db_exec_plsql apm_highest_version {
- begin
- :1 := apm_package.highest_version (
- package_key => :package_key
- );
- end;
+ begin
+ :1 := apm_package.highest_version (
+ package_key => :package_key
+ );
+ end;
}]
}
@@ -975,11 +975,11 @@
@return The number of instances of the indicated package.
} {
return [db_exec_plsql apm_num_instances {
- begin
- :1 := apm_package.num_instances(
- package_key => :package_key
- );
- end;
+ begin
+ :1 := apm_package.num_instances(
+ package_key => :package_key
+ );
+ end;
}]
}
@@ -999,25 +999,25 @@
@return The parameter id that has been updated.
} {
if {$section_name eq ""} {
- set section_name [db_null]
+ set section_name [db_null]
}
db_dml parameter_update {
- update apm_parameters
- set parameter_name = :parameter_name,
- default_value = :default_value,
- datatype = :datatype,
- description = :description,
- section_name = :section_name,
- min_n_values = :min_n_values,
- max_n_values = :max_n_values
- where parameter_id = :parameter_id
+ update apm_parameters
+ set parameter_name = :parameter_name,
+ default_value = :default_value,
+ datatype = :datatype,
+ description = :description,
+ section_name = :section_name,
+ min_n_values = :min_n_values,
+ max_n_values = :max_n_values
+ where parameter_id = :parameter_id
}
db_dml object_title_update {
- update acs_objects
- set title = :parameter_name
- where object_id = :parameter_id
+ update acs_objects
+ set title = :parameter_name
+ where object_id = :parameter_id
}
return $parameter_id
@@ -1045,11 +1045,11 @@
} {
if {$parameter_id eq ""} {
- set parameter_id [db_null]
+ set parameter_id [db_null]
}
if {$section_name eq ""} {
- set section_name [db_null]
+ set section_name [db_null]
}
ns_log debug "apm_parameter_register: Registering $parameter_name, $section_name, $default_value"
@@ -1065,7 +1065,7 @@
# Update the cache.
db_foreach apm_parameter_cache_update {
} {
- ad_parameter_cache -set $attr_value $package_id $parameter_name
+ ad_parameter_cache -set $attr_value $package_id $parameter_name
}
return $parameter_id
}
@@ -1087,10 +1087,10 @@
ns_log Debug "apm_parameter_unregister: Unregistering parameter $parameter_id."
if { $scope eq "global" } {
- ad_parameter_cache -delete $package_key $parameter_name
+ ad_parameter_cache -delete $package_key $parameter_name
} else {
db_foreach all_parameters_packages {} {
- ad_parameter_cache -delete $package_id $parameter_name
+ ad_parameter_cache -delete $package_id $parameter_name
}
}
db_exec_plsql unregister {}
@@ -1109,9 +1109,9 @@
} {
if {$dependency_id eq ""} {
- set dependency_id [db_null]
+ set dependency_id [db_null]
}
-
+
return [db_exec_plsql dependency_add {}]
}
@@ -1121,11 +1121,11 @@
} {
db_exec_plsql dependency_remove {
- begin
- apm_package_version.remove_dependency(
- dependency_id => :dependency_id
- );
- end;
+ begin
+ apm_package_version.remove_dependency(
+ dependency_id => :dependency_id
+ );
+ end;
}
}
@@ -1142,18 +1142,18 @@
} {
if {$interface_id eq ""} {
- set interface_id [db_null]
+ set interface_id [db_null]
}
return [db_exec_plsql interface_add {
- begin
- :1 := apm_package_version.add_interface(
- interface_id => :interface_id,
- version_id => :version_id,
- interface_uri => :interface_uri,
- interface_version => :interface_version
- );
- end;
+ begin
+ :1 := apm_package_version.add_interface(
+ interface_id => :interface_id,
+ version_id => :version_id,
+ interface_uri => :interface_uri,
+ interface_version => :interface_version
+ );
+ end;
}]
}
@@ -1163,11 +1163,11 @@
} {
db_exec_plsql interface_remove {
- begin
- apm_package_version.remove_interface(
- interface_id => :interface_id
- );
- end;
+ begin
+ apm_package_version.remove_interface(
+ interface_id => :interface_id
+ );
+ end;
}
}
@@ -1181,7 +1181,7 @@
@param version_id The id of the package version to get info for
@param package_key Can be specified instead of version_id in which case
- the live version of the package will be used.
+ the live version of the package will be used.
@param array The name of the array variable to upvar the info to
@author Peter Marklund
@@ -1212,7 +1212,7 @@
unmemoized version of apm_package_key_from_id
} {
return [db_string apm_package_key_from_id {
- select package_key from apm_packages where package_id = :package_id
+ select package_key from apm_packages where package_id = :package_id
} -default ""]
}
@@ -1230,7 +1230,7 @@
unmemoized version of apm_instance_name_from_id
} {
return [db_string apm_package_instance_name_from_id {
- select instance_name from apm_packages where package_id = :package_id
+ select instance_name from apm_packages where package_id = :package_id
} -default ""]
}
@@ -1253,7 +1253,7 @@
unmemoized version of apm_package_id_from_key
} {
return [db_string apm_package_id_from_key {
- select package_id from apm_packages where package_key = :package_key
+ select package_id from apm_packages where package_key = :package_key
} -default 0]
}
@@ -1278,19 +1278,19 @@
} {
if {$mounted_p} {
- set package_ids [list]
- db_foreach apm_package_ids_from_key {
- select package_id from apm_packages where package_key = :package_key
- } {
- if {"" ne [site_node::get_node_id_from_object_id -object_id $package_id] } {
- lappend package_ids $package_id
- }
- }
- return $package_ids
+ set package_ids [list]
+ db_foreach apm_package_ids_from_key {
+ select package_id from apm_packages where package_key = :package_key
+ } {
+ if {"" ne [site_node::get_node_id_from_object_id -object_id $package_id] } {
+ lappend package_ids $package_id
+ }
+ }
+ return $package_ids
} else {
- return [db_list apm_package_ids_from_key {
- select package_id from apm_packages where package_key = :package_key
- }]
+ return [db_list apm_package_ids_from_key {
+ select package_id from apm_packages where package_key = :package_key
+ }]
}
}
@@ -1371,10 +1371,10 @@
} {
uplevel 1 {
- db_1row apm_package_by_version_id {
- select pretty_name, version_name, package_key, installed_p, distribution_uri, tagged_p
- from apm_package_version_info where version_id = :version_id
- }
+ db_1row apm_package_by_version_id {
+ select pretty_name, version_name, package_key, installed_p, distribution_uri, tagged_p
+ from apm_package_version_info where version_id = :version_id
+ }
}
}
@@ -1409,8 +1409,8 @@
# Change all "-" to "_" to mimic our tcl standards
regsub -all {\-} $procedure_name "_" procedure_name
if { [info commands ::$procedure_name] eq "" } {
- # No such procedure exists...
- return ""
+ # No such procedure exists...
+ return ""
}
# Procedure exists
return $procedure_name
@@ -1427,16 +1427,16 @@
set package_id [ad_conn package_id]
}
db_transaction {
- db_dml app_rename {
- update apm_packages
- set instance_name = :instance_name
- where package_id = :package_id
- }
- db_dml rename_acs_object {
- update acs_objects
- set title = :instance_name
- where object_id = :package_id
- }
+ db_dml app_rename {
+ update apm_packages
+ set instance_name = :instance_name
+ where package_id = :package_id
+ }
+ db_dml rename_acs_object {
+ update acs_objects
+ set title = :instance_name
+ where object_id = :package_id
+ }
}
foreach node_id [db_list nodes_to_sync {}] {
site_node::update_cache -node_id $node_id
@@ -1549,9 +1549,9 @@
invocation are logged.
@param callback_proc if this is provided it is called
- instead of attempting to look up the proc via the package_key or version_id
- (needed for before-install callbacks since the db is not populated when those
- are called).
+ instead of attempting to look up the proc via the package_key or version_id
+ (needed for before-install callbacks since the db is not populated when those
+ are called).
@return 1 if invocation
was carried out successfully, 0 if no proc to invoke could
@@ -1736,9 +1736,9 @@
# that the ad_proc arg parser doesn't throw an error with
# test arg list
if { [catch {
- set args $test_arg_list
- ::${proc_name}__arg_parser
- } errmsg] } {
+ set args $test_arg_list
+ ::${proc_name}__arg_parser
+ } errmsg] } {
return 0
} else {
return 1
@@ -1757,30 +1757,30 @@
@param package_key The package_key of the package to instantiate.
@param instance_name The name of the package instance, defaults to the pretty name of the
- package type.
+ package type.
@param package_id The id of the new package. Optional.
@param context_id The context_id of the new package. Optional.
-
+
@return The id of the instantiated package
} {
if { $instance_name eq "" } {
- set p_name [apm::package_version::attributes::get_instance_name $package_key]
+ set p_name [apm::package_version::attributes::get_instance_name $package_key]
- if {$p_name eq ""} {
- set instance_name [db_string pretty_name_from_key {select pretty_name
- from apm_enabled_package_versions
- where package_key = :package_key}]
- } else {
- set instance_name "$p_name"
- }
+ if {$p_name eq ""} {
+ set instance_name [db_string pretty_name_from_key {select pretty_name
+ from apm_enabled_package_versions
+ where package_key = :package_key}]
+ } else {
+ set instance_name "$p_name"
+ }
}
if { $package_id eq "" } {
- set package_id [db_null]
+ set package_id [db_null]
}
set package_id [db_exec_plsql invoke_new {}]
-
+
apm_parameter_sync $package_key $package_id
foreach inherited_package_key [nsv_get apm_package_inherit_order $package_key] {
@@ -1802,16 +1802,16 @@
# Get all the parameter names and values for this package_id.
set names_and_values [db_list_of_lists apm_parameter_names_and_values {
- select parameter_name, attr_value
- from apm_parameters p, apm_parameter_values v, apm_packages a
- where p.parameter_id = v.parameter_id
- and a.package_id = v.package_id
- and a.package_id = :package_id
+ select parameter_name, attr_value
+ from apm_parameters p, apm_parameter_values v, apm_packages a
+ where p.parameter_id = v.parameter_id
+ and a.package_id = v.package_id
+ and a.package_id = :package_id
}]
# Put it in the cache.
- foreach name_value_pair $names_and_values {
- ad_parameter_cache -set [lindex $name_value_pair 1] $package_id [lindex $name_value_pair 0]
+ foreach name_value_pair $names_and_values {
+ ad_parameter_cache -set [lindex $name_value_pair 1] $package_id [lindex $name_value_pair 0]
}
}
@@ -1866,13 +1866,13 @@
# Now check what the provides clauses say
db_foreach installed_provides {
- select service_uri,
- service_version
- from apm_package_dependencies d,
- apm_package_versions v
- where d.dependency_type = 'provides'
- and d.version_id = v.version_id
- and v.enabled_p = 't'
+ select service_uri,
+ service_version
+ from apm_package_dependencies d,
+ apm_package_versions v
+ where d.dependency_type = 'provides'
+ and d.version_id = v.version_id
+ and v.enabled_p = 't'
} {
if { ![info exists installed_provides($service_uri)] || \
[apm_version_names_compare $installed_provides($service_uri) $service_version] == -1 } {
@@ -1908,7 +1908,7 @@
set html_string "