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.31 -r1.32
--- openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl	22 May 2010 09:04:33 -0000	1.31
+++ openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl	31 May 2010 10:50:58 -0000	1.32
@@ -90,6 +90,30 @@
   }
   fileSpooler tick
 
+
+  # StreamSpooler object:
+  # This single spooler object is useful for forwarding a given stream of data (fd) 
+  # to a connection channel (ch) in the background. 
+
+  FileSpooler create streamSpooler
+
+  streamSpooler proc spool {-channel -fd -context -query {-client_data ""}} {
+    set filename ""
+    fconfigure $fd -translation binary
+    fconfigure $channel -translation binary
+      fcopy $fd $channel -command [list [self] end-delivery -client_data $client_data $filename $fd $channel]
+    set ::running($channel,$fd,$filename) $context
+    incr ::delivery_count
+  }
+  
+  streamSpooler proc end-delivery {{-client_data ""} filename fd channel bytes args} {
+    ns_log Warning "streamSpooler end-delivery $fd"
+      if {[catch {close $channel} e]} {ns_log notice "bgdelivery, closing channel for $fd, error: $e"}
+      if {[catch {close $fd} e]} {ns_log notice "bgdelivery, closing fd $fd, error: $e"}
+    unset ::running($channel,$fd,$filename)
+  }
+
+
   # 
   # A first draft of a h264 pseudo streaming spooler.
   # Like for the fileSpooler, we create a single spooler object