Index: openacs-4/packages/xotcl-core/xotcl-core.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/xotcl-core.info,v
diff -u -r1.68 -r1.69
--- openacs-4/packages/xotcl-core/xotcl-core.info	23 Apr 2009 10:14:51 -0000	1.68
+++ openacs-4/packages/xotcl-core/xotcl-core.info	28 Apr 2009 14:33:27 -0000	1.69
@@ -10,10 +10,10 @@
     <inherit-templates-p>t</inherit-templates-p>
     <auto-mount>xotcl</auto-mount>
 
-    <version name="0.105" url="http://media.wu-wien.ac.at/download/xotcl-core-0.105.apm">
+    <version name="0.106" url="http://media.wu-wien.ac.at/download/xotcl-core-0.106.apm">
         <owner url="mailto:neumann@wu-wien.ac.at">Gustaf Neumann</owner>
         <summary>XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes)</summary>
-        <release-date>2009-04-23</release-date>
+        <release-date>2009-04-28</release-date>
         <vendor>Gustaf Neumann, WU Wien</vendor>
         <description format="text/html">This component contains some core functionality for OpenACS
 applications using XOTcl. It includes
@@ -43,13 +43,16 @@
         <license>BSD-Style</license>
         <maturity>0</maturity>
 
-        <provides url="xotcl-core" version="0.105"/>
+        <provides url="xotcl-core" version="0.106"/>
 
         <callbacks>
             <callback type="after-upgrade"  proc="::xotcl-core::after_upgrade_callback"/>
             <callback type="before-install"  proc="::xotcl-core::before_install_callback"/>
         </callbacks>
         <parameters>
+            <parameter datatype="number"  min_n_values="1"  max_n_values="1"  name="NslogRedirector"  default="0" description="Allow redirections of nslog. The redirector filters ns_log messages and sends these not only to the error log (standard behaviour) but also to ds_comments in the developer support. This way, a developer can view the log messages for the current request directly in the browser when the developer support is activated, without having to watch the log file. 
+
+The value of 0 means &quot;no redirecting&quot; (deactivation), 1 means &quot;redirecting errors&quot;, 2 means &quot;redirect errors and notices&quot;"/>
             <parameter datatype="number"  min_n_values="1"  max_n_values="1"  name="XOTclObjectCacheSize"  default="400000" description="Size of the ns_cache xotcl_object_cache (used for caching XOTcl objects fetched from the database)"/>
             <parameter datatype="number"  min_n_values="1"  max_n_values="1"  name="XOTclObjectTypeCacheSize"  default="10000" description="Size of the ns_cache xotcl_object_type_cache (used for caching types of XOTcl objects)"/>
         </parameters>
Index: openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl,v
diff -u -r1.40 -r1.41
--- openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl	27 Apr 2009 20:34:23 -0000	1.40
+++ openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl	28 Apr 2009 14:33:27 -0000	1.41
@@ -454,33 +454,114 @@
   Module instproc cleanup args {ns_log notice "create/recreate [self] without cleanup"}
 }
 
