Index: openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl,v
diff -u -r1.37 -r1.38
--- openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl	20 Sep 2007 12:05:34 -0000	1.37
+++ openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl	24 Sep 2007 12:04:26 -0000	1.38
@@ -409,6 +409,7 @@
     $r db_1row dbq..get_instance [$class fetch_query $id]
     $r set object_id $id
     $r destroy_on_cleanup
+    $r initialize_loaded_object
     return $r
   }
 
@@ -816,10 +817,12 @@
     my check_table_atts
 
     # The default supertype is acs_object. If the supertype
-    # was not changed, we map the class to the object_type. 
-    if {$supertype ne "acs_object"} {
-      set supertype [my class_to_object_type [my info superclass]]
+    # was not changed (still acs_object), we map the superclass 
+    # to the object_type to obtain the ACS supertype.
+    if {$supertype eq "acs_object"} {
+      set supertype [::xo::db::Class class_to_object_type [my info superclass]]
     }
+
     if {![info exists pretty_name]}   {set pretty_name [namespace tail [self]]}
     if {![info exists pretty_plural]} {set pretty_plural $pretty_name}
 
@@ -1035,6 +1038,10 @@
   }
 
   ::xo::db::Class instproc initialize_acs_object {obj id} {
+    #
+    # This method is called, whenever a new (fresh) object with
+    # a new object_id is created.
+    #
     $obj set object_id $id
     # construct the same object_title as acs_object.new() does
     $obj set object_title "[my pretty_name] $id"
@@ -1082,35 +1089,68 @@
     {-dbn ""}
     {-sql ""}
     {-full_statement_name ""}
+    {-as_order_composite:boolean true}
+    {-object_class "::xotcl::Object"}
+    {-named_objects:boolean false}
+    {-destroy_on_cleanup:boolean true}
   } {
-    Return a set of objects where each object is a tuple of the
-    answer-set of the SQL query. This method creates 
-    plain objects of the type of the specified class 
-    (default ::xotcl::Object) containing the variables that
-    the SQL query returns.
 
-    The container and contained objects are automatically 
-    destroyed on cleanup of the connection thread.
+    Retrieve multiple objects from the database using the given SQL
+    query and create XOTcl objects from the tuples. 
+
+    @param sql The SQL query to retrieve tuples. Note that if the SQL
+    query only returns a restricted set of attributes, the objects will
+    be only partially instantiated.
+
+    @param as_ordered_composite return an ordered composite object
+    preserving the order. If the flag is calse, one has to use
+    "info instances" to access the resulted objects.
+
+    @param object_class specifies the XOTcl class, for which instances
+    are created.
+
+    @named_objects If this flag is true, the value of the id_column is used
+    for the name of the created objects (object will be named
+    e.g. ::13738). Otherwise, objects are created with the XOTcl "new"
+    method to avoid object name clashes.
+
+    @destroy_on_cleanup If this flag is true, the objects (and ordered
+    composite) will be automatically destroyed on cleaup (typically
+    after the request was processed).
   } {
-    set __result [::xo::OrderedComposite new -destroy_on_cleanup]
-    #$__result proc destroy {} {my log "-- "; next}
+    if {$object_class eq ""} {set object_class [self]}
+    if {$as_order_composite} {
+      set __result [::xo::OrderedComposite new]
+      if {$destroy_on_cleanup} {$__result destroy_on_cleanup}
+    } else {
+      set __result ""
+    }
 
     db_with_handle -dbn $dbn db {
       set selection [db_exec select $db $full_statement_name $sql]
       while {1} {
         set continue [ns_db getrow $db $selection]
         if {!$continue} break
-        set o [::xotcl::Object new]
+        if {$named_objects} {
+          set object_name ::[ns_set get $selection [my id_column]]
+          set o [$object_class create $object_name]
+        } else {
+          set o [$object_class new]
+        }
+        if {$as_order_composite} {
+          $__result add $o
+        } elseif {$destroy_on_cleanup} {
+          $o destroy_on_cleanup
+        }
         foreach {att val} [ns_set array $selection] {$o set $att $val}
-
         if {[$o exists object_type]} {
-          # set the object type if it looks like from xotcl
+          # set the object type if it looks like managed from XOTcl
           if {[string match "::*" [set ot [$o set object_type]] ]} {
             $o class $ot
           }
         }
+        $o initialize_loaded_object
         #my log "--DB more = $continue [$o serialize]" 
-        $__result add $o
       }
     }
     return $__result
@@ -1282,6 +1322,14 @@
     return $id
   }
 
