Index: openacs-4/packages/acs-tcl/tcl/install-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/install-procs.tcl,v
diff -u -r1.26 -r1.27
--- openacs-4/packages/acs-tcl/tcl/install-procs.tcl	3 Dec 2008 12:12:00 -0000	1.26
+++ openacs-4/packages/acs-tcl/tcl/install-procs.tcl	4 Dec 2008 16:04:19 -0000	1.27
@@ -899,6 +899,105 @@
     return $parent_id
 }
 
+ad_proc -private ::install::xml::action::call-tcl-proc { node } {
+
+    Call an arbitrary Tcl library procedure.
+
+    Parameters which have a name are called using the "-param" syntax. If there's
+    no name given, the value is passed directly as a positional parameter.  It is the
+    user's responsibility to list all named parameters before any positional parameter
+    (as is necessary if the proc is declared using ad_proc).
+
+    If a named parameter has an XML attribute declaring its type to be boolean, and the
+    value is blank, the switch is passed without a value.  Otherwise, the boolparam=value
+    syntax is used.
+
+    You can cheat and use this to execute arbitrary Tcl code if you dare, since Tcl
+    commands are just procs ...
+
+    @author Don Baccus donb@pacifier.com
+    @creation-date 2008-12-04
+
+} {
+    set cmd [list [apm_required_attribute_value $node name]]
+
+    set params [xml_node_get_children [lindex $node 0]]
+    foreach param $params {
+        if {[xml_node_get_name $param] ne "param"} {
+            error "Unknown xml element \"[xml_node_get_name $param]\""
+        }
+
+        set name [apm_attribute_value -default {} $param name]
+        set id [apm_attribute_value -default {} $param id]
+        set value [apm_attribute_value -default {} $param value]
+        set type [apm_attribute_value -default {} $param type]
+
+        if {$id ne ""} {
+            set value [install::xml::util::get_id $id]
+        }
+
+        if { $name ne "" && $type eq "boolean" } {
+            if { $value ne "" } {
+                lappend cmd -${name}=$value
+            } else {
+                lappend cmd -$name
+            }
+        } else {
+            if { $name ne "" } {
+                lappend cmd -$name
+            }
+            lappend cmd $value
+        }
+    }
+
+    set result [eval $cmd]
+    set id [apm_attribute_value -default "" $node id]
+    if {$id ne ""} {
+        set ::install::xml::ids($id) $result
+    }
+    return
+}
+
+
+ad_proc -private ::install::xml::action::instantiate-object { node } {
+
+    Instantiate an object using package_instantiate_object.  This will work
+    for both PostgreSQL and Oracle if the proper object package and new()
+    function have been defined.
+    
+    @author Don Baccus donb@pacifier.com
+    @creation-date 2008-12-04
+
+} {
+    set type [apm_required_attribute_value $node type]
+
+    set params [xml_node_get_children [lindex $node 0]]
+    set var_list {}
+    foreach param $params {
+        if {[xml_node_get_name $param] ne "param"} {
+            error "Unknown xml element \"[xml_node_get_name $param]\""
+        }
+
+        set name [apm_required_attribute_value $param name]
+        set id [apm_attribute_value -default {} $param id]
+        set value [apm_attribute_value -default {} $param value]
+
+        if {$id ne ""} {
+            set value [install::xml::util::get_id $id]
+        }
+
+        lappend var_list [list $name $value]
+    }
+
+    set object_id [package_instantiate_object -var_list $var_list $type]
+
+    set id [apm_attribute_value -default "" $node id]
+    if {$id ne ""} {
+        set ::install::xml::ids($id) $object_id
+    }
+    return
+}
+
 ad_proc -public install::xml::object_id::package { node } {
     Returns an object_id for a package specified in node.