Index: openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl 25 Feb 2003 16:48:08 -0000 1.14
+++ openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl 10 Mar 2003 14:04:26 -0000 1.15
@@ -66,6 +66,8 @@
found only in the bootstrap installer).
Files with extension .xml
in the directory catalog are
considered message catalog files.
+ Tcl procs or init files in a test directory are of type test_procs and test_init
+ respectively.
Rules are applied in this order (stopping with the first match).
@@ -94,7 +96,7 @@
if { [string equal $extension ".sql"] } {
if { [lsearch -glob $components "*upgrade-*-*"] >= 0 } {
set type "data_model_upgrade"
- } elseif { [regexp -- "$package_key-(create|drop)\.sql" [file tail $path] "" kind] } {
+ } elseif { [regexp -- "^$package_key-(create|drop)\.sql\$" [file tail $path] "" kind] } {
set type "data_model_$kind"
} else {
set type "data_model"
@@ -129,7 +131,11 @@
set type "content_page"
} elseif { [string equal $extension ".tcl"] } {
if { [regexp -- {-(procs|init)(-[0-9a-zA-Z]*)?\.tcl$} [file tail $path] "" kind] } {
- set type "tcl_$kind"
+ if { [string equal [lindex $components end-1] test] } {
+ set type "test_$kind"
+ } else {
+ set type "tcl_$kind"
+ }
} else {
set type "tcl_util"
}
@@ -141,6 +147,7 @@
}
ad_proc -public apm_get_package_files {
+ {-all_db_types:boolean}
{-package_key:required}
{-file_types {}}
} {
@@ -178,7 +185,11 @@
set file_db_type [apm_guess_db_type $package_key $rel_path]
set type_match_p [expr [empty_string_p $file_types] || [lsearch $file_types $file_type] != -1]
- set db_match_p [expr [empty_string_p $file_db_type] || [string equal $file_db_type [db_type]]]
+ if { $all_db_types_p } {
+ set db_match_p 1
+ } else {
+ set db_match_p [expr [empty_string_p $file_db_type] || [string equal $file_db_type [db_type]]]
+ }
if { $type_match_p && $db_match_p } {
lappend matching_files $rel_path
@@ -274,8 +285,8 @@
2. Other files.
- If the file name contains a dash and database type, the file is assumed to be
- specific to that database type.
+ If it is a tcl or xql file 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.
@@ -298,14 +309,43 @@
set file_name [file tail $path]
foreach known_database_type [nsv_get ad_known_database_types .] {
- if { [string match "*-[lindex $known_database_type 0]\.*" $file_name] } {
+ if { [regexp -- "\-[lindex $known_database_type 0]\.(xql|tcl)\$" $file_name match] } {
return [lindex $known_database_type 0]
}
}
return ""
}
+ad_proc apm_package_supports_rdbms_p {
+ {-package_key:required}
+} {
+ Returns 1 if the given package supports the rdbms of the system and 0 otherwise.
+ The package is considedered to support the given rdbms if there is at least one
+ file in the package of matching db_type, or if there are no files in the package
+ of a certain db type.
+
+ @author Peter Marklund
+} {
+ set system_db_type [db_type]
+
+ set has_db_types_p 0
+
+ foreach file [apm_get_package_files -all_db_types -package_key $package_key] {
+ set db_type [apm_guess_db_type $package_key $file]
+ ns_log Notice "pm debug $file db type $db_type"
+ if { ![empty_string_p $db_type] } {
+ set has_db_types_p 1
+ }
+
+ if { [string equal $system_db_type $db_type] } {
+ return 1
+ }
+ }
+
+ return [expr ! $has_db_types_p]
+}
+
ad_proc apm_source { __file } {
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