+  ::xo::db::Object instproc initialize_loaded_object {} {
+    #
+    # This method is to be called, after an existing
+    # object is fetched from the database.
+    #
+    # empty body, to be refined
+  }
+
   ##############
   ::xotcl::Class create ::xo::db::Attribute \
       -superclass {::xo::Attribute} \
Index: openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl	24 Sep 2007 12:04:26 -0000	1.1
@@ -0,0 +1,173 @@
+ad_library {
+  Definition of a package manager for creating XOTcl package objects
+  
+  @author Gustaf Neumann (neumann@wu-wien.ac.at)
+  @creation-date 2007-09-24
+  @cvs-id $Id: 06-package-procs.tcl,v 1.1 2007/09/24 12:04:26 gustafn Exp $
+}
+
+namespace eval ::xo {
+  #
+  # Meta-Class for Application Package Classes
+  #
+
+  Class create ::xo::PackageMgr \
+      -superclass ::xo::db::Class \
+      -parameter {
+        package_key
+      }
+
+  PackageMgr ad_instproc instances {{-include_unmounted false}} {
+    @return list of package_ids of xowiki instances
+  } {
+    my instvar package_key
+    if {$include_unmounted} {
+      return [db_list [my qn get_xowiki_packages] {select package_id \
+        from apm_packages where package_key = :package_key}]
+    } else {
+      return [db_list [my qn get_mounted_packages] {select package_id \
+        from apm_packages p, site_nodes s  \
+        where package_key = :package_key and s.object_id = p.package_id}]
+    }
+  }
+
+  PackageMgr ad_instproc initialize {
+    -ad_doc
+    {-parameter ""}
+    {-package_id 0}
+    {-url ""}
+    {-user_id -1}
+    {-actual_query " "}
+    {-init_url true}
+    {-form_parameter}
+  } {
+    Create a connection context if there is none available.
+    The connection context should be reclaimed after the request
+    so we create it as a volatile object in the toplevel scope,
+    it will be destroyed automatically with destroy_on_cleanup, 
+    when the global variables are reclaimed.
+    
+    As a side effect this method sets in the calling context
+    the query parameters and package_id as variables, using the 
+    "defaults" for default values.
+
+    init_url false requires the package_id to be specified and
+    a call to Package instproc set_url to complete initialization
+  } {
+    #my log "--i [self args], URL=$url, init_url=$init_url"
+
+    if {$url eq "" && $init_url} {
+      #set url [ns_conn url]
+      #my log "--CONN ns_conn url"
+      set url [root_of_host [ad_host]][ns_conn url]
+    }
+    #my log "--cc actual_query = <$actual_query>"
+
+    # require connection context
+    ConnectionContext require \
+	-package_id $package_id -user_id $user_id \
+	-parameter $parameter -url $url -actual_query $actual_query
+    set package_id [::xo::cc package_id]
+    if {[info exists form_parameter]} {
+      ::xo::cc array set form_parameter $form_parameter
+    }
+
+    # create package object if necessary
+    my require -url $url $package_id
+    ::xo::cc export_vars -level 2
+  }
+
+  PackageMgr ad_instproc require {{-url ""} package_id} {
+    Create package object if needed.
+  } {
+    #my log "--R $package_id exists? [my isobject ::$package_id]"
+    if {![my isobject ::$package_id]} {
+      #my log "--R we have to create ::$package_id //url='$url'"
+      if {$url ne ""} {
+        my create ::$package_id -url $url
+      } else {
+        my create ::$package_id
+      }
+      ::$package_id destroy_on_cleanup
+    } else {
+      if {$url ne ""} {
+        ::$package_id set_url -url $url
+      }
+    }
+  }
+
+  #
+  # generic Package class
+  #
+  # get apm_package class  #### missing in acs_attributes: instance_name, default_locale
+  #::xo::db::Class get_class_from_db -object_type apm_package
+ 
+  #ns_log notice [::xo::db::apm_package serialize]
+  #ns_log notice =======================================
+
+  PackageMgr create ::xo::Package \
+      -superclass ::xo::db::Object \
+      -table_name apm_packages -id_column package_id \
+      -object_type apm_package -package_key apm_package \
+      -slots {
+        ::xo::db::Attribute create package_key -datatype string -sqltype varchar(100)
+        ::xo::db::Attribute create instance_name -datatype string -sqltype varchar(300)
+        ::xo::db::Attribute create default_locale -datatype string -sqltype varchar(30)
+      } \
+      -parameter {
+        id
+        url 
+        {context ::xo::cc}
+        package_url
+      }
+  ::xo::Package instforward query_parameter        {%my set context} %proc
+  ::xo::Package instforward exists_query_parameter {%my set context} %proc
+  ::xo::Package instforward form_parameter         {%my set context} %proc
+  ::xo::Package instforward exists_form_parameter  {%my set context} %proc
+  ::xo::Package instforward returnredirect         {%my set context} %proc
+
+  ::xo::Package instproc get_parameter {attribute {default ""}} {
+    set param [::xo::parameter get \
+                -parameter $attribute \
+                -package_id [my id] \
+                -default $default]
+    #my log "--get_parameter <$attribute> <$default> returned $param"
+    return $param
+  }
+ 
+  ::xo::Package instproc init args {
+    #my log "--R creating"
+    my instvar id url
+    set id [namespace tail [self]]
+    array set info [site_node::get_from_object_id -object_id $id]
+    set package_url $info(url)
+    if {[ns_conn isconnected]} {
+      # in case of of host-node map, simplify the url to avoid redirects
+      # .... but ad_host works only, when we are connected.... TODO: solution for syndication
+      set root [root_of_host [ad_host]]
+      regexp "^${root}(.*)$" $package_url _ package_url
+    }
+    #my log "--R package_url= $package_url (was $info(url))"
+    my package_url $package_url
+    my package_key $info(package_key)
+    my instance_name $info(instance_name)
+    if {[my exists url] && [info exists root]} {
+      regexp "^${root}(.*)$" $url _ url
+    } else {
+      my log "--R we have no url, use package_url"
+      # if we have no more information, we use the package_url as actual url
+      set url $package_url
+    } 
+    my set_url -url $url
+  }
+ 
+  ::xo::Package instproc set_url {-url} {
+    my url $url
+    my set object [string range [my url] [string length [my package_url]] end]
+    #my log "--R object set to [my set object], [my serialize]"
+  }
+
+ 
+  #ns_log notice [::xo::Package serialize]
+
+}
\ No newline at end of file
Index: openacs-4/packages/xotcl-core/tcl/06-param-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/06-param-procs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/xotcl-core/tcl/06-param-procs.tcl	24 Sep 2007 12:04:26 -0000	1.1
@@ -0,0 +1,311 @@
+# Motivations: 
+#
+#  - Huge number of parameter_values in larger dotlrn installations
+#    Learn: currently > 0.3 mio entries, 
+#    gallileo: > 2mio (2nd largest kind of object type)
+#    Small oacs installation: 1000 objects (38 package instances)
+#
+#  - High growth, when parmeters are used more intensively
+#    Size: #package-key * #parameter * #package_instances
+#    -> does not scale well.
+#
+# - High degree of redundancy:
+#   Most parameters are stored multiple times with the same values
+#   (e.g. most dotlrn parameters > 4000 times on dotlrn; cause:
+#   Cause: high number of communities.
+#  
+#   Do we really need to store 4000 times what the pretty-plural 
+#   string is one and the same string?
+#
+# - Most parameter_values are identical to default values
+#   For 1 parameter in learn, we have 8 different values, for
+#   4 parameters we have 3 different values, ... for most, 
+#   all values are the same
+#
+# - Huge improvements, when redundancy is removed.
+#   Learn: from 300000 entries -> 406 necessary entries
+#   Small oacs installation: 1000 objects -> 256 necessary entries
+#   => especially big savings on larger installations.
+#
+# Other shortcomings:
+# 
+# - Existent design is 2 level: 
+#     package-key provides default
+#     package-instance keeps values (materialized cross-product)
+#
+# - Consquences
+#   1) Since default values are copied into
+#      per-package-instance-values altering the default has no
+#      immediate effect.  It would be nice to alter in an openacs
+#      installation e.g. the default-values for all forums for a
+#      certain parameter, and that this value is used in cases, where
+#      the admin has not changed the package parameters
+#
+#   2) No inheritance between packages is possible.  It would be nice
+#      to define derived packages (such as e.g. s5 derived from
+#      xowiki) where the parameters do not have to be duplicated
+#      (e.g. a new parameter added to xowiki should be available in
+#      the s5 package as well, otherwise code reuese is limited)
+#
+# ======================================================================
+#
+# The implementation below addressed these issues (i.e. is much more
+# flexible) and is substantially faster (current implementation):
+#      parameter get_from_package_key   old: 172.92 new: 32.16 (5x)
+#      parameter get                    old: 63.09 new: 31.29 (2x)
+#      
+# The implementation uses the OpenACS datamodel (apm_packages, 
+# apm_package_values) and loads the parameters during startup.
+#
+# Missing: 
+#   - definition of new parameters (based on ::xo::db interface)
+#   - changing of per-package-key values
+#   - user interface 
+#   - alternate permissions for changing/deleting per-package-instance and
+#     per-package-key values (simple approach: use swa for the latter)
+#
+# ======================================================================
+#
+# Illustrative example for lookup logic
+#
+# Package class hierarchy
+#
+#   ::xo::Package (apm_package)
+#      <- ::xowiki::Package
+#           <- ::s5::Package
+#   
+#   package_parameter: 
+#       parameter_id  package_key  parameter_name         default_value
+#        835          xowiki       with_yahoo_publisher     0
+#       2071          s5           with_yahoo_publisher     0
+#
+#   apm_packages:
+#       package_id  parameter_id  attr_value
+#       2075        2071          0
+#
+# Lookup for package_id=2075 "with_yahoo_publisher"
+#   1) lookup parameter_id for "with_yahoo_publisher" from s5 (::s5::Package)
+#      1.1) parameter_id exists for s5 => parameter_id=2071
+#           lookup value for parameter_id=2071,package_id=2075 
+#           1.1.1) value for parameter=2071 and package_id=2075 exists 
+#                  => return value
+#           1.1.2) value for parameter=2071 and package_id=2075 does not exist 
+#                  => return default value for parameter and package_key=s5
+#      1.2) no parameter_id for s5 + "with_yahoo_publisher"
+#           search for parameter_id in superclasses ...
+#
+#   2) lookup parameter_id for "with_yahoo_publisher" from superclass
+#      2.1) parameter_id exists for xowiki => parameter_id=835
+#           lookup value for parameter_id=835,package_id=2075 
+#           2.1.1) value for parameter=835 and package_id=2075 exists 
+#                  => return value
+#           2.1.2) value for parameter=835 and package_id=2075 does not exist 
+#                  => return default value for parameter and package_key=xowiki
+#      2.2) no parameter_id for xowiki + "with_yahoo_publisher"
+#           search for parameter_id in superclasses ...
+
+namespace eval ::xo {
+
+  Class create ::xo::parameter
+  
+  # Every OpenACS parameter should work with the methods defined here.
+  # So, fetch first the apm_parameter class from the definitions
+  # in the database, and ...
+  ::xo::db::Class get_class_from_db -object_type apm_parameter
+
+  # ... add the methods of ::xo::parameter by adding this as a mixin
+  ::xo::db::apm_parameter instmixin parameter
+
+  #
+  # Methods on the parameter class object
+  #
+  parameter proc get_package_key_from_id {
+    -package_id:required
+  } {
+    return [ns_cache eval xotcl_object_type_cache package_key-$package_id {
+      db_string get_package_key "select package_key from apm_packages where package_id = $package_id"
+    }]
+  }
+  parameter proc get_package_id_from_package_key {
+    -package_key:required
+  } {
+    return [ns_cache eval xotcl_object_type_cache package_id-$package_key {
+      db_string get_package_id "select package_id from apm_packages where package_key = :package_key"
+    }]
+  }
+
+  parameter proc get_package_class_from_package_key {-package_key:required} {
+    # Look up the parameter class from a package_key.
+    # TODO: should be done from object_type of package_id, 
+    # but first, we have to store it there).  
+    # We simply iterate here of the classes of packages (only a few exist).
+    set r ""
+    while {1} {
+      set r [ns_cache eval xotcl_object_type_cache package_class-$package_key {
+        foreach p [::xo::PackageMgr info instances] {
+          if {[$p set package_key] eq $package_key} { return $p }
+        }
+        break; # don't cache
+      }]
+      break
+    }
+    return $r
+  }
+
+  parameter proc get_parameter_object {
+    -parameter_name:required
+    -package_id
+    -package_key
+  } {
+    ::xo::PackageMgr instvar package_class
+    if {![info exists package_key]} {
+      set package_key [my get_package_key_from_id -package_id $package_id]
+    }
+    while {$package_key ne ""} {
+      set key Parameter_id($package_key,$parameter_name)
+      if {[my exists $key]} {
+        return [my set $key]
+      }
+      # 
+      # We did not find the parameter object for the current package
+      # key. Loop up the parameter class (TODO: should be done from
+      # object_type of package_id, but first, we have to store it
+      # there).  We simply iterate here of the classes of packages
+      # (only a few exist).
+      # 
+      #my log "--p looking for $parameter_name in superclass of package_key=$package_key"
+      set success 0
+      set pkg_class [my get_package_class_from_package_key -package_key $package_key]
+      if {$pkg_class ne ""} {
+        set sc [$pkg_class info superclass]
+        if {[$sc exists package_key]} {
+          set package_key [$sc package_key]
+          set success 1
+          #my log "--p new package_key=$package_key"
+        }
+      }
+      if {!$success} break
+    }
+    return ""
+  }
+
+  parameter proc get_from_package_key {
+    -package_key:required
+    -parameter:required
+    -default
+  } {
+    set parameter_obj [my get_parameter_object -package_key $package_key -parameter_name $parameter]
+    if {$parameter_obj eq ""} {
+      if {[info exists default]} {return $default}
+      error "No parameter '$parameter' for package_key '$package_key' defined"
+    }
+    set package_id [my get_package_id_from_package_key -package_key $package_key]
+    set value [$parameter_obj get -package_id $package_id]
+    if {$value eq ""} {return $default}
+    return $value
+  }
+
+  parameter proc get {
+    -package_id:required
+    -parameter:required
+    -default
+  } {
+    set parameter_obj [my get_parameter_object -parameter_name $parameter -package_id $package_id]
+    if {$parameter_obj eq ""} {
+      if {[info exists default]} {return $default}
+      error "No parameter '$parameter' for package_id '$package_id' defined"
+    }
+    set value [$parameter_obj get -package_id $package_id]
+    if {$value eq ""} {return $default}
+    return $value
+  }
+  
+  #
+  # Methods for parameter instances
+  #
+  parameter instproc set_per_package_instance_value {package_id value} {
+    set array [my per_package_id_name $package_id]
+    nsv_set $array [my parameter_name] $value
+  }
+  parameter instproc initialize_loaded_object {} {
+    my instvar package_key parameter_name
+    [self class] set Parameter_id($package_key,$parameter_name) [self]
+  }
+  parameter instproc per_package_id_name {package_id} {
+    return "CFG-$package_id"
+  }
+  #   parameter instproc per_package_class_name {package_class} {
+  #     return "CFG-$package_class"
+  #   }
+  parameter instproc get {-package_id:required} {
+    set key [my parameter_name]
+    set nsv_array_name [my per_package_id_name $package_id]
+    if {[nsv_exists $nsv_array_name $key]} {
+      #my log "--parameter get <$key> from $nsv_array_name --> '[nsv_get $nsv_array_name $key]'"
+      return [nsv_get $nsv_array_name $key]
+    }
+    # We could as well store per-package-key values,
+    # but most probably, this is not needed if we use
+    # the parameter default (which is per package-key).
+    # With additional  per-package-key values, we could implement
+    # a very simple "reset to default" for package-key values.
+    #
+    #     foreach cls $package_class_hierarchy {
+    #       set nsv_array_name [my per_package_class_name $cls]
+    #       if {[nsv_exists $nsv_array_name $key]} {
+    #         #my log "--parameter get <$key> from $nsv_array_name --> '[nsv_get $nsv_array_name $key]'"
+    #         return [nsv_get $nsv_array_name $key]
+    #       }
+    #     }
+    #
+    #my log "--parameter get <$key> from default of [my package_key] --> '[my default_value]'"
+    return [my default_value]
+  }
+
+  # get apm_parameter objects
+  ::xo::db::apm_parameter instantiate_objects \
+      -sql [::xo::db::apm_parameter instance_select_query] \
+      -object_class ::xo::db::apm_parameter \
+      -as_order_composite false -named_objects true -destroy_on_cleanup false
+  ns_log notice "--p got [llength [::xo::db::apm_parameter info instances]] parameters"
+  #foreach p [::xo::db::apm_parameter info instances] { ns_log notice [$p serialize] }
+
+  parameter proc initialize_parameters {} {
+    # Get those parameter values, which are different from the default and
+    # remember theses per package_id.
+    db_foreach get_non_default_values {
+      select p.parameter_id, p.package_key, v.package_id, p.parameter_name, 
+             p.default_value, v.attr_value 
+      from apm_parameters p, apm_parameter_values v 
+      where p.parameter_id = v.parameter_id and attr_value <> p.default_value
+    } {
+      ns_log notice "--p $parameter_id $package_key $package_id $parameter_name <$attr_value>"
+      $parameter_id set_per_package_instance_value $package_id $attr_value
+    }
+  }
+
+  parameter initialize_parameters
+  #
+  #  A few test cases
+  #
+#   ns_log notice "xotcl-request-monitor.max-url-stats=[parameter get_from_package_key \
+#       -package_key xotcl-request-monitor \
+#       -parameter max-url-stats]"
+
+#   set cmd1 "::parameter::get_from_package_key \
+#       -package_key xotcl-request-monitor \
+#       -parameter max-url-stats"
+#   set cmd2 "parameter get_from_package_key \
+#       -package_key xotcl-request-monitor \
+#       -parameter max-url-stats"
+#   ns_log notice "GET_PACKAGE_KEY old: [time $cmd1 100], new: [time $cmd2 100]"
+
+#   set pid 4906
+#   set pname trend-elements 
+#   ns_log notice "xotcl-request-monitor.$pname=[parameter get \
+#       -package_id $pid -parameter $pname]"
+#   set cmd1 "::parameter::get -package_id $pid -parameter $pname"
+#   set cmd2 "parameter get -package_id $pid -parameter $pname"
+#   ns_log notice "GET old: [time $cmd1 100], new: [time $cmd2 100]"
+
+}
\ No newline at end of file
Index: openacs-4/packages/xotcl-core/tcl/cluster-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/cluster-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/xotcl-core/tcl/cluster-procs.tcl	20 Sep 2007 11:57:04 -0000	1.1
+++ openacs-4/packages/xotcl-core/tcl/cluster-procs.tcl	24 Sep 2007 12:04:26 -0000	1.2
@@ -59,7 +59,7 @@
     set cmd [ns_queryget cmd]
     set addr [lindex [ns_set iget [ns_conn headers] x-forwarded-for] end]
     if {$addr eq ""} {set addr [ns_conn peeraddr]}
