Index: openacs-4/packages/xowiki/tcl/xowiki-callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-callback-procs.tcl,v
diff -u -r1.45 -r1.46
--- openacs-4/packages/xowiki/tcl/xowiki-callback-procs.tcl	10 Sep 2008 10:19:19 -0000	1.45
+++ openacs-4/packages/xowiki/tcl/xowiki-callback-procs.tcl	11 Sep 2008 13:47:14 -0000	1.46
@@ -560,6 +560,85 @@
     return 1
   }
 
+  ad_proc cr_thin_out {{-doit 0} -package_id -item_id} {
+    delete unneded items
+  } {
+    set extra_cause ""
+    if {[info exists package_id]} {
+      append extra_clause " and o.package_id = $package_id"
+    }
+    if {[info exists item_id]} {
+      append extra_clause " and i.item_id = $item_id"
+    }
+
+    # only delete revisions older than this date
+    set older_than [clock scan "1 month ago"]
+    # delete revisions which are less than 5 minutes apart
+    set delete_interval [expr {60*5}]
+
+    #
+    # The first query removes widow entries, where a user pressed new, but
+    # never saved it. We could check as well, if the item has exactly one revision.
+    #
+    set sql "
+       select i.name, o.package_id, i.item_id, r.revision_id, o.last_modified
+       from acs_objects o, xowiki_page p, cr_revisions r, cr_items i 
+       where p.page_id = r.revision_id and r.item_id = i.item_id and o.object_id = r.revision_id 
+       and i.publish_status = 'production' and i.name = r.revision_id::varchar
+    "
+    foreach tuple [db_list_of_lists get_revisions $sql] {
+      #::xotcl::Object msg "tuple = $tuple"
+      foreach {name package_id item_id revision_id last_modified} $tuple break 
+      set time [clock scan [::xo::db::tcl_date $last_modified tz_var]]
+      if {$time > $older_than} continue
+      ::xotcl::Object msg "...will delete $name doit=$doit $last_modified"
+      if {$doit} {
+        ::xowiki::Package require $package_id
+        $package_id delete -item_id $item_id -name $name
+      }
+    }
+    
+    #
+    # The first query removes quick edits, where from a sequence of edits of the same user,
+    # only the last edit is kept
+    #
+    set sql "
+      select i.name, i.item_id, r.revision_id,  o.last_modified, o.creation_user, o.package_id
+      from acs_objects o, xowiki_page p, cr_revisions r, cr_items i 
+      where p.page_id = r.revision_id and r.item_id = i.item_id
+      and o.object_id = r.revision_id  
+      $extra_clause
+      order by item_id, revision_id asc
+    "
+    set last_item ""
+    set last_time 0
+    set last_user ""
+    set last_revision ""
+
+    foreach tuple [db_list_of_lists get_revisions $sql] {
+      #::xotcl::Object msg "tuple = $tuple"
+      foreach {name item_id revision_id last_modified user package_id} $tuple break 
+      set time [clock scan [::xo::db::tcl_date $last_modified tz_var]]
+      if {$time > $older_than} continue
+      #::xotcl::Object msg "compare time $time with $older_than => [expr {$time < $older_than}]"
+      if {$last_user eq $user && $last_item == $item_id} {
+        set timediff [expr {$time-$last_time}]
+        #::xotcl::Object msg "   timediff=[expr {$time-$last_time}]"
+        if {$timediff < $delete_interval && $timediff >= 0} {
+          ::xotcl::Object msg "...will delete $name revision=$last_revision, doit=$doit $last_modified"
+          if {$doit} {
+            ::xowiki::Package require $package_id
+            $package_id delete_revision -revision_id $last_revision -item_id $item_id
+          }
+        }
+      }
+      set last_user $user
+      set last_time $time
+      set last_item $item_id
+      set last_revision $revision_id
+    }
+  }
+
   proc unmounted_instances {} {
     return [db_list unmounted_instances {
       select package_id from apm_packages p where not exists