From c46fde880b6d3f9eef24e8dd1ab7bc3f6a8a0f18 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Tue, 31 May 2011 20:28:57 +1000
Subject: Add aio support for buffering

And fconfigure for Tcl compatibility

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 examples/client-server.tcl |  2 +-
 examples/tcp.server        |  3 ++-
 examples/udp.client        |  3 ++-
 jim-aio.c                  | 42 ++++++++++++++++++++++++++++++++++++++++++
 tclcompat.tcl              | 16 ++++++++++++++++
 5 files changed, 63 insertions(+), 3 deletions(-)

diff --git a/examples/client-server.tcl b/examples/client-server.tcl
index 4856e47..0740773 100644
--- a/examples/client-server.tcl
+++ b/examples/client-server.tcl
@@ -15,6 +15,7 @@ if {[os.fork] == 0} {
 	sleep .1
 
 	set f [socket stream localhost:9876]
+	fconfigure $f -buffering line
 
 	set done 0
 
@@ -30,7 +31,6 @@ if {[os.fork] == 0} {
 	proc onwrite {f} {
 		verbose "child: sending request"
 		$f puts -nonewline "GET / HTTP/1.0\r\n\r\n"
-		$f flush
 		$f writable {}
 	}
 
diff --git a/examples/tcp.server b/examples/tcp.server
index ef71fe5..1e400fb 100644
--- a/examples/tcp.server
+++ b/examples/tcp.server
@@ -11,6 +11,8 @@ $s readable {
 	if {[os.fork] == 0} {
 		$s close
 
+		$sock buffering line
+
 		# Get the request (max 80 chars) - need the source address
 		while {[$sock gets buf] >= 0} {
 			set buf [string trim $buf]
@@ -26,7 +28,6 @@ $s readable {
 
 			# Send the result back to where it came from
 			$sock puts $result
-			$sock flush
 		}
 	}
 
diff --git a/examples/udp.client b/examples/udp.client
index da74e77..165050a 100644
--- a/examples/udp.client
+++ b/examples/udp.client
@@ -15,12 +15,13 @@ $s close
 # Now sending via a connected udp socket
 
 set s [socket dgram 127.0.0.1:20000]
+$s buffering line
 
 foreach i [range 5 10] {
 	# Socket is connected, so can just use puts here
 	# But remember to flush to ensure that each message is separate
 	$s puts -nonewline "$i * $i"
-	$s flush
+	#$s flush
 
 	# Receive the response - max length of 100
 	puts [$s recvfrom 100]
diff --git a/jim-aio.c b/jim-aio.c
index 1e295ed..e5e8898 100644
--- a/jim-aio.c
+++ b/jim-aio.c
@@ -715,6 +715,41 @@ static int aio_cmd_ndelay(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 }
 #endif
 
+static int aio_cmd_buffering(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+    AioFile *af = Jim_CmdPrivData(interp);
+
+    static const char *options[] = {
+        "none",
+        "line",
+        "full",
+        NULL
+    };
+    enum
+    {
+        OPT_NONE,
+        OPT_LINE,
+        OPT_FULL,
+    };
+    int option;
+
+    if (Jim_GetEnum(interp, argv[0], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
+        return JIM_ERR;
+    }
+    switch (option) {
+        case OPT_NONE:
+            setvbuf(af->fp, NULL, _IONBF, 0);
+            break;
+        case OPT_LINE:
+            setvbuf(af->fp, NULL, _IOLBF, BUFSIZ);
+            break;
+        case OPT_FULL:
+            setvbuf(af->fp, NULL, _IOFBF, BUFSIZ);
+            break;
+    }
+    return JIM_OK;
+}
+
 #ifdef jim_ext_eventloop
 static void JimAioFileEventFinalizer(Jim_Interp *interp, void *clientData)
 {
@@ -874,6 +909,13 @@ static const jim_subcmd_type aio_command_table[] = {
         .description = "Set O_NDELAY (if arg). Returns current/new setting."
     },
 #endif
+    {   .cmd = "buffering",
+        .args = "none|line|full",
+        .function = aio_cmd_buffering,
+        .minargs = 1,
+        .maxargs = 1,
+        .description = "Sets buffering"
+    },
 #ifdef jim_ext_eventloop
     {   .cmd = "readable",
         .args = "?readable-script?",
diff --git a/tclcompat.tcl b/tclcompat.tcl
index 8559edc..d7266e1 100644
--- a/tclcompat.tcl
+++ b/tclcompat.tcl
@@ -35,6 +35,22 @@ if {[info commands stdout] ne ""} {
 		}
 		tailcall $chan read {*}${-nonewline}
 	}
+
+	proc fconfigure {f args} {
+		foreach {n v} $args {
+			switch -glob -- $n {
+				-bl* {
+					$f ndelay $v
+				}
+				-bu* {
+					$f buffering $v
+				}
+				default {
+					return -code error "fconfigure: unknown option $n"
+				}
+			}
+		}
+	}
 }
 
 # case var ?in? pattern action ?pattern action ...?
-- 
cgit v1.1