-    ns_log notice "--cluster got cmd='$cmd' from $addr"
+    #ns_log notice "--cluster got cmd='$cmd' from $addr"
     if {[catch {set result [::xo::Cluster execute [ns_conn peeraddr] $cmd]} errorMsg]} {
       ns_log notice "--cluster error: $errorMsg"
       ns_return 417 text/plain $errorMsg
Index: openacs-4/packages/xotcl-core/tcl/context-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/context-procs.tcl,v
diff -u -r1.23 -r1.24
--- openacs-4/packages/xotcl-core/tcl/context-procs.tcl	4 Sep 2007 11:31:18 -0000	1.23
+++ openacs-4/packages/xotcl-core/tcl/context-procs.tcl	24 Sep 2007 12:04:26 -0000	1.24
@@ -339,152 +339,5 @@
   }
 
 
-  #
-  # Meta-Class for Application Package Classes
-  #
 
-  Class PackageMgr -superclass Class -parameter {
-    package_key
-  }
-
-  PackageMgr ad_instproc instances {{-include_unmounted false}} {
-    @return list of package_ids of xowiki instances
-  } {
-    my instvar package_key
-    if {$include_unmounted} {
-      return [db_list [my qn get_xowiki_packages] {select package_id \
-        from apm_packages where package_key = :package_key}]
-    } else {
-      return [db_list [my qn get_mounted_packages] {select package_id \
-        from apm_packages p, site_nodes s  \
-        where package_key = :package_key and s.object_id = p.package_id}]
-    }
-  }
-
-  PackageMgr ad_instproc initialize {
-    -ad_doc
-    {-parameter ""}
-    {-package_id 0}
-    {-url ""}
-    {-user_id -1}
-    {-actual_query " "}
-    {-init_url true}
-    {-form_parameter}
-  } {
-    Create a connection context if there is none available.
-    The connection context should be reclaimed after the request
-    so we create it as a volatile object in the toplevel scope,
-    it will be destroyed automatically with destroy_on_cleanup, 
-    when the global variables are reclaimed.
-    
-    As a side effect this method sets in the calling context
-    the query parameters and package_id as variables, using the 
-    "defaults" for default values.
-
-    init_url false requires the package_id to be specified and
-    a call to Package instproc set_url to complete initialization
-  } {
-    #my log "--i [self args], URL=$url, init_url=$init_url"
-
-    if {$url eq "" && $init_url} {
-      #set url [ns_conn url]
-      #my log "--CONN ns_conn url"
-      set url [root_of_host [ad_host]][ns_conn url]
-    }
-    #my log "--cc actual_query = <$actual_query>"
-
-    # require connection context
-    ConnectionContext require \
-	-package_id $package_id -user_id $user_id \
-	-parameter $parameter -url $url -actual_query $actual_query
-    set package_id [::xo::cc package_id]
-    if {[info exists form_parameter]} {
-      ::xo::cc array set form_parameter $form_parameter
-    }
-
-    # create package object if necessary
-    my require -url $url $package_id
-    ::xo::cc export_vars -level 2
-  }
-
-  PackageMgr ad_instproc require {{-url ""} package_id} {
-    Create package object if needed.
-  } {
-    #my log "--R $package_id exists? [my isobject ::$package_id]"
-    if {![my isobject ::$package_id]} {
-      #my log "--R we have to create ::$package_id //url='$url'"
-      if {$url ne ""} {
-        my create ::$package_id -url $url
-      } else {
-        my create ::$package_id
-      }
-      ::$package_id destroy_on_cleanup
-    } else {
-      if {$url ne ""} {
-        ::$package_id set_url -url $url
-      }
-    }
-  }
-
-  #
-  # generic Package class
-  #
-
-  PackageMgr create Package -parameter {
-    id
-    url 
-    {context ::xo::cc}
-    package_url
-    package_key
-    instance_name
-  }
-  Package instforward query_parameter        {%my set context} %proc
-  Package instforward exists_query_parameter {%my set context} %proc
-  Package instforward form_parameter         {%my set context} %proc
-  Package instforward exists_form_parameter  {%my set context} %proc
-  Package instforward returnredirect         {%my set context} %proc
-
-  Package instproc get_parameter {attribute {default ""}} {
-    return [parameter::get -parameter $attribute -package_id [my id] \
-                -default $default]
-  }
- 
-  Package instproc init args {
-    #my log "--R creating"
-    my instvar id url
-    set id [namespace tail [self]]
-    array set info [site_node::get_from_object_id -object_id $id]
-    set package_url $info(url)
-    if {[ns_conn isconnected]} {
-      # in case of of host-node map, simplify the url to avoid redirects
-      # .... but ad_host works only, when we are connected.... TODO: solution for syndication
-      set root [root_of_host [ad_host]]
-      regexp "^${root}(.*)$" $package_url _ package_url
-    }
-    #my log "--R package_url= $package_url (was $info(url))"
-    my package_url $package_url
-    my package_key $info(package_key)
-    my instance_name $info(instance_name)
-    if {[my exists url] && [info exists root]} {
-      regexp "^${root}(.*)$" $url _ url
-    } else {
-      my log "--R we have no url, use package_url"
-      # if we have no more information, we use the package_url as actual url
-      set url $package_url
-    } 
-    my set_url -url $url
-  }
- 
-  Package instproc set_url {-url} {
-    my url $url
-    my set object [string range [my url] [string length [my package_url]] end]
-    #my log "--R object set to [my set object], [my serialize]"
-  }
-
-#   Package instproc destroy {} {
-#     my log "--i destroy"
-#     #::xo::show_stack
-#     next
-#   }
-  
 }
\ No newline at end of file
Index: openacs-4/packages/xotcl-core/tcl/cr-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/cr-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/xotcl-core/tcl/cr-procs.tcl	20 Sep 2007 11:57:04 -0000	1.5
+++ openacs-4/packages/xotcl-core/tcl/cr-procs.tcl	24 Sep 2007 12:04:26 -0000	1.6
@@ -673,7 +673,8 @@
 
   ##################################
 
-  ::xo::db::CrClass create ::xo::db::CrItem -superclass ::xo::db::Object \
+  ::xo::db::CrClass create ::xo::db::CrItem \
+      -superclass ::xo::db::Object \
       -table_name cr_revisions -id_column revision_id \
       -object_type content_revision \
       -slots {
@@ -957,9 +958,9 @@
     set __atts  [list creation_user]
     set __vars $__atts
 
-    my log "db_slots for $__class: [$__class array get db_slot]"
+    #my log "db_slots for $__class: [$__class array get db_slot]"
     foreach {__slot_name __slot} [$__class array get db_slot] {
-      my log "--slot = $__slot"
+      #my log "--slot = $__slot"
       if {
 	  $__slot eq "::xo::db::Object::slot::object_title" ||
 	  $__slot eq "::xo::db::CrItem::slot::name"