+ NOTE: This proc doesn't do anything anymore. +
+ ++ Loads XML packages into the running interpreter, if they're not + already there. We need to load these packages once per connection, + since AOLserver doesn't seem to deal with packages very well. +
+ +} { + global ad_conn + if { ![info exists ad_conn(xml_loaded_p)] } { + # ns_xml needs to be loaded + +# foreach file [glob "[acs_package_root_dir acs-tcl]/tcl/xml-*-procs.tcl"] { +# apm_source $file +# } + set ad_conn(xml_loaded_p) 1 + } + +# package require xml 1.9 +} + ad_proc -private apm_required_attribute_value { element attribute } { Returns an attribute of an XML element, throwing an error if the attribute @@ -68,15 +94,12 @@ Generates an XML-formatted specification for a version of a package. } { - set spec "" - db_1row package_version_select { - select t.package_key, t.package_uri, t.pretty_name, t.pretty_plural, t.package_type, - t.initial_install_p, t.singleton_p, v.* - from apm_package_versions v, apm_package_types t - where v.version_id = :version_id - and v.package_key = t.package_key - } + set spec {} + + db_1row package_version_select {} + apm_log APMDebug "APM: Writing Package Specification for $pretty_name $version_name" + set auto_mount_tag [ad_decode $auto_mount "" "" "files: a list of files in the package,
containing elements of the form [list $path
$type]
+ callbacks: an array list of callbacks of the package
+ on the form [list callback_type1 proc_name1 callback_type2 proc_name2 ...]
Element and attribute values directly from the XML specification:
package.key,
package.url,
package.type
pretty-plural
initial-install-p
singleton-p
+ auto-mount
name (the version name, e.g., 3.3a1,
url (the version URL),
package-name,
@@ -296,6 +311,7 @@
set properties(package-name) [apm_tag_value $package package-name]
set properties(initial-install-p) [apm_tag_value -default "f" $package initial-install-p]
set properties(singleton-p) [apm_tag_value -default "f" $package singleton-p]
+ set properties(auto-mount) [apm_tag_value -default "" $package auto-mount]
set properties(pretty-plural) [apm_tag_value -default "$properties(package-name)s" $package pretty-plural]
@@ -383,7 +399,7 @@
# Validate the file type: it must be null (unknown type) or
# some value in [apm_file_type_keys].
if { ![empty_string_p $type] && [lsearch -exact [apm_file_type_keys] $type] < 0 } {
- error "Invalid file type \"$type\""
+ ns_log Warning "Unrecognized file type \"$type\" of file $file_path"
}
# Validate the database type: it must be null (unknown type) or
# some value in [apm_db_type_keys].
@@ -394,6 +410,38 @@
}
}
+ # Build a list of package callbacks
+ array set callback_array {}
+
+ set callbacks_node_list [xml_node_get_children_by_name $version callbacks]
+
+ foreach callbacks_node $callbacks_node_list {
+
+ set callback_node_list [xml_node_get_children_by_name $callbacks_node callback]
+ foreach callback_node $callback_node_list {
+
+ set type [apm_attribute_value $callback_node type]
+ set proc [apm_attribute_value $callback_node proc]
+
+ if { [llength [array get callback_array $type]] != 0 } {
+ # A callback proc of this type already found in the xml file
+ ns_log Error "package info file $path contains more than one callback proc of type $type"
+ continue
+ }
+
+ if { [lsearch -exact [apm_supported_callback_types] $type] < 0 } {
+ # The callback type is not supported
+ ns_log Error "package info file $path contains an unsupported callback type $type - ignoring. Valid values are [apm_supported_callback_types]"
+ continue
+ }
+
+ set callback_array($type) $proc
+ }
+ }
+
+ set properties(callbacks) [array get callback_array]
+
+
# Build a list of the package's owners (if any).
set properties(owners) [list]