-# per default, deactivated
-if {0} {
-  if {[info command ::xo::ns_log] eq ""} {
+namespace eval ::xo {
+  #
+  # ns_log_redirector_manager manages the ns_log-redirector, which can
+  # be used to direct debugging output from the error log file as well
+  # to the developer support. The behavior is controlled via a package
+  # parameter.
+  #
+  Object ns_log_redirector_manager 
+
+  ns_log_redirector_manager proc clean {} {
     #
+    # check if nothing to do
+    #
+    if {[info command ::xo::ns_log] eq ""} return
+    if {![my isobject ::ns_log]} return
+    #
+    # remove the stub
+    #
+    ::ns_log destroy
+    rename ::xo::ns_log ::ns_log
+  }
+
+  ns_log_redirector_manager proc require_stub {} {
+    #
+    # check if nothing to do
+    #
+    if {[info command ::xo::ns_log] ne ""} return
+    if {[my isobject ::ns_log]} return
+    #
     # provide an XOTcl stub for ns_log
     #
     rename ::ns_log ::xo::ns_log
-    ::xotcl::Object create ns_log
-    ns_log proc unknown {m args} {::xo::ns_log notice "Warning ns_log called with unknown severity '$m' $args"}
+    ::xotcl::Object create ::ns_log
+    ::ns_log proc unknown {m args} {::xo::ns_log notice "Warning ns_log called with unknown severity '$m' $args"}
     foreach flag {notice warning error fatal bug debug dev} {
-      ns_log forward [string totitle $flag] %self $flag
-      ns_log forward $flag ::xo::ns_log $flag
+      ::ns_log forward [string totitle $flag] %self $flag
+      ::ns_log forward $flag ::xo::ns_log $flag
     }
+  }
+
+  ns_log_redirector_manager proc set_level {new_logging_level} {
+    ::ns_log notice "SET LEVEL $new_logging_level"
     #
-    # we want ns_log error be reported as well via ds_comment
+    # We want ns_log error be reported as well via ds_comment;
+    # severity new_logging_level defines the amount of logging
     #
     ::xotcl::Class create ::xo::DS
-    ::xo::DS instproc error args {
-      catch {ds_comment "[self proc]: [join $args { }]"}
-      ::xo::ns_log [self proc] [join $args " "]
+    switch -- $new_logging_level {
+      1 {set severities [list error]}
+      2 {set severities [list error notice]}
+      default {set severities [list]}
     }
-    ::xo::DS instproc notice args {
-      catch {ds_comment "[self proc]: [join $args { }]"}
-      ::xo::ns_log [self proc] [join $args " "]
+    if {[llength $severities] > 0} {
+      my require_stub
+      foreach severity $severities {
+        ::xo::DS instproc $severity args {
+          catch {ds_comment "[self proc]: [join $args { }]"}
+          ::xo::ns_log [self proc] [join $args " "]
+        }
+      }
+      ::ns_log mixin ::xo::DS
+    } else {
+      my clean
     }
-    ::ns_log mixin ::xo::DS
   }
+
+  #
+  # per default, the redirector is deactivated
+  #
+  ns_log_redirector_manager set_level [::parameter::get_from_package_key \
+                                           -package_key xotcl-core \
+                                           -parameter NslogRedirector \
+                                           -default 0]
+  
+
+  #
+  # For the time being: catch changed parameter values; it would be nice
+  # to have in the future a more generic interface to trigger actions
+  # directly on all parameter changes.
+  #
+  ad_proc -public -callback subsite::parameter_changed -impl xotcl-core_param_changed {
+    -package_id:required
+    -parameter:required
+    -value:required
+  } {
+    Implementation of subsite::parameter_changed for xotcl-core parameters
+    
+    @param package_id the package_id of the package the parameter was changed for
+    @param parameter  the parameter name
+    @param value      the new value
+  } {
+    set package_key [apm_package_key_from_id $package_id]
+    if {$package_key eq "xotcl-core" && $parameter eq "NslogRedirector"} {
+      ::xo::ns_log_redirector_manager set_level $value
+      #
+      # Update the blueprint to reflect the parameter change
+      # immediately.
+      #
+      # This is a heavy solution, but the NslogRedirector is not
+      # likely to be changed frequently on a production system. The
+      # alternative, a server restart, is even more expensive.
+      #
+      set blueprint [ns_ictl get]
+      set last [string last "\n::xo::ns_log_redirector_manager" $blueprint]
+      if {$last > -1} { set blueprint [string range $blueprint 0 [expr {$last-1}]]}
+      ns_ictl save "$blueprint\n::xo::ns_log_redirector_manager set_level $value"
+    }
+  }
 }
 
 #ns_log notice "*** FREECONN? [ns_ictl gettraces freeconn]"
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.80 -r1.81
--- openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl	27 Apr 2009 20:33:19 -0000	1.80
+++ openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl	28 Apr 2009 14:33:27 -0000	1.81
@@ -1141,7 +1141,7 @@
 
     if {![my exists sql_package_name]} {
       set sql_package_name [self]
-      my log "-- sql_package_name of [self] is '$sql_package_name'"
+      #my log "-- sql_package_name of [self] is '$sql_package_name'"
     }
     if {[string length $sql_package_name] > 30} {
       error "SQL package_name '$sql_package_name' can be maximal 30 characters long!\
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 -r1.20 -r1.21
--- openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl	8 Apr 2009 11:04:56 -0000	1.20
+++ openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl	28 Apr 2009 14:33:27 -0000	1.21
@@ -227,10 +227,21 @@
   }
  
   ::xo::Package instproc init args {
-    #my log "--R creating"
     my instvar id url
-    array set info [site_node::get_from_object_id -object_id $id]
-    set package_url $info(url)
+    set package_url [site_node::get_url_from_object_id -object_id $id]
+    #my log "--R creating package_url='$package_url'"
+    if {$package_url ne ""} {
+      array set info [site_node::get -url $package_url]
+      #set package_url $info(url)
+      my package_key $info(package_key)
+      my instance_name $info(instance_name)
+    } else {
+      db_1row [my qn package_info] {
+        select package_key, instance_name from apm_packages where package_id = :id
+      }
+      my package_key $package_key
+      my instance_name $instance_name
+    }
     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.... 
@@ -240,20 +251,18 @@
     }
     #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
     } elseif {![my exists url]} {
       #my log "--R we have no url, use package_url '$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
     my set mime_type text/html
     my set delivery ns_return
-    set target_class ::$info(package_key)::Package
+    set target_class ::[my package_key]::Package
     if {[my info class] ne $target_class && [my isclass $target_class]} {
       my class $target_class
     }