$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.
@@ -68,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] } - set file_function [expr {$include_data_model_files_p ? "apm_include_data_model_file_p" : "apm_include_file_p"}] + if {$all_p} { + set file_function "" + } else { + 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 set system_db_type [nsv_get ad_database_type .] set matching_files [list] foreach file $files { - set rel_path [string range $file [expr {[string length $package_path] + 1}] end] + set rel_path [string range $file [string length $package_path]+1 end] set file_type [apm_guess_file_type $package_key $rel_path] set file_db_type [apm_guess_db_type $package_key $rel_path] - set type_match_p [expr {$file_types eq "" || [lsearch $file_types $file_type] != -1}] + set type_match_p [expr {$file_types eq "" || $file_type in $file_types}] if { $all_db_types_p } { set db_match_p 1 @@ -293,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 "/"]
@@ -330,7 +318,7 @@
"ctl_file" eq $file_type } {
set sql_index [lsearch $components "sql"]
if { $sql_index >= 0 } {
- set db_dir [lindex $components [expr {$sql_index + 1}]]
+ set db_dir [lindex $components $sql_index+1]
if {$db_dir eq "common"} {
return ""
}
@@ -369,52 +357,64 @@
# We need to add that information back into the .info files.
set package_path [acs_package_root_dir $package_key]
- return [expr ![file exists "${package_path}/sql"] || [file exists "${package_path}/sql/[db_type]"]]
+ return [expr {![file exists "${package_path}/sql"] || [file exists "${package_path}/sql/[db_type]"]}]
}
-ad_proc -private apm_source { __file } {
+ad_proc -private apm_source { __file {errorVarName ""}} {
Sources $__file in a clean environment, returning 1 if successful or 0 if not.
Records that the file has been sourced and stores its mtime in the nsv array
apm_library_mtime
} {
+ if {$errorVarName ne ""} {
+ upvar $errorVarName errors
+ } else {
+ 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 }] } {
- global errorInfo
- ns_log "Error" "Error sourcing $__file:\n$errorInfo"
- return 0
+ 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
}
- nsv_set apm_library_mtime [ad_make_relative_path $__file] [file mtime $__file]
+ nsv_set apm_library_mtime $r_file [file mtime $__file]
return 1
}
# Special boot strap load file routine.
-ad_proc -private apm_bootstrap_load_file { root_directory file } {
+ad_proc -private apm_bootstrap_load_file { root_directory file {errorVarName ""}} {
Source a single file during initial bootstrapping and set APM data.
} {
ns_log "Notice" "Loading [file tail $root_directory]/$file"
-
- apm_source "${root_directory}/${file}"
+ if {$errorVarName ne ""} {upvar $errorVarName errors}
+ apm_source ${root_directory}/${file} errors
}
ad_proc -private apm_bootstrap_load_libraries {
{-load_tests:boolean 0}
{-init:boolean}
{-procs:boolean}
package_key
+ {errorVarName ""}
} {
Scan all the files in the tcl dir of the package and load those asked for by the init
and procs flags.
This proc is an analog of apm_load_libraries. In addition though
- this proc sets apm_first_time_loading_p nsv variable.
+ this proc sets apm_first_time_loading_p variable.
@author Don Baccus (dhogaza@pacifier.com)
@author Peter Marklund
@@ -433,16 +433,18 @@
if { $load_tests_p } {
lappend file_types test_procs
}
+ if {$errorVarName ne ""} {
+ upvar $errorVarName error
+ }
# This is the first time each of these files is being loaded (see
# the documentation for the apm_first_time_loading_p proc).
- global apm_first_time_loading_p
- set apm_first_time_loading_p 1
+ set ::apm_first_time_loading_p 1
set package_root_dir [acs_package_root_dir $package_key]
foreach file [apm_get_package_files -package_key $package_key -file_types $file_types] {
- apm_bootstrap_load_file $package_root_dir $file
+ apm_bootstrap_load_file $package_root_dir $file error
# Call db_release_unused_handles, only if the library defining it
# (10-database-procs.tcl) has been sourced yet.
@@ -451,25 +453,24 @@
}
}
- unset apm_first_time_loading_p
+ unset ::apm_first_time_loading_p
}
proc apm_bootstrap_load_queries { package_key } {
# Load up queries.
- set root_directory [nsv_get acs_properties root_directory]
set db_type [nsv_get ad_database_type .]
# 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 $root_directory/packages/$package_key]
+ set files [ad_find_all_files $::acs::rootdir/packages/$package_key]
if { [llength $files] == 0 } {
- error "Unable to locate $root_directory/packages/$package_key/*."
+ error "Unable to locate $::acs::rootdir/packages/$package_key/*."
}
foreach file [lsort $files] {
@@ -479,7 +480,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
}
}
}
@@ -507,7 +508,7 @@
@author Peter Marklund
} {
- return "[acs_root_dir]/install.xml"
+ return "$::acs::rootdir/install.xml"
}
ad_proc -private apm_ignore_file_p {
@@ -520,23 +521,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
#
@@ -589,3 +590,30 @@
#ns_log notice "apm_include_file_p <$filename> => [apm_ignore_file_p $filename]"
return [expr {![apm_ignore_file_p $filename]}]
}
+
+ad_proc apm_bootstrap_upgrade {
+ {-from_version_name:required}
+ {-to_version_name:required}
+} {
+
+ Copy the files from acs-bootstrap-installer/installer/tcl to the
+ Tcl files in the acs root directory. This makes it possible to
+ incorporate changes to these files by only updating the
+ acs-bootstrap-installer package (rather than a full tar file
+ install as in eralier versions).
+
+ Caveat: don't modify these files in your local installation, addin
+ extra files to $::acs::rootdir/tcl is fine.
+} {
+ set source $::acs::rootdir/packages/acs-bootstrap-installer/installer/tcl
+ foreach file [glob -nocomplain $source/*tcl] {
+ file copy -force $file $::acs::rootdir/tcl
+ }
+}
+
+#
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 4
+# indent-tabs-mode: nil
+# End: