Index: openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl,v
diff -u -r1.18 -r1.19
--- openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl	3 Aug 2011 19:25:19 -0000	1.18
+++ openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl	11 Aug 2011 12:32:58 -0000	1.19
@@ -137,11 +137,24 @@
     return 1
   }
 
-  ad_proc cr_thin_out {{-doit 0} {-edit_interval 300} {-older_than "1 month ago"} -package_id -item_id} {
-    Delete supposedly uninportant revision from the content repository.
+  ad_proc cr_thin_out {
+      {-doit false} 
+      {-delete_orphans false} 
+      {-delete_sequences false} 
+      {-edit_interval 300} 
+      {-older_than "1 month ago"} 
+      -package_id
+      -item_id
+  } {
+    Delete supposedly uninportant items and revision from the content repository.
     
+    @param doit if not true, then just write delete operation to the logfile
+    @param delete_orphans if true, delete orphaned items
+    @param delete_sequences if true, delete revisions from edit sequences lower than edit_interval
     @param edit_interval delete entries, which never become older than this interval (in seconds, default 300)
     @param older_than delete only entries, which were modified longer than the provided time ago
+    @param package_id if specified, perform operation just on the specified package
+    @param item_id if specified, perform operation just on the specified item
   } {
     set extra_clause ""
     if {[info exists package_id]} {
@@ -154,66 +167,72 @@
     # only delete revisions older than this date
     set older_than [clock scan $older_than]
 
-    #
-    # 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
+    if {$delete_orphans} {
+      #
+      # Removes orphaned items, where a user pressed "new", but never
+      # saved the page. 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
+         $extra_clause
+      "
+      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 log "...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 < $edit_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
-          }
-        }
+    if {$delete_sequences} {
+      #
+      # The second 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 < $edit_interval && $timediff >= 0} {
+	    ::xotcl::Object log "...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
       }
-      set last_user $user
-      set last_time $time
-      set last_item $item_id
-      set last_revision $revision_id
     }
   }