first commit

Makefile

@@ -0,0 +1,12 @@
+
+.PSEUDO: all
+all: memcache.so
+
+.PSEUDO: clean
+clean:
+	rm -f memcache.so
+
+memcache.so: mymemcache.c
+	gcc -Wall -O2 -DUSE_TCL_STUBS -I/usr/local/include -L/usr/local/lib \
+		-o memcache.so -shared mymemcache.c -lmemcached -ltclstub8.5 
+

mymemcache.c

@@ -0,0 +1,173 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <tcl.h>
+#include <libmemcached/memcached.h>
+
+
+static int Memcache_Cmd(ClientData arg, Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[]);
+
+
+static memcached_st *memc = NULL;
+
+
+int DLLEXPORT
+Memcache_Init(Tcl_Interp *interp)
+{
+  if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+    return TCL_ERROR;
+  }
+  if (Tcl_PkgProvide(interp, "Memcache", "1.0") == TCL_ERROR) {
+    return TCL_ERROR;
+  }
+  memc = memcached_create(NULL);
+  Tcl_CreateObjCommand(interp, "memcache", Memcache_Cmd, NULL, NULL);
+  return TCL_OK;
+}
+
+
+static int Memcache_Cmd(ClientData arg, Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[])
+{
+  memcached_return result;
+  uint32_t flags = 0;
+  char *key, *data = NULL;
+  uint32_t size, expires = 0;
+  uint64_t size64;
+  int cmd;
+
+  enum {
+    cmdGet, cmdAdd, cmdAppend, cmdSet, cmdReplace,
+    cmdDelete, cmdIncr, cmdDecr, cmdVersion, cmdServer
+  };
+
+  static CONST char *sCmd[] = {
+    "get", "add", "append", "set", "replace",
+    "delete", "incr", "decr", "version", "server",
+    0
+  };
+
+  if (objc < 2) {
+    Tcl_WrongNumArgs(interp, 1, objv, "cmd args");
+    return TCL_ERROR;
+  }
+  if (Tcl_GetIndexFromObj(interp, objv[1], sCmd, "command", TCL_EXACT, (int *) &cmd) != TCL_OK) {
+    return TCL_ERROR;
+  }
+
+  switch (cmd) {
+  case cmdServer:
+    if (objc < 5) {
+      Tcl_WrongNumArgs(interp, 2, objv, "cmd server port");
+      return TCL_ERROR;
+    }
+    if (!strcmp(Tcl_GetString(objv[2]), "add")) {
+      result = memcached_server_add(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_SetObjResult(interp, Tcl_NewIntObj(result));
+    break;
+
+  case cmdGet:
+    if (objc < 4) {
+      Tcl_WrongNumArgs(interp, 2, objv, "key dataVar ?lengthVar? ?flagsVar?");
+      return TCL_ERROR;
+    }
+    key = Tcl_GetString(objv[2]);
+    data = memcached_get(memc, key, strlen(key), &size, &flags, &result);
+    fprintf(stderr, "result=%d\n", result);
+    if (data != NULL) {
+      Tcl_SetVar2Ex(interp, Tcl_GetString(objv[3]), NULL, Tcl_NewByteArrayObj((uint8_t*)data, size), 0);
+      if (objc > 4) {
+        Tcl_SetVar2Ex(interp, Tcl_GetString(objv[4]), NULL, Tcl_NewLongObj(size), 0);
+      }
+      if (objc > 5) {
+        Tcl_SetVar2Ex(interp, Tcl_GetString(objv[5]), NULL, Tcl_NewIntObj(flags), 0);
+      }
+      free(data);
+    }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
+    break;
+
+  case cmdAdd:
+  case cmdSet:
+  case cmdAppend:
+  case cmdReplace:
+    if (objc < 4) {
+      Tcl_WrongNumArgs(interp, 2, objv, "key value ?expires? ?flags?");
+      return TCL_ERROR;
+    }
+    key = Tcl_GetString(objv[2]);
+    data = (char*)Tcl_GetByteArrayFromObj(objv[3], (int*)&size);
+    if (objc > 4) {
+      expires = atoi(Tcl_GetString(objv[4]));
+    }
+    if (objc > 5) {
+      flags = atoi(Tcl_GetString(objv[5]));
+    }
+    switch (cmd) {
+    case cmdAdd:
+      result = memcached_add(memc, key, strlen(key), data, size, expires, flags);
+      break;
+    case cmdAppend:
+      result = memcached_append(memc, key, strlen(key), data, size, expires, flags);
+      break;
+    case cmdSet:
+      result = memcached_set(memc, key, strlen(key), data, size, expires, flags);
+      break;
+    case cmdReplace:
+      result = memcached_replace(memc, key, strlen(key), data, size, expires, flags);
+      break;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
+    break;
+
+  case cmdDelete:
+    if (objc < 3) {
+      Tcl_WrongNumArgs(interp, 2, objv, "key ?expires?");
+      return TCL_ERROR;
+    }
+    key = Tcl_GetString(objv[2]);
+    if (objc > 3) {
+      expires = atoi(Tcl_GetString(objv[3]));
+    }
+    result = memcached_delete(memc, key, strlen(key), expires);
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
+    break;
+
+  case cmdIncr:
+  case cmdDecr:
+    if (objc < 4) {
+      Tcl_WrongNumArgs(interp, 2, objv, "key value ?varname?");
+      return TCL_ERROR;
+    }
+    key = Tcl_GetString(objv[2]);
+    size = atoi(Tcl_GetString(objv[3]));
+    switch (cmd) {
+    case cmdIncr:
+      result = memcached_increment(memc, key, strlen(key), size, &size64);
+      break;
+    case cmdDecr:
+      result = memcached_decrement(memc, key, strlen(key), size, &size64);
+      break;
+    }
+    if (result == 1 && objc > 4) {
+      Tcl_SetVar2Ex(interp, Tcl_GetString(objv[4]), NULL, Tcl_NewLongObj(size64), 0);
+    }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
+    break;
+
+  case cmdVersion:
+    /*
+    result = memcached_version(memc);    // TODO
+    if (data != NULL) {
+      Tcl_SetObjResult(interp, Tcl_NewStringObj(data, -1));
+    }
+    */
+    break;
+
+  }
+  return TCL_OK;
+}
+

pkgIndex.tcl

@@ -0,0 +1,3 @@
+# pkgIndex.tcl -- tells Tcl how to load my package.
+package ifneeded "Memcache" 1.0 \
+    [list load [file join $dir memcache[info sharedlibextension]]]

testmemc.tcl

@@ -0,0 +1,8 @@
+#!/usr/bin/tclsh
+
+load ./memcache[info sharedlibextension]
+
+memcache server add localhost 11211
+memcache set moo "cows go moo"
+memcache get moo value
+puts "value=$value!\n";