Merge pull request #4 from flightaware/BCK-2485

BCK 2485 - add 'server clear' command

Makefile.in

@@ -116,6 +116,9 @@ TCL_SRC_DIR	= @TCL_SRC_DIR@
 #TK_BIN_DIR	= @TK_BIN_DIR@
 #TK_SRC_DIR	= @TK_SRC_DIR@
 
+# If this isn't set, resetting it later on will break things
+@LD_LIBRARY_PATH_VAR@ ?= /usr/lib:/usr/local/lib
+
 # Not used, but retained for reference of what libs Tcl required
 #TCL_LIBS	= @TCL_LIBS@
 

README.FreeBSD

@@ -1,4 +1,5 @@
-pkg install databases/libmemcached
+#pkg install databases/libmemcached
+echo install [email protected]:awesomized/libmemcached.git
 
 env CPPFLAGS=-I/usr/local/include LDFLAGS=-L/usr/local/lib ./configure --with-tcl=/usr/local/lib/tcl8.6
 

README.md

@@ -14,9 +14,12 @@ The actual memcached server installation is independent of the
 installation of this client package and is not addressed by this
 document.
 
+The underlying libmemcached installation recommended is awesomized/libmemcached
+because the official libmemcached has not had a release since 2014 and there are
+crashing bugs that have had fixes provided that haven't been rolled up into a release.
 
 On FreeBSD:
-* pkg install databases/libmemcached
+* install [email protected]:awesomized/libmemcached.git
 * env CPPFLAGS=-I/usr/local/include LDFLAGS=-L/usr/local/lib ./configure --with-tcl=/usr/local/lib/tcl8.6
 * make
 * make install
@@ -54,12 +57,16 @@ on success or some other integer error. If the returned value is
 non-zero then the request failed, and you should not expect any 
 varname arguments to have been modified.
 
+Use `memcache strerror` to get a human readable version of the error code.
+
 
 Available Commands
 ------------------
 
  memcache server add hostname port
 
+ memcache server clear
+
  memcache get key varname ?lengthVar? ?flagsVar?
 
  memcache add key value ?expires? ?flags?
@@ -83,3 +90,5 @@ Available Commands
  memcache version
 
  memcache behavior flagname ?flagvalue?
+
+ memcache strerror errorcode

generic/tclMemcache.c

