- OpenACS 5.9

72096651 · Frank Bergmann · 7b96ee5d · 72096651 · 72096651 · 72096651
Commit 72096651 authored Dec 04, 2015 by Frank Bergmann
42 changed files
--- a/catalog/xotcl-core.de_DE.ISO-8859-1.xml
+++ b/catalog/xotcl-core.de_DE.ISO-8859-1.xml
@@ -6,6 +6,8 @@
  <msg key="edit_item">Editieren</msg>
  <msg key="has_entered_the_room">has entered the room</msg>
  <msg key="live_revision">Aktuelle Version</msg>
+  <msg key="nobody">Gast</msg>
+  <msg key="No_Data">Keine Daten</msg>
  <msg key="permission_denied">Zugriff verweigert</msg>
  <msg key="policy-error-insufficient_permissions">&lt;blockquote&gt;
 Sie haben keine ausreichende Berechtigung, um die Methode %method% am Objekt %object% auszufhren.

--- a/catalog/xotcl-core.en_US.ISO-8859-1.xml
+++ b/catalog/xotcl-core.en_US.ISO-8859-1.xml
@@ -10,6 +10,8 @@
  <msg key="edit_type">Edit %type%</msg>
  <msg key="has_entered_the_room">has entered the room</msg>
  <msg key="live_revision">Live Revision</msg>
+  <msg key="nobody">Guest</msg>
+  <msg key="No_Data">No Data</msg>
  <msg key="permission_denied">Permission Denied</msg>
  <msg key="policy-error-insufficient_permissions">&lt;blockquote&gt;
 You don't have sufficient permissions for performing method %method% on object %object%.

--- a/catalog/xotcl-core.ru_RU.utf-8.xml
+++ b/catalog/xotcl-core.ru_RU.utf-8.xml
+<?xml version="1.0" encoding="utf-8"?>
+<message_catalog package_key="xotcl-core" locale="ru_RU" charset="utf-8">
+
+  <msg key="add">Добавить %type%</msg>
+  <msg key="add_item">Добавить пункт</msg>
+  <msg key="add_long">Добавить новый пункт типа %type%</msg>
+  <msg key="create_new_type">Создать новый %type%</msg>
+  <msg key="delete_item">Удалить пункт</msg>
+  <msg key="edit_item">Редактировать пункт</msg>
+  <msg key="edit_type">Редактировать %type%</msg>
+  <msg key="has_entered_the_room">вошёл в комнату</msg>
+  <msg key="live_revision">Текущая ревизия</msg>
+  <msg key="No_Data">Нет данных</msg>
+  <msg key="nobody">Гость</msg>
+  <msg key="permission_denied">В разрешении отказано</msg>
+  <msg key="policy-error-insufficient_permissions">&lt;blockquote&gt; Вы не имеете достаточно полномочий для выполнения метода %method% для объекта %object%. &lt;/blockquote&gt;</msg>
+  <msg key="revision_title">Ревизии записи</msg>
+  <msg key="revisions">Ревизии</msg>
+  <msg key="view_item">Просмотреть пункт</msg>
+</message_catalog>
--- a/lib/revisions-postgresql.xql
+++ b/lib/revisions-postgresql.xql
@@ -23,6 +23,26 @@
 	order by n.revision_id desc
    </querytext>
  </fullquery> 
+
+  <fullquery name="revisions_info">
+    <rdbms><type>postgresql</type><version>8.4</version></rdbms>
+      <querytext>
+        select  ci.name, n.revision_id as version_id,
+        person__name(n.creation_user) as author,
+        n.creation_user as author_id,
+        to_char(n.last_modified,'YYYY-MM-DD HH24:MI:SS') as last_modified_ansi,
+        n.description,
+        acs_permission__permission_p(n.revision_id,:user_id,'admin') as admin_p,
+        acs_permission__permission_p(n.revision_id,:user_id,'delete') as delete_p,
+        char_length(n.data) as content_size,
+        content_revision__get_number(n.revision_id) as version_number
+        from cr_revisionsi n, cr_items ci
+        where ci.item_id = n.item_id and ci.item_id = :page_id
+        and acs_permission__permission_p(n.revision_id, :user_id, 'read')
+        order by n.revision_id desc
+      </querytext>
+  </fullquery>
+
 </queryset>


--- a/lib/revisions.tcl
+++ b/lib/revisions.tcl
@@ -5,7 +5,7 @@ ad_page_contract {
  @creation-date Oct 23, 2005
  @cvs-id $Id$
 } {
-  page_id:integer,notnull
+  page_id:naturalnum,notnull
  {name ""}
 } -properties {
  name:onevalue
@@ -97,3 +97,9 @@ db_multirow -unclobber -extend {
  set author_link [acs_community_member_link -user_id $author_id -label $author]
 }

+
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/00-serializer-procs.tcl
+++ b/tcl/00-serializer-procs.tcl
@@ -13,3 +13,9 @@ if {$::xotcl::version < 1.5} {
  ns_log notice "Please updgrade to a new version (see http://openacs.org/xowiki/xotcl-core)"
  ns_log notice "**********************************************************"
 }
+
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/01-debug-procs.tcl
+++ b/tcl/01-debug-procs.tcl
--- a/tcl/03-doc-procs.tcl
+++ b/tcl/03-doc-procs.tcl
--- a/tcl/04-library-procs.tcl
+++ b/tcl/04-library-procs.tcl
@@ -111,3 +111,9 @@ namespace eval ::xo {
    }
  }
 }
