diff -r 000000000000 -r 2b3e5ec03512 test/file-injector.tcl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/file-injector.tcl	Thu Apr 21 14:57:45 2011 +0100
@@ -0,0 +1,109 @@
+#
+#    Copyright 2004-2006 Intel Corporation
+# 
+#    Licensed under the Apache License, Version 2.0 (the "License");
+#    you may not use this file except in compliance with the License.
+#    You may obtain a copy of the License at
+# 
+#        http://www.apache.org/licenses/LICENSE-2.0
+# 
+#    Unless required by applicable law or agreed to in writing, software
+#    distributed under the License is distributed on an "AS IS" BASIS,
+#    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#    See the License for the specific language governing permissions and
+#    limitations under the License.
+#
+
+#
+# Simple test code that scans a directory for new data and injects
+# whatever it finds as a bundle.
+#
+
+#
+# Starts up a file injector to scan the given directory and create
+# new bundles from any files that are found.
+#
+# usage: file_injector <dir> <source> <dest> <-period ms>
+#
+proc file_injector_start {dir source dest args} {
+    global file_injector_handles
+    
+    set period 1000
+    
+    if {$args != {}} {
+	error "XXX/demmer implement optional args"
+    }
+
+    set after_handle [after 0 \
+	    [list file_injector_scan $dir $source $dest $period]]
+    set file_injector_handles($dir) $after_handle
+
+    return $dir
+}
+
+#
+# Stops a file injector on the given directory
+#
+proc file_injector_stop {dir} {
+    global file_injector_handles
+
+    if [info exists file_injector_handles($dir)] {
+	after cancel $file_injector_handles($dir)
+    } else {
+	error "no injector running on dir $dir"
+    }
+}
+
+#
+# Internal proc that actually does the scanning
+#
+proc file_injector_scan {dir source dest period} {
+    global file_injector_handles
+    global fd_ftplog
+    
+    set files [glob -nocomplain -- "$dir/*"]
+
+#    log /file_injector DEBUG "scanning $dir... found [llength $files] files"
+    foreach file $files {
+	file stat $file file_stat
+	
+	log /file_injector DEBUG "stat type $file_stat(type)"
+	
+	if {$file_stat(type) != "file"} {
+	    log /file_injector DEBUG \
+		    "ignoring file $file type $file_stat(type)"
+	    continue
+	}
+
+	set len $file_stat(size)
+	if {$len == 0} {
+	    log /file_injector DEBUG "ignoring empty file $file"
+	    continue
+	}
+
+	log /file_injector DEBUG "reading payload from bundle file $file";
+	set fd [open $file]
+	fconfigure $fd -translation binary
+	set payload [read $fd]
+	close $fd
+
+	log /file_injector DEBUG "gotnow $len byte payload"
+	
+	log /file_injector INFO " sending bundle [file tail $file] $len byte payload"
+
+	if {[info exists fd_ftplog]} {
+	    puts $fd_ftplog "[time] :: sending bundle [file tail $file]  $len byte  "
+	    flush $fd_ftplog
+	
+	}
+	bundle inject $source "$dest/[file tail $file]" $payload option [list length $len]
+
+	file delete $file
+    }
+
+    # re-schedule the scan
+    set after_handle [after $period \
+	    [list file_injector_scan $dir $source $dest $period]]
+    set file_injector_handles($dir) $after_handle
+    return ""
+}