@@ -61,17 +61,20 @@ static int Memcache_Cmd(ClientData arg, Tcl_Interp * interp, int objc, Tcl_Obj *
   uint32_t expires = 0;
   uint64_t size64;
   int cmd;
+  int errorcode;
 
 
   // list of supported commands that we expose.
   enum {
     cmdGet, cmdAdd, cmdAppend, cmdPrepend, cmdSet, cmdReplace,
-    cmdDelete, cmdFlush, cmdIncr, cmdDecr, cmdVersion, cmdServer, cmdBehavior
+    cmdDelete, cmdFlush, cmdIncr, cmdDecr, cmdVersion, cmdServer, cmdBehavior,
+    cmdStringError
   };
 
   static CONST char *sCmd[] = {
     "get", "add", "append", "prepend", "set", "replace",
     "delete", "flush", "incr", "decr", "version", "server", "behavior",
+    "strerror",
     0
   };
 
@@ -132,22 +135,30 @@ static int Memcache_Cmd(ClientData arg, Tcl_Interp * interp, int objc, Tcl_Obj *
   case cmdServer:
     /*
      * Server list manipulation:
-     *   - server add hostname port
-     *   - memcache server delete hostname port
+     *   - memcache server add hostname port
+     *   - memcache server clear
      */
-    if (objc != 5) {
-      Tcl_WrongNumArgs(interp, 2, objv, "cmd server port");
+    if (objc < 3) {
+      Tcl_WrongNumArgs(interp, 2, objv, "(add|clear) ...");
       return TCL_ERROR;
     }
     if (!strcmp(Tcl_GetString(objv[2]), "add")) {
+      // adds a TCP memcache server
+      if (objc != 5) {
+        Tcl_WrongNumArgs(interp, 2, objv, "add hostname port");
+        return TCL_ERROR;
+      }
       result = memcached_server_add(get_memc(), Tcl_GetString(objv[3]), atoi(Tcl_GetString(objv[4])));
-    } else if (!strcmp(Tcl_GetString(objv[2]), "delete")) {
-      // TODO: not supported
-      //mc_server_delete(mc, mc_server_find(mc, Tcl_GetString(objv[3]), 0));
-      Tcl_AppendResult(interp, "server delete not supported.", NULL);
-      return TCL_ERROR;
+    } else if (!strcmp(Tcl_GetString(objv[2]), "clear")) {
+      // clear the entire memcache server list.
+      if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "clear");
+        return TCL_ERROR;
+      }
+      memcached_servers_reset(get_memc());
+      result = 0;
     } else {
-      Tcl_AppendResult(interp, "server command not recognized.", NULL);
+      Tcl_AppendResult(interp, "server subcommand not recognized.", NULL);
       return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
@@ -293,16 +304,16 @@ static int Memcache_Cmd(ClientData arg, Tcl_Interp * interp, int objc, Tcl_Obj *
     switch (cmd) {
     case cmdIncr:
       if (objc > 5) {
-	result = memcached_increment_with_initial(get_memc(), key, strlen(key), size, size64, expires, &size64);
+        result = memcached_increment_with_initial(get_memc(), key, strlen(key), size, size64, expires, &size64);
       } else {
-	result = memcached_increment(get_memc(), key, strlen(key), size, &size64);
+        result = memcached_increment(get_memc(), key, strlen(key), size, &size64);
       }
       break;
     case cmdDecr:
       if (objc > 5) {
-	result = memcached_decrement_with_initial(get_memc(), key, strlen(key), size, size64, expires, &size64);
+        result = memcached_decrement_with_initial(get_memc(), key, strlen(key), size, size64, expires, &size64);
       } else {
-	result = memcached_decrement(get_memc(), key, strlen(key), size, &size64);
+        result = memcached_decrement(get_memc(), key, strlen(key), size, &size64);
       }
       break;
     }
@@ -341,6 +352,20 @@ static int Memcache_Cmd(ClientData arg, Tcl_Interp * interp, int objc, Tcl_Obj *
       uint64_t currentVal = memcached_behavior_get(get_memc(), cmd);
       Tcl_SetObjResult(interp, Tcl_NewWideIntObj(currentVal));
     }
+  case cmdStringError:
+    /*
+     * Return the string associated with a libmemcached error code.
+     *
+     * - memcached strerror integer
+     */
+    if (objc != 3) {
+      Tcl_WrongNumArgs(interp, 2, objv, "errorcode");
+      return TCL_ERROR;
+    }
+    if (Tcl_GetIntFromObj(interp, objv[2], &errorcode) != TCL_OK) {
+      return TCL_ERROR;
+    }
+    Tcl_SetResult(interp, memcached_strerror(get_memc(), errorcode), TCL_VOLATILE);
   }
   return TCL_OK;
 }

tests/all.tcl

@@ -2,21 +2,57 @@
 package require Memcache
 #load ./memcache[info sharedlibextension]
 
-memcache server add localhost 11211
-memcache set moo "cows go moo"
-memcache get moo value
+set result [memcache server add localhost 11211]
+if {$result} {
+    puts "memcache server add: [memcache strerror $result]"
+    exit 1
+}
+
+# Clear server list just to make sure.
+set result [memcache server clear]
+if {$result} {
+    puts "memcache server clear: [memcache strerror $result]"
+    exit 1
+}
+
+# add again
+set result [memcache server add localhost 11211]
+if {$result} {
+    puts "memcache server add: [memcache strerror $result]"
+    exit 1
+}
+
+# actually test something
+set result [memcache set moo "cows go moo"]
+if {$result} {
+    puts "memcache set: [memcache strerror $result]"
+    exit 1
+}
+set result [memcache get moo value]
+if {$result} {
+    puts "memcache get: [memcache strerror $result]"
+    exit 1
+}
 if {$value != "cows go moo"} {
     puts "Error.  value=$value!\n";
     exit 1
 }
 
 set value "Boeing 777-200 (طائرة نفاثة ثنائية المحرك)"
 
-memcache set unicodeTest $value
-memcache get unicodeTest newvalue
+set result [memcache set unicodeTest $value]
+if {$result} {
+    puts "memcache set: [memcache strerror $result]"
+    exit 1
+}
+set result [memcache get unicodeTest newvalue]
+if {$result} {
+    puts "memcache set: [memcache strerror $result]"
+    exit 1
+}
 if {$value != $newvalue} {
     puts "Error.  newvalue=$newvalue!\n";
-	exit 1
+    exit 1
 }
 
 puts "Success"