+
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/05-db-procs.tcl
+++ b/tcl/05-db-procs.tcl
--- a/tcl/06-package-procs.tcl
+++ b/tcl/06-package-procs.tcl
@@ -22,7 +22,7 @@ namespace eval ::xo {
  } {
    my instvar package_key
    if {[info exists privilege]} {
-      set sql [::xo::db::sql select -vars package_id \
+      set sql [::xo::dc select -vars package_id \
                   -from "apm_packages, acs_object_party_privilege_map ppm, site_nodes s" \
                   -where {
                     package_key = :package_key 
@@ -31,7 +31,7 @@ namespace eval ::xo {
                     and ppm.party_id = :party_id
                     and ppm.privilege = :privilege
                   } -limit 1]
-      db_string [my qn get_package_id] $sql
+      ::xo::dc get_value get_package_id $sql
    } else {
      ::xo::parameter get_package_id_from_package_key -package_key $package_key
    }
@@ -44,18 +44,18 @@ namespace eval ::xo {
  } {
    my instvar package_key
    if {$include_unmounted} {
-      set result [db_list [my qn get_xowiki_packages] {select package_id \
-        from apm_packages where package_key = :package_key}]
+      set result [::xo::dc list get_xowiki_packages {select package_id \
+                                                         from apm_packages where package_key = :package_key}]
    } else {
-      set result [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}]
+      set result [::xo::dc list 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}]
    }
    if {$closure} {
      foreach subclass [my info subclass] {
-	foreach id [$subclass instances -include_unmounted $include_unmounted -closure true] {
-	  lappend result $id
-	}
+        foreach id [$subclass instances -include_unmounted $include_unmounted -closure true] {
+          lappend result $id
+        }
      }
    }
    return [lsort -integer $result]
@@ -91,6 +91,12 @@ namespace eval ::xo {
  } {
    #my msg "--i [self args], URL=$url, init_url=$init_url"

+    if {[info exists ad_doc] && [api_page_documentation_mode_p]} {
+      ad_parse_documentation_string $ad_doc doc_elements
+      set doc_elements(query) $parameter
+      error [array get doc_elements] "ad_page_contract documentation"
+    }
+
    if {$url eq "" && $init_url} {
      set url [root_of_host [ad_host]][ns_conn url]
      #my log "--CONN ns_conn url -> $url"
@@ -120,7 +126,7 @@ namespace eval ::xo {
    } else {
      my require -url $url $package_id
    }
-      
+    
    #
    # In case the login expired, we can force an early login to
    # prevent later login redirects, which can cause problems
@@ -129,9 +135,9 @@ namespace eval ::xo {
    # might not require the real user_id.
    #
    #my msg "force [$package_id force_refresh_login] &&\
-    #	[::xo::cc set untrusted_user_id] != [::xo::cc user_id]"
+        #    [::xo::cc set untrusted_user_id] != [::xo::cc user_id]"
    if {[$package_id force_refresh_login] && 
-	[::xo::cc set untrusted_user_id] != [::xo::cc user_id]} {
+        [::xo::cc set untrusted_user_id] != [::xo::cc user_id]} {
      auth::require_login
    }

@@ -142,6 +148,9 @@ namespace eval ::xo {
  PackageMgr ad_proc get_package_class_from_package_key {package_key} {
    Obtain the package class from a package key
  } {
+    set key ::xo::package_class($package_key)
+    if {[info exists $key]} {return [set $key]}
+    
    foreach p [::xo::PackageMgr allinstances] {
      # Sanity check for old apps, having not set the package key.
      # TODO: remove this in future versions, when package_keys are enforced
@@ -150,16 +159,21 @@ namespace eval ::xo {
        continue
      }
      if {[$p package_key] eq $package_key} {
+        set $key $p
        return $p
      }
    }
+
    return ""
  }

  PackageMgr ad_instproc require {{-url ""} package_id} {
    Create package object if needed.
  } {
-    if {$package_id eq ""} {error "package_id must not be empty"}
+    if {$package_id eq ""} {
+      #::xo::show_stack
+      error "package_id must not be empty"
+    }

    #my log "--R $package_id exists? [my isobject ::$package_id] url='$url'"

@@ -201,7 +215,7 @@ namespace eval ::xo {
  #
  # 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 =======================================

@@ -219,7 +233,7 @@ namespace eval ::xo {
        url 
        {context ::xo::cc}
        package_url
-	{force_refresh_login false}
+        {force_refresh_login false}
      }

  ::xo::Package instforward query_parameter        {%my set context} %proc
@@ -229,15 +243,22 @@ namespace eval ::xo {
  ::xo::Package instforward returnredirect         {%my set context} %proc

  ::xo::Package instproc get_parameter {attribute {default ""}} {
-    set param [::xo::parameter get \
+    set package_id [my id]
+    set parameter_obj [::xo::parameter get_parameter_object \
+                           -parameter_name $attribute \
+                           -package_id $package_id \
+                           -retry false]
+    set success 0
+    if {$parameter_obj ne ""} {
+      set value [$parameter_obj get -package_id $package_id]
+      if {[$parameter_obj set __success]} {return $value}
+    }
+    return [parameter::get_global_value \
+                   -package_key [my set package_key] \
                   -parameter $attribute \
-                   -package_id [my id] \
-                   -default $default \
-                   -retry false]
-    #my log "--get_parameter <$attribute> <$default> returned <$param>"
-    return $param
+                   -default $default]
  }
- 
+  
  ::xo::Package instproc init args {
    my instvar id url
    set package_url [lindex [site_node::get_url_from_object_id -object_id $id] 0]
@@ -248,12 +269,13 @@ namespace eval ::xo {
      my package_key $info(package_key)
      my instance_name $info(instance_name)
    } else {
-      db_1row [my qn package_info] {
+      ::xo::dc 1row 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.... 
@@ -278,6 +300,12 @@ namespace eval ::xo {
    if {[my info class] ne $target_class && [my isclass $target_class]} {
      my class $target_class
    }
+    
+    #
+    # Save the relation between class and package_key for fast lookup
+    #
+    set ::xo::package_class([my set package_key]) [my info class]
+
    my initialize
  }

@@ -326,14 +354,34 @@ namespace eval ::xo {
    #my msg "--R object set to [my set object], url=$url, [my serialize]"
  }

+  ::xo::Package instproc handle_http_caching {} {
+    #
+    # Subpackages can overload this method for realizing 
+    #
+    # a) package specific caching policies
+    # b) page-type specific caching policies
+    # c) page specific caching policies
+    #
+    # Items (b) and (c) can e realized via the instance variable of
+    # the package object named "invoke_object", which is set for
+    # non-error cases in e.g. xowiki.
+    #
+    ns_set put [ns_conn outputheaders] "Cache-Control" \
+        "max-age=0, no-cache, no-store"
+    # 
+  }
+
  ::xo::Package instproc reply_to_user {text} {
+
+    my handle_http_caching
+
    #my log "REPLY [::xo::cc exists __continuation]"
    if {[::xo::cc exists __continuation]} {
      #my log "REPLY [::xo::cc set __continuation]"
      eval [::xo::cc set __continuation]
    } else {
      if {[string length $text] > 1} {
-	set status_code [expr {[::xo::cc exists status_code] ? [::xo::cc set status_code] : 200}]
+        set status_code [expr {[::xo::cc exists status_code] ? [::xo::cc set status_code] : 200}]
        #my log "REPLY [my set delivery] 200 [my set mime_type]"
        [my set delivery] $status_code [my set mime_type] $text
      }
@@ -345,8 +393,15 @@ namespace eval ::xo {
    set __vars [list]
    foreach _var $variables {
      if {[llength $_var] == 2} {
+        #
+        # The variable specification is a pair of name and value
+        #
        lappend __vars [lindex $_var 0] [uplevel subst [lindex $_var 1]]
      } else {
+        #
+        # We have just a variable name, provide an linked variable to
+        # access the value.
+        #
        set localvar local.$_var
        upvar $_var $localvar
        if {[array exists $localvar]} {
@@ -365,16 +420,26 @@ namespace eval ::xo {
        upvar #$level $f $f
      }
    }
-    #my log "--before adp"   ; # $__vars
+    #
+    # Substitute the template with the themed template
+    #
+    set adp [template::themed_template $adp]
+    
    set text [template::adp_include $adp $__vars]
-    #my log "--after adp"
    if { [lang::util::translator_mode_p] } {
      set text [::xo::localize $text 1]
    }
    #my log "--after adp"
    return $text
  }
- 
+  
  #ns_log notice [::xo::Package serialize]

-}
\ No newline at end of file
+}
+
+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/06-param-procs.tcl
+++ b/tcl/06-param-procs.tcl
@@ -37,7 +37,7 @@
 # - 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
+#      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
@@ -160,19 +160,20 @@ namespace eval ::xo {
  # 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 [my qn get_package_key] \
-          "select package_key from apm_packages where package_id = $package_id"
-    }]
+                                          -package_id:required
+                                        } {
+    return [apm_package_key_from_id $package_id]
+    #return [ns_cache eval xotcl_object_type_cache package_key-$package_id {
+    #  ::xo::dc get_value 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
-  } {
+                                                  -package_key:required
+                                                } {
    return [ns_cache eval xotcl_object_type_cache package_id-$package_key {
-      db_string [my qn get_package_id] \
-          [::xo::db::sql select -vars package_id -from apm_packages \
+      ::xo::dc get_value get_package_id \
+          [::xo::dc select -vars package_id -from apm_packages \
               -where "package_key = :package_key" -limit 1]
    }]
  }
@@ -196,11 +197,11 @@ namespace eval ::xo {
  }

  parameter proc get_parameter_object {
-    -parameter_name:required
-    -package_id
-    -package_key
-    {-retry true}
-  } {
+                                       -parameter_name:required
+                                       -package_id
+                                       -package_key
+                                       {-retry true}
+                                     } {
    ::xo::PackageMgr instvar package_class
    if {![info exists package_key]} {
      set package_key [my get_package_key_from_id -package_id $package_id]
@@ -241,6 +242,7 @@ namespace eval ::xo {
                             and package_key = :package_key
                           }] \
                 -object_class ::xo::db::apm_parameter \
+                 -ignore_missing_package_ids true \
                 -as_ordered_composite false -named_objects true -destroy_on_cleanup false]
      #
      # Check for "retry" to avoid potential recursive loops
@@ -264,10 +266,10 @@ namespace eval ::xo {
  }

  parameter proc get_from_package_key {
-    -package_key:required
-    -parameter:required
-    -default
-  } {
+                                       -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}
@@ -280,17 +282,17 @@ namespace eval ::xo {
  }

  parameter proc get {
-    -package_id
-    -parameter:required
-    -default
-    {-retry true}
-  } {
+                      -package_id
+                      -parameter:required
+                      -default
+                      {-retry true}
+                    } {
    if {![info exists package_id]} {
      # try to get the package id; 
      # if everything fails, use kernel_id (to be compatible with trad. parameter::get)
-      set package_id [expr {[info command ::xo::cc] ne "" ? 
-		    [::xo::cc package_id] : 
-		    [ns_conn isconnected] ? [ad_conn package_id] : [ad_acs_kernel_id]}]
+      set package_id [expr {[info commands ::xo::cc] ne "" ? 
+                            [::xo::cc package_id] : 
+                            [ns_conn isconnected] ? [ad_conn package_id] : [ad_acs_kernel_id]}]
    }
    set parameter_obj [my get_parameter_object -parameter_name $parameter -package_id $package_id -retry $retry]
    if {$parameter_obj ne ""} {
@@ -356,21 +358,22 @@ namespace eval ::xo {
  ::xo::db::apm_parameter instantiate_objects \
      -sql [::xo::db::apm_parameter instance_select_query] \
      -object_class ::xo::db::apm_parameter \
+      -ignore_missing_package_ids true \
      -as_ordered_composite false -named_objects true -destroy_on_cleanup false
-#  ns_log notice "--p got [llength [::xo::db::apm_parameter info instances]] parameters"
+  #  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 [my qn get_non_default_values] {
+    xo::dc foreach get_non_default_values {
      select p.parameter_id, p.package_key, v.package_id, p.parameter_name, 
-             p.default_value, v.attr_value 
+      p.default_value, v.attr_value 
      from apm_parameters p, apm_parameter_values v 
      where p.parameter_id = v.parameter_id 
      and coalesce(attr_value,'') <> coalesce(p.default_value,'')
    } {
-#      ns_log notice "--p $parameter_id $package_key $package_id $parameter_name <$attr_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
    }
  }
@@ -381,9 +384,9 @@ namespace eval ::xo {
  # For the time being: catch changed parameter values
  #
  ad_proc -public -callback subsite::parameter_changed -impl xotcl-param-procs {
-   -package_id:required
-   -parameter:required
-   -value:required
+    -package_id:required
+    -parameter:required
+    -value:required
  } {
    Implementation of subsite::parameter_changed for xotcl param procs
    
@@ -398,8 +401,8 @@ namespace eval ::xo {
    #
    set package_key [apm_package_key_from_id $package_id]
    set parameter_obj [::xo::parameter get_parameter_object \
-                            -package_key $package_key \
-                            -parameter_name $parameter]
+                           -package_key $package_key \
+                           -parameter_name $parameter]
    
    if {$parameter_obj eq ""} {
      # We have still no parameter. There must be something significantly wrong.
@@ -416,43 +419,50 @@ namespace eval ::xo {
  #
  #  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]"
+  #   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 "::xo::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 cmd1 "::parameter::get_from_package_key \
+      #       -package_key xotcl-request-monitor \
+      #       -parameter max-url-stats"
+  #   set cmd2 "::xo::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 "::xo::parameter get -package_id $pid -parameter $pname"
-#   ns_log notice "GET 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 "::xo::parameter get -package_id $pid -parameter $pname"
+  #   ns_log notice "GET old: [time $cmd1 100], new: [time $cmd2 100]"

  #
  #
  #
  #
-#   set p [parameter get_parameter_object -package_key xowiki -parameter_name dummy]
-#   ns_log notice "--p getobject => $p"
-#   if {$p eq ""} {
-#     set p [::xo::db::apm_parameter new_persistent_object  \
-#                -package_key "xowiki" \
-#                -parameter_name "dummy" \
-#                -default_value "testing" \
-#                -description "Description of test parameter" \
-#                -section_name ""]
-#     ns_log notice "--p created new parameter $p"
-#   }
-#   $p append default_value "1"
-#   $p save
+  #   set p [parameter get_parameter_object -package_key xowiki -parameter_name dummy]
+  #   ns_log notice "--p getobject => $p"
+  #   if {$p eq ""} {
+  #     set p [::xo::db::apm_parameter new_persistent_object  \
+      #                -package_key "xowiki" \
+      #                -parameter_name "dummy" \
+      #                -default_value "testing" \
+      #                -description "Description of test parameter" \
+      #                -section_name ""]
+  #     ns_log notice "--p created new parameter $p"
+  #   }
+  #   $p append default_value "1"
+  #   $p save
  # $p delete
  
-}
\ No newline at end of file
+}
+
+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/10-recreation-procs.tcl
+++ b/tcl/10-recreation-procs.tcl
@@ -16,10 +16,10 @@ ad_library {
 if {![::xotcl::Object isclass ::xotcl::RecreationClass]} {
  ::xotcl::Class create ::xotcl::RecreationClass -ad_doc {
    <p>This meta-class controlls the behavior of classes (and optionally
-    their instances), when the classes (or their instances) are	
+    their instances), when the classes (or their instances) are    
    overwritten by same named new objects; we call this situation
    a recreate of an object.</p>
-					     
+    
    <p>Normally, when files with e.g. class definitions are sourced,
    the classes and objects are newly defined. When e.g. class 
    definitions exists already in this file, these classes are 
@@ -42,7 +42,7 @@ if {![::xotcl::Object isclass ::xotcl::RecreationClass]} {
    <li><b>reconfigure:</b> reconfigure class (default 1)
    <li><b>reinit:</b> run init after configure for this class (default unset)
    <li><b>instrecreate:</b> handle recreate of class instances (default unset)
-      When this flag is set to 0, instreconfigure and instreinit are ignored.
+    When this flag is set to 0, instreconfigure and instreinit are ignored.
    <li><b>instreconfigure:</b> reconfigure instances of this class (default 1)
    <li><b>instreinit:</b> re-init instances of this class (default unset)
    </ul>
@@ -54,43 +54,43 @@ if {![::xotcl::Object isclass ::xotcl::RecreationClass]} {
    {instreinit}
  } -superclass ::xotcl::Class \
      -instproc recreate {obj args} {
-	#my log "### recreateclass instproc $obj <$args>"
-	# the minimal reconfiguration is to set the class and remove methods
-	$obj class [self]
-	foreach p [$obj info procs] {$obj proc $p {} {}}
-	if {![my exists instrecreate]} {
-	  #my log "### no instrecreate for $obj <$args>"
-	  next
-	  return
-	}
-	if {[my exists instreconfigure]} {
-	  # before we set defaults, we must unset vars
-	  foreach var [$obj info vars] {$obj unset $var}
-	  # set defaults and run configure
+        #my log "### recreateclass instproc $obj <$args>"
+        # the minimal reconfiguration is to set the class and remove methods
+        $obj class [self]
+        foreach p [$obj info procs] {$obj proc $p {} {}}
+        if {![my exists instrecreate]} {
+          #my log "### no instrecreate for $obj <$args>"
+          next
+          return
+        }
+        if {[my exists instreconfigure]} {
+          # before we set defaults, we must unset vars
+          foreach var [$obj info vars] {$obj unset $var}
+          # set defaults and run configure
          $obj set_instance_vars_defaults
-	  eval $obj configure $args
-	  #my log "### instproc recreate $obj + configure $args ..."
-	}
-	if {[my exists instreinit]} {
-	  #my log "### instreinit for $obj <$args>"
-	  eval $obj init 
-	  #my log "### instproc recreate $obj + init ..."
-	}
+          $obj configure {*}$args
+          #my log "### instproc recreate $obj + configure $args ..."
+        }
+        if {[my exists instreinit]} {
+          #my log "### instreinit for $obj <$args>"
+          $obj init 
+          #my log "### instproc recreate $obj + init ..."
+        }
      } -proc recreate {obj args} {
-	#my log "### recreateclass proc $obj <$args>"
-	# the minimal reconfiguration is to set the class and remove methods
-	$obj class [self]
-	foreach p [$obj info instprocs] {$obj instproc $p {} {}}
-	if {[my exists reconfigure]} {
-	  # before we set defaults, we must unset vars
-	  foreach var [$obj info vars] {$obj unset $var}
-	  # set defaults and run configure
+        #my log "### recreateclass proc $obj <$args>"
+        # the minimal reconfiguration is to set the class and remove methods
+        $obj class [self]
+        foreach p [$obj info instprocs] {$obj instproc $p {} {}}
+        if {[my exists reconfigure]} {
+          # before we set defaults, we must unset vars
+          foreach var [$obj info vars] {$obj unset $var}
+          # set defaults and run configure
          $obj set_instance_vars_defaults
-	  eval $obj configure $args
-	}
-	if {[my exists reinit]} {
-	  eval $obj init 
-	}
+          $obj configure {*}$args
+        }
+        if {[my exists reinit]} {
+          $obj init
+        }
      }

  ::Serializer exportObjects {
@@ -150,9 +150,9 @@ if {[string match "1.3.*" $version]} {

    # we use uplevel to handle -volatile correctly
    set pos [my uplevel $obj configure $args]
-    if {[lsearch -exact $args -init] == -1} {
+    if {"-init" ni $args} {
      incr pos -1
-      eval $obj init [lrange $args 0 $pos]
+      $obj init {*}[lrange $args 0 $pos]
    }
  }

@@ -173,4 +173,11 @@ if {[string match "1.3.*" $version]} {
    my log "-- [self args]"; next
  }
  #::xotcl::Class instmixin RR
-}
\ No newline at end of file
+}
+
+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/20-Ordered-Composite-procs.tcl
+++ b/tcl/20-Ordered-Composite-procs.tcl
@@ -69,7 +69,7 @@ namespace eval ::xo {
    if {[my exists __children]} {
      #my log "--W destroying children [my set __children]"
      foreach c [my set __children] { 
-	if {[my isobject $c]} {$c destroy}
+        if {[my isobject $c]} {$c destroy}
      }
    }
    #show_stack;my log "--W children murdered, now next, chlds=[my info children]"
@@ -80,7 +80,7 @@ namespace eval ::xo {
  OrderedComposite instproc contains cmds {
    my requireNamespace ;# legacy for older xotcl versions
    set m [Object info instmixin]
-    if {[lsearch $m [self class]::ChildManager] == -1} {
+    if {"[self class]::ChildManager" ni $m} {
      set insert 1
      Object instmixin add [self class]::ChildManager
    } else { 
@@ -91,7 +91,7 @@ namespace eval ::xo {
    # push the active composite
    lappend composite [self]
    # check, if we have Tcl's apply available
-    if {$::tcl_version >= 8.5 && [info proc ::apply] eq ""} {
+    if {$::tcl_version >= 8.5 && [info procs ::apply] eq ""} {
      set errorOccurred [catch {::apply [list {} $cmds [self]]} errorMsg]
    } else {
      set errorOccurred [catch {namespace eval [self] $cmds} errorMsg]
@@ -136,31 +136,31 @@ namespace eval ::xo {
    set yp [string first . $y]
    if {$xp == -1 && $yp == -1} {
      if {$x < $y} {
-	return -1
+        return -1
      } elseif {$x > $y} {
-	return 1
+        return 1
      } else {
-	return $def
+        return $def
      }
    } elseif {$xp == -1} {
-      set yh [string range $y 0 [expr {$yp-1}]]
+      set yh [string range $y 0 $yp-1]
      return [my __value_compare $x $yh -1]
    } elseif {$yp == -1} {
-      set xh [string range $x 0 [expr {$xp-1}]]
+      set xh [string range $x 0 $xp-1]
      return [my __value_compare $xh $y 1]
    } else {
      set xh [string range $x 0 $xp]
      set yh [string range $y 0 $yp]
      #puts "xh=$xh yh=$yh"
      if {$xh < $yh} {
-	return -1
+        return -1
      } elseif {$xh > $yh} {
-	return 1
+        return 1
      } else {
-	incr xp 
-	incr yp
-	#puts "rest [string range $x $xp end] [string range $y $yp end]"
-	return [my __value_compare [string range $x $xp end] [string range $y $yp end] $def]
+        incr xp 
+        incr yp
+        #puts "rest [string range $x $xp end] [string range $y $yp end]"
+        return [my __value_compare [string range $x $xp end] [string range $y $yp end] $def]
      }
    }
  }
@@ -180,3 +180,9 @@ namespace eval ::xo {
  }
 }

+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/30-widget-procs.tcl
+++ b/tcl/30-widget-procs.tcl
--- a/tcl/40-thread-mod-procs.tcl
+++ b/tcl/40-thread-mod-procs.tcl
 ad_library {
  Tcl API for Thread management provides some support for threads
-   under the AOL-server and XOTcl. It contains
-   essentially two classes THREAD and Proxy.
+  under the AOL-server and XOTcl. It contains
+  essentially two classes THREAD and Proxy.
  <p>
-   The class THREAD is used to create, initialize
-   and destroy threads and to pass commands to these 
-   threads. It is designed in a way to create threads
-   lazyly such that thread definitions can be included
-   in the modules directory of the aolserver and 
-   therefore be part of the aolserver blueprints.
-   When an instance of THREAD is created (e.g. t1), 
-   an init-command is provided. e.g.:
+  The class THREAD is used to create, initialize
+  and destroy threads and to pass commands to these 
+  threads. It is designed in a way to create threads
+  lazyly such that thread definitions can be included
+  in the modules directory of the aolserver and 
+  therefore be part of the aolserver blueprints.
+  When an instance of THREAD is created (e.g. t1), 
+  an init-command is provided. e.g.:
  <pre>
-    ::xotcl::THREAD create t1 {
-      Class Counter -parameter {{value 1}}
-      Counter instproc ++ {} {my incr value}
-      Counter c1
-      Counter c2
-    }
+  ::xotcl::THREAD create t1 {
+    Class Counter -parameter {{value 1}}
+    Counter instproc ++ {} {my incr value}
+    Counter c1
+    Counter c2
+  }
  </pre>
-   Commands are sent to the thread via the
-   "do" method, which returns the result of the
-   command evaluated in the specified thread. 
-   When the first command is sent to a 
-   non-initialized thread, such as
+  Commands are sent to the thread via the
+  "do" method, which returns the result of the
+  command evaluated in the specified thread. 
+  When the first command is sent to a 
+  non-initialized thread, such as
  <pre>
-    set x [t1 do c1 ++]
+  set x [t1 do c1 ++]
  </pre> 
-   the actual thread is created and the thread 
-   ID is remembered in a tsv array. When a
-   THREAD object is destroyed, the associated
-   thread is terminated as well. 
+  the actual thread is created and the thread 
+  ID is remembered in a tsv array. When a
+  THREAD object is destroyed, the associated
+  thread is terminated as well. 
  
-   Notice that according to the aol-server behavior it
-   is possible to create **persistent threads**
-   (when the thread object is created during
+  Notice that according to the aol-server behavior it
+  is possible to create **persistent threads**
+  (when the thread object is created during
   startup and provided to all request threads
-   through the blueprint, or to create **volatile
-   threads** that are created during a request
-   and which are deleted when the thread cleanup
-   is called after some timeout. Volatile threads can 
-   shared as well (when different request-threads
-   create the same-named thread objects) and can 
-   be used for caching proposes. Flushing the cache
-   can be done in the thread's exitHandler.
+   through the blueprint), or to create **volatile
+  threads** that are created during a request
+  and which are deleted when the thread cleanup
+  is called after some timeout. Volatile threads can 
+  shared as well (when different request-threads
+                  create the same-named thread objects) and can 
+  be used for caching proposes. Flushing the cache
+  can be done in the thread's exitHandler.
  
-   The Proxy class can be used to simplify
-   the interaction with a thread and to 
-   hide the fact, that certain classes/objects
-   are part of a thread. The following command
-   creates a Proxy for an object c1 in thread t1.
-   After this, c1 can be used like an local object.
+  The Proxy class can be used to simplify
+  the interaction with a thread and to 
+  hide the fact, that certain classes/objects
+  are part of a thread. The following command
+  creates a Proxy for an object c1 in thread t1.
+  After this, c1 can be used like an local object.
  <pre>
-    ::xotcl::THREAD::Proxy c1 -attach t1
-    set x [c1 ++]
+  ::xotcl::THREAD::Proxy c1 -attach t1
+  set x [c1 ++]
  </pre>
  The Proxy forwards all commands to the 
  attached thread except the methods attatch, filter, 
  detachAll and destroy. The attach method can be used 
  to reattach a proxy instance to a different thread, such as 
  <pre>  
-    c1 attach t2
+  c1 attach t2
  </pre>
-   A proxy can be (temporarily) detachted from a thread via
+  A proxy can be (temporarily) detachted from a thread via
  <pre>
-    c1 filter ""
+  c1 filter ""
  </pre>
  Later forwarding to the thread can be re-enabled via 
  <pre>
-    c1 filter forward
+  c1 filter forward
  </pre>
  When a proxy is attached to a thread and 
  receives a destroy command, both the proxy
@@ -93,12 +93,16 @@ ad_library {
 ::Serializer exportObjects {
  ::xotcl::THREAD
  ::xotcl::THREAD::Client
-  ::xotcl::THREAD::Proxy
 }
+#  ::xotcl::THREAD::Proxy

 ################## main thread support ##################
 Class create ::xotcl::THREAD \
-    -parameter {{persistent 0} {lightweight 0}}
+    -parameter {
+      {persistent 0}
+      {lightweight 0}
+      {exithandler {my log "EXITHANDLER of slave thread SELF [pid]"}}
+    }

 ::xotcl::THREAD instproc check_blueprint {} {
  if {![[self class] exists __blueprint_checked]} {
@@ -127,10 +131,10 @@ Class create ::xotcl::THREAD \
  }
  append initcmd {
    ns_thread name SELF
-    ::xotcl::Object setExitHandler {
-      #my log "EXITHANDLER of slave thread SELF [pid]"
-    }
  }
+  append initcmd [subst {
+    ::xotcl::Object setExitHandler [list [my exithandler]]
+  }]
  regsub -all SELF $initcmd [self] initcmd
  append initcmd \n\
      [list set ::xotcl::currentScript [info script]] \n\
@@ -150,7 +154,7 @@ Class create ::xotcl::THREAD \
  $obj set recreate 1
  next
  $obj init [lindex $args 0]
-  if {[nsv_exists [self] $obj]} {
+  if {[nsv_exists [self] $obj] && [$obj exists initcmd]} {
    set tid [nsv_get [self] $obj]
    ::thread::send $tid [$obj set initcmd]
    $obj set tid $tid
@@ -202,19 +206,19 @@ Class create ::xotcl::THREAD \
      }
      nsv_set [self class] [self] $tid
      if {[my persistent]} {
-	my log "--created new persistent [self class] as $tid pid=[pid]"
+        my log "--created new persistent [self class] as $tid pid=[pid]"
      } else {
-	my log "--created new [self class] as $tid pid=[pid]"
+        my log "--created new [self class] as $tid pid=[pid]"
      }
      #my log "--THREAD DO send [self] epoch = [ns_ictl epoch]"
      if {[my lightweight]} {
      } elseif {![ns_ictl epoch]} {
-	#ns_log notice "--THREAD send [self] no epoch"
-	# We are during initialization. For some unknown reasons, XOTcl 
-	# is not available in newly created threads, so we have to care 
-	# for full initialization, including xotcl blueprint.
-	_ns_savenamespaces
-	set initcmd [ns_ictl get]
+        #ns_log notice "--THREAD send [self] no epoch"
+        # We are during initialization. For some unknown reasons, XOTcl 
+        # is not available in newly created threads, so we have to care 
+        # for full initialization, including xotcl blueprint.
+        _ns_savenamespaces
+        set initcmd [ns_ictl get]
      }
      append initcmd [my set initcmd]
      #ns_log notice "INIT $initcmd"
@@ -231,9 +235,9 @@ Class create ::xotcl::THREAD \
  if {![my exists tid]} {
    # this is the first call 
    if {![my persistent] && ![my exists recreate]} {
-      # for a shared thread, we do ref-counting through preseve
-      my log "must preserve for sharing request-thread [pid]"
+      # for a shared thread, we do ref-counting through preserve
      set tid [nsv_get [self class] [self]]
+      my log "THREAD::PRESERVE must preserve for sharing request-thread [pid] tid $tid"
      ::thread::preserve $tid
    }
    my set tid $tid
@@ -260,19 +264,19 @@ Class create ::xotcl::THREAD \
 ################## forwarding  proxy ##################
 # Class ::xotcl::THREAD::Proxy -parameter {attach} 
 # ::xotcl::THREAD::Proxy configure \
-#     -instproc forward args {
+    #     -instproc forward args {
 #       set cp [self calledproc]
-#       if { [string equal $cp "attach"] 
-# 	   || $cp eq "filter" 
-# 	   || $cp eq "detachAll"} {
-# 	next
+#       if { $cp eq "attach"
+#        || $cp eq "filter" 
+#        || $cp eq "detachAll"} {
+#     next
 #       } elseif {$cp eq "destroy"} {
-# 	eval [my attach] do [self] $cp $args
-# 	my log "destroy"
-# 	next
+#     eval [my attach] do [self] $cp $args
+#     my log "destroy"
+#     next
 #       } else {
-# 	my log "forwarding [my attach] do [self] $cp $args"
-# 	eval [my attach] do [self] $cp $args
+#     my log "forwarding [my attach] do [self] $cp $args"
+#     eval [my attach] do [self] $cp $args
 #       }
 #     } -instproc init args {
 #       my filter forward
@@ -284,9 +288,15 @@ Class create ::xotcl::THREAD \
 # sample Thread client routine, calls a same named object in the server thread
 # a thread client should be created in an connection thread dynamically to 
 # avoid name clashes in the blueprint.
- 
+
 Class create ::xotcl::THREAD::Client -parameter {server {serverobj [self]}}
 ::xotcl::THREAD::Client instproc do args {
-  eval [my server] do [my serverobj] $args
+  [my server] do [my serverobj] {*}$args
 }

+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/50-protocol-handler-procs.tcl
+++ b/tcl/50-protocol-handler-procs.tcl
@@ -27,8 +27,7 @@ namespace eval ::xo {
      # get the second bit, the base64 encoded bit
      set up [lindex [split $ah " "] 1]
      # after decoding, it should be user:password; get the username
-      set user [lindex [split [ns_uudecode $up] ":"] 0]
-      set password [lindex [split [ns_uudecode $up] ":"] 1]
+      lassign [split [ns_uudecode $up] ":"] user password
      array set auth [auth::authenticate \
                          -username $user \
                          -authority_id [::auth::get_register_authority] \
@@ -59,7 +58,7 @@ namespace eval ::xo {
  ProtocolHandler ad_instproc initialize {} {
    Setup connection object and authenticate user
  } {
-    my instvar uri method urlv destination
+    my instvar uri method url urlv destination
    ad_conn -reset
    # Make sure, there is no ::ad_conn(request); otherwise the
    # developer support will add all its output to a single var, which
@@ -67,15 +66,17 @@ namespace eval ::xo {
    # unset, the developer support will create its own id.
    catch {unset ::ad_conn(request)}
    set uri [ns_urldecode [ns_conn url]]
+    if {[string length $uri] < [string length $url]} {append uri /}
    set url_regexp "^[my url]"
-    #my log "--conn_setup: uri '$uri' my url='[my url]' con='[ns_conn url]'"
    regsub $url_regexp $uri {} uri
    if {![regexp {^[./]} $uri]} {set uri /$uri}
+    #my log "--conn_setup: uri '$uri' my url='[my url]' con='[ns_conn url]'"
    my set_user_id

    set method [string toupper [ns_conn method]]
    #my log "--conn_setup: uri '$uri' method $method"
    set urlv [split [string trimright $uri "/"] "/"]
+    my set user_agent [ns_set iget [ns_conn headers] user-agent]
    set destination [ns_urldecode [ns_set iget [ns_conn headers] Destination]]
    if {$destination ne ""} {
      regsub {https?://[^/]+/} $destination {/} dest
@@ -96,7 +97,7 @@ namespace eval ::xo {
      ns_returnunauthorized
      return filter_return
    }
-  
+    
    # set common data for all kind of requests 
    my initialize

@@ -115,15 +116,16 @@ namespace eval ::xo {
    This method is typically called via *-init.tcl.

    Note, that the specified url must not have an entry
-    in the site-nodes, otherwise the openacs request 
+    in the site-nodes, otherwise the OpenACS request 
    processor performs always the cockie-based authorization.

    To change that, it would be necessary to register the
    filter before the request processor (currently, there
-    are no hooks for that).
+                                         are no hooks for that).
  } {
    set filter_url [my url]*
    set url [my url]/*
+    set root [string trimright [my url] /]
    #
    # Methods defined by RFC 2086 (19.6.1 Additional Request Methods):
    #
@@ -176,11 +178,16 @@ namespace eval ::xo {
      DELETE LOCK UNLOCK OPTIONS
      REPORT
    } {
-      ns_register_filter preauth $method $filter_url  [self]
-      ns_register_proc $method $url [self] handle_request
-      #my log "--ns_register_filter preauth $method $filter_url  [self]"
-      #my log "--ns_register_proc $method $url [self] handle_request"
-    }
+       ns_register_filter preauth $method $filter_url [self]
+       ns_register_filter preauth $method $root       [self]
+       ns_register_proc $method $url  [self] handle_request
+       ns_register_proc $method $root [self] handle_request
+
+       #my log "--ns_register_filter preauth $method $filter_url  [self]"
+       #my log "--ns_register_proc $method $url [self] handle_request"
+     }
+    ns_register_proc OPTIONS  / ::xo::minimalProctocolHandler OPTIONS
+    ns_register_proc PROPFIND / ::xo::minimalProctocolHandler PROPFIND
  }

  ProtocolHandler ad_instproc get_package_id {} {
@@ -199,10 +206,11 @@ namespace eval ::xo {
    dispatches the HTTP requests.
  } {
    my instvar uri method user_id
-  
+    
    #my log "--handle_request method=$method uri=$uri\
-    # 	userid=$user_id -ns_conn query '[ns_conn query]'"
-    if {[my exists package]} {
+        #     userid=$user_id -ns_conn query '[ns_conn query]'"
+    if {[my exists package] && $uri ne "/"} {
+      # We don't call package-initialze for $uri = "/"
      my set package_id [my get_package_id]
    }
    if {[my procsearch $method] ne ""} {
@@ -212,19 +220,130 @@ namespace eval ::xo {
    }
  }

+  #
+  # Formatting methods
+  #
+  ProtocolHandler instproc tcl_time_to_iso8601 {datetime} {
+    # RFC2518 requires this just for creationdate
+    if {$datetime eq ""} return ""
+    set tcl_time [::xo::db::tcl_date $datetime tz]
+    return [clock format [clock scan $tcl_time] -format "%Y-%m-%dT%H:%M:%SZ" -gmt 1]
+  }
+
+  ProtocolHandler instproc http_date {seconds} {
+    # HTTP-Date as defined in RFC2068#section-3.3.1
+    return "[clock format $seconds -format {%a, %d %b %Y %T} -gmt 1] GMT"
+  }
+
+  ProtocolHandler instproc tcl_time_to_http_date {datetime} {
+    # RFC2518 requires this e.g. for getlastmodified
+    if {$datetime eq ""} return ""
+    return [my http_date [clock scan [::xo::db::tcl_date $datetime tz]]]
+  }
+
+  ProtocolHandler instproc multiStatus {body} {
+    append _ {<?xml version="1.0" encoding="utf-8" ?>} \n \
+        {<D:multistatus xmlns:D="DAV:">} $body \n </D:multistatus> \n
+  }
+
+  ProtocolHandler instproc multiStatusResonse {
+    -href:required 
+    -propstats:required 
+    {-propstatus true}
+  } {
+    #my log "multiStatusResonse href $href propstats $propstats"
+    append reply \n \
+        {<D:response xmlns:lp1="DAV:" xmlns:lp2="http://apache.org/dav/props/" xmlns:g0="DAV:">} \
+        "\n<D:href>$href</D:href>\n"
+    # The multi-status respons has 2 formats
+    # - with <D:propstat> (used in PROPFIND and PROPPATCH)
+    # - without <D:propstat> (used in other cases, e.g. DELETE, COPY, MOVE for collections)
+    # http://www.webdav.org/specs/rfc4918.html#multi-status.response
+    #
+    foreach {props status} $propstats {
+      if {$propstatus} {
+        append reply <D:propstat>\n
+        if {[llength $props] > 0} {
+          append reply <D:prop>\n
+          foreach {name value} $props {
+            if {$value ne ""} { 
+              append reply <$name>$value</$name>\n
+            } else {
+              append reply <$name/>\n
+            }
+          }
+          append reply </D:prop>\n
+        } else {
+          append reply <D:prop/>\n
+        }
+        append reply <D:status>$status</D:status>\n</D:propstat>\n
+      } else {
+        append reply <D:status>$status</D:status>\n
+      }
+    }
+    append reply </D:response>\n
+  }
+
+  ProtocolHandler instproc multiStatusError {status} {
+    lappend davprops \
+        D:getlastmodified "" \
+        D:getcontentlength "" \
+        D:creationdate "" \
+        D:resourcetype ""
+    set r [my multiStatus [my multiStatusResonse \
+                               -href [ns_urldecode [ns_conn url]] \
+                               -propstats [list $davprops $status]]]
+    my log multiStatusError=$r
+    ns_return 207 text/xml $r
+  }
+
  #
  # Some dummy HTTP methods
  #
  ProtocolHandler instproc GET {} {
    my log "--GET method"
-    ns_return 200 text/plain GET-[my uri]
+    ns_return 200 text/plain GET-[my set uri]
  }
  ProtocolHandler instproc PUT {} {
    my log "--PUT method [ns_conn content]"
    ns_return 201 text/plain "received put with content-length [string length [ns_conn content]]"
  }
+
+  ProtocolHandler instproc OPTIONS {} {
+    ns_set put [ns_conn outputheaders] Allow OPTIONS
+    ns_return 200 text/plain {}
+  }
+  
  ProtocolHandler instproc PROPFIND {} {
-    my log "--PROPFIND [ns_conn content]"
-    ns_return 204 text/xml {<?xml version="1.0" encoding="utf-8" ?>}
+    #my log "--ProtocolHandler PROPFIND [ns_conn content]"
+    # when GET is not supported on this resource, the get* properties are not be sent
+    # see http://www.webdav.org/specs/rfc4918.html, 9.1.5
+    lappend davprops \
+        lp1:resourcetype    <D:collection/> \
+        lp1:creationdate    [my tcl_time_to_iso8601 "2013-06-30 01:21:22.648325+02"] \
+        D:supportedlock     {} \
+        D:lockdiscovery     {}
+    
+    ns_return 207 text/xml [my multiStatus \
+                                [my multiStatusResonse \
+                                     -href [my set uri] \
+                                     -propstats [list $davprops "HTTP/1.1 200 OK"]]]
  }
-}
\ No newline at end of file
+
+  ::xo::ProtocolHandler create ::xo::minimalProctocolHandler
+  ::xo::minimalProctocolHandler proc OPTIONS {args} {
+    ns_set put [ns_conn outputheaders] Allow OPTIONS
+    ns_return 200 text/plain {}
+  }
+  ::xo::minimalProctocolHandler proc PROPFIND {args} {
+    my multiStatusError "HTTP/1.1 403 Forbidden"
+  }
+}
+
+
+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/bgdelivery-procs.tcl
+++ b/tcl/bgdelivery-procs.tcl
--- a/tcl/chat-procs.tcl
+++ b/tcl/chat-procs.tcl
--- a/tcl/cluster-init.tcl
+++ b/tcl/cluster-init.tcl
@@ -27,11 +27,18 @@ if {[server_cluster_enabled_p]} {
  array set node [site_node::get -url $url] 
  if {$node(url) ne "/"} {
    ns_log notice "***\n*** WARNING: there appears a package mounted on\
-	$url\n***Cluster configuration will not work\
-	since there is a conflict with the aolserver filter with the same name!\n"
+       $url\n***Cluster configuration will not work\
+       since there is a conflict with the aolserver filter with the same name!\n"
  }
  
  #ns_register_filter trace GET $url ::xo::Cluster
  ns_register_filter preauth GET $url ::xo::Cluster 
  #ad_register_filter -priority 900 preauth GET $url ::xo::Cluster
 }
+
+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/cluster-procs.tcl
+++ b/tcl/cluster-procs.tcl
@@ -12,7 +12,7 @@ namespace eval ::xo {
    # first, excute the command on the local server
    eval $args
    # then, distribute the command in the cluster
-    eval ::xo::Cluster broadcast $args
+    ::xo::Cluster broadcast {*}$args
  }

  proc cache_flush_all {cache pattern} {
@@ -113,25 +113,32 @@ namespace eval ::xo {
  #
  Cluster proc broadcast args {
    foreach server [my info instances] {
-      eval $server message $args
+      $server message {*}$args
    }
  }
  Cluster instproc message args {
    my log "--cluster outgoing request to [my host]:[my port] // $args" 
-#     set r [::xo::HttpRequest new -volatile \
-#                -host [my host] -port [my port] \
-#                -path [Cluster set url]?cmd=[ns_urlencode $args]]
-#     return [$r set data]
+    #     set r [::xo::HttpRequest new -volatile \
+    #                -host [my host] -port [my port] \
+    #                -path [Cluster set url]?cmd=[ns_urlencode $args]]
+    #     return [$r set data]

    set r [::xo::AsyncHttpRequest new -volatile \
-	       -host [my host] -port [my port] \
-	       -path [Cluster set url]?cmd=[ns_urlencode $args]]
-  
-#     ::bgdelivery do ::xo::AsyncHttpRequest new \
-# 	-host [my host] -port [my port] \
-#         -path [Cluster set url]?cmd=[ns_urlencode $args] \
-# 	-mixin ::xo::AsyncHttpRequest::SimpleListener \
-# 	-proc finalize {obj status value} { my destroy }
+               -host [my host] -port [my port] \
+               -path [Cluster set url]?cmd=[ns_urlencode $args]]
+    
+    #     ::bgdelivery do ::xo::AsyncHttpRequest new \
+    #         -host [my host] -port [my port] \
+    #         -path [Cluster set url]?cmd=[ns_urlencode $args] \
+    #         -mixin ::xo::AsyncHttpRequest::SimpleListener \
+    #         -proc finalize {obj status value} { my destroy }

  }
-}
\ No newline at end of file
+}
+
+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/context-procs.tcl
+++ b/tcl/context-procs.tcl
--- a/tcl/cr-procs.tcl
+++ b/tcl/cr-procs.tcl
--- a/tcl/doc-procs.tcl
+++ b/tcl/doc-procs.tcl
--- a/tcl/generic-procs.tcl
+++ b/tcl/generic-procs.tcl
--- a/tcl/html-procs.tcl
+++ b/tcl/html-procs.tcl
--- a/tcl/http-client-procs.tcl
+++ b/tcl/http-client-procs.tcl
--- a/tcl/ical-procs.tcl
+++ b/tcl/ical-procs.tcl
--- a/tcl/install-check-procs.tcl
+++ b/tcl/install-check-procs.tcl
 namespace eval ::xotcl-core {

-  ad_proc ::xotcl-core::before_install_callback {} {
+  ad_proc -private ::xotcl-core::before-install {} {
  
    Callback for checking whether xotcl is installed for OpenACS
    
    @author Gustaf Neumann (neumann@wu-wien.ac.at)
  } {
    ns_log notice "-- before-install callback"
-    if {[info command ::xotcl::Class] eq ""} {
+    if {[info commands ::xotcl::Class] eq ""} {
      error " XOTcl does not appear to be installed on your system!\n\
     Please follow the install instructions on http://www.openacs.org/xowiki/xotcl-core"
    } elseif {$::xotcl::version < 1.5} {
      error " XOTcl 1.5 or newer required. You are using $::xotcl::version$::xotcl::patchlevel.\n\
-	Please install a new version of XOTcl (see http://www.openacs.org/xowiki/xotcl-core)"
+      Please install a new version of XOTcl (see http://www.openacs.org/xowiki/xotcl-core)"
    } else {
      ns_log notice "XOTcl $::xotcl::version$::xotcl::patchlevel is installed on your system."
    }
  }
  
-  ad_proc ::xotcl-core::after_upgrade_callback {
+  ad_proc -private ::xotcl-core::after-upgrade {
    {-from_version_name:required}
    {-to_version_name:required}
  } {
@@ -46,4 +46,12 @@ namespace eval ::xotcl-core {
    }
  }

-}
\ No newline at end of file
+}
+
+
+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/object-cache-init.tcl
+++ b/tcl/object-cache-init.tcl
@@ -12,3 +12,9 @@

 #    [parameter::get -package_id [ad_acs_kernel_id] -parameter MaxSize -default 200000]

+
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End:
--- a/tcl/policy-procs.tcl
+++ b/tcl/policy-procs.tcl
--- a/tcl/test/xotcl-avail-procs.tcl
+++ b/tcl/test/xotcl-avail-procs.tcl
--- a/www/cache.adp
+++ b/www/cache.adp
 <master>
-<property name="title">@title;noquote@</property>
-<property name="doc(title)">@title;noquote@</property>
-<property name="context">@context;noquote@</property>
+<property name="doc(title)">@title;literal@</property>
+<property name="context">@context;literal@</property>

 <if @t1@ not nil>
 <h3>Memory Caches</h3>

--- a/www/cache.tcl
+++ b/www/cache.tcl
--- a/www/index.adp
+++ b/www/index.adp
--- a/www/index.tcl
+++ b/www/index.tcl
--- a/www/show-class-graph.tcl
+++ b/www/show-class-graph.tcl
--- a/www/show-object.adp
+++ b/www/show-object.adp
--- a/www/show-object.tcl
+++ b/www/show-object.tcl
--- a/www/version-numbers.adp
+++ b/www/version-numbers.adp
--- a/www/version-numbers.tcl
+++ b/www/version-numbers.tcl
--- a/xotcl-core.info
+++ b/xotcl-core.info