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.84 -r1.85
--- openacs-4/packages/xotcl-core/xotcl-core.info	11 Aug 2011 13:05:16 -0000	1.84
+++ openacs-4/packages/xotcl-core/xotcl-core.info	21 Sep 2011 07:51:42 -0000	1.85
@@ -10,7 +10,7 @@
     <inherit-templates-p>t</inherit-templates-p>
     <auto-mount>xotcl</auto-mount>
 
-    <version name="0.121" url="http://media.wu-wien.ac.at/download/xotcl-core-0.121.apm">
+    <version name="0.122" url="http://media.wu-wien.ac.at/download/xotcl-core-0.122.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>2011-01-14</release-date>
@@ -43,7 +43,7 @@
         <license>BSD-Style</license>
         <maturity>0</maturity>
 
-        <provides url="xotcl-core" version="0.121"/>
+        <provides url="xotcl-core" version="0.122"/>
         <requires url="acs-kernel" version="5.2.0"/>
 
         <callbacks>
Index: openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl,v
diff -u -r1.35 -r1.36
--- openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl	9 May 2011 09:06:25 -0000	1.35
+++ openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl	21 Sep 2011 07:51:42 -0000	1.36
@@ -118,6 +118,9 @@
   fileSpooler tick
 
 
+  ###############
+  # h264Spooler
+  ###############
   # 
   # A first draft of a h264 pseudo streaming spooler.
   # Like for the fileSpooler, we create a single spooler object
@@ -194,7 +197,64 @@
     }
   }
 
+  #################
+  # AsyncDiskWriter
+  #################
+  ::xotcl::Class create ::AsyncDiskWriter -parameter {
+    {blocksize 4096} 
+    {autoflush false}
+    {verbose false}
+  }
+  ::AsyncDiskWriter instproc log {msg} {
+    if {[my verbose]} {ns_log notice "[self] --- $msg"}
+  }
+  ::AsyncDiskWriter instproc open {-filename {-mode w}} {
+    my set channel [open $filename $mode]
+    my set content ""
+    my set filename $filename
+    fconfigure [my set channel] -translation binary -blocking false
+    my log "open [my set filename]"
+  }
 
+  ::AsyncDiskWriter instproc close {{-sync false}} {
+    my instvar content channel
+    if {$sync || [string length $content] == 0} {
+      my log "close sync"
+      if {$content ne ""} {
+	fconfigure $channel -translation binary -blocking true
+	puts -nonewline $channel $content
+      }
+      close $channel
+      my destroy
+    } else {
+      my log "close async"
+      my set finishWhenDone 1
+    }
+  }
+  ::AsyncDiskWriter instproc async_write {block} {
+    my append content $block
+    fileevent [my set channel] writable [list [self] writeBlock]
+  }
+  ::AsyncDiskWriter instproc writeBlock {} {
+    my instvar content blocksize channel
+    if {[string length $content] < $blocksize} {
+      puts -nonewline $channel $content
+      my log "write [string length $content] bytes"
+      fileevent [my set channel] writable ""
+      set content ""
+      if {[my autoflush]} {flush $channel}
+      if {[my exists finishWhenDone]} {
+	my close -sync true
+      }
+    } else {
+      set chunk [string range $content 0 [expr {$blocksize-1}]]
+      set content [string range $content $blocksize end]
+      puts -nonewline $channel $chunk
+      my log "write [string length $chunk] bytes ([string length $content] buffered)"
+    }
+  }
+  
+
   ###############
   # Subscriptions
   ###############
@@ -252,6 +312,11 @@
     incr ::subscription_count
   }
   
+
+  ###############
+  # HttpSpooler
+  ###############
+
   Class ::HttpSpooler -parameter {channel {timeout 10000} {counter 0}}
   ::HttpSpooler instproc init {} {
     my set running 0
@@ -324,6 +389,19 @@
 	  -timeout [my timeout] -post_data $post_data -request_manager [self]
     }
   }
+
+  #
+  # Add an exit handler to close all AsyncDiskWriter, when this thread goes
+  # down.
+  #
+  ::xotcl::Object setExitHandler {
+    ns_log notice "--- exit handler"
+    foreach writer [::AsyncDiskWriter info instances -closure] {
+      ns_log notice "close AsyncDiskWriter $writer"
+      $writer close
+    }
+  }
+
 } -persistent 1 ;# -lightweight 1
 
 bgdelivery ad